January 23, 2010
I will say up front that this example is a bit complicated – if you feel sick to your stomach after reading this article it is not my fault. So, what does this example show:
- Query Active Directory using ADO to obtain a list of all computers on the domain.
- Ping each of the computers to verify that the computer may be reached over the network.
- Send a WMI query to each computer that responded to a ping. The WMI query targets Win32_ComputerSystem which describes the timezone, domain, computer role, computer manufacturer, computer model, number of CPUs, amount of physical memory, currently logged on user, and more.
- Create a table in the Oracle database to contain the data returned by the WMI query (using a very generic VARCHAR2(100) definition for each column).
- Transfer the data from the WMI results to the database table.
- Announce using voice prompts if a computer does not respond to a ping, and also announce when the WMI query is being sent to the remote computer.
Note that I had a bit of difficulty making the usual method for submitting SQL statements with bind variables work correctly with the WMI data, so I used another approach. There are 2 subroutines in the script, the Main script is started when the VBS file executes, and the Main script calls the PingTest function as needed. Save the script as CheckComputers.vbs, then execute the script using either cscript or wscript. Note that you must be an aministrator on each computer, or a domain administrator for the remote WMI queries to correctly execute.
Main
Sub Main()
Const CONVERT_TO_LOCAL_TIME = True
Const wbemFlagReturnImmediately = &H10
Const wbemFlagForwardOnly = &H20
Const adCmdText = 1
Const adVarChar = 200
Const adchar = 129
Const adParamInput = 1
Const adOpenKeyset = 1
Const adLockOptimistic = 3
Const ADS_SCOPE_SUBTREE = 2
Dim strSpeech
Dim objSpeech
Dim strComputer
Dim varStartTime
Dim objWMIService
Dim colItems
Dim objItem
Dim i
Dim intResult
Dim intComputer
Dim lngPass
Dim lngPassMax
Dim intColumns
Dim intColumn
Dim objProperty
Dim dbActiveDirectory
Dim strSQL
Dim strSQLInsert
Dim strSQLTable
Dim comData
Dim snpData
Dim strDomain
Dim comDataInsert
Dim dynDataInsert
Dim dbDatabase
Dim strUsername
Dim strPassword
Dim strDatabase
On Error Resume Next
Set dbDatabase = CreateObject("ADODB.Connection")
Set comDataInsert = CreateObject("ADODB.Command")
Set dynDataInsert = CreateObject("ADODB.Recordset")
Set objSpeech = CreateObject("SAPI.SpVoice")
strUsername = "MyUsername"
strPassword = "MyPassword"
strDatabase = "MyDB"
strDomain = "DC=oracle,DC=com" 'Your domain: Equivalent to oracle.com, change as needed
Set dbActiveDirectory = CreateObject("ADODB.Connection")
Set comData = CreateObject("ADODB.Command")
Set snpData = CreateObject("ADODB.Recordset")
dbDatabase.ConnectionString = "Provider=OraOLEDB.Oracle;Data Source=" & strDatabase & ";User ID=" & strUsername & ";Password=" & strPassword & ";"
dbDatabase.Open
'Should verify that the connection attempt was successful, but I will leave that for someone else to code
dbActiveDirectory.Provider = "ADsDSOObject"
dbActiveDirectory.Open "Active Directory Provider"
comData.ActiveConnection = dbActiveDirectory
If Err <> 0 Then
intResult = MsgBox("An error happened while connecting to Active Directory" & vbCrLf & Err.Description, 16, "Oh NO!")
Exit Sub
End If
With comData
strSQL = "SELECT" & vbCrLf
strSQL = strSQL & " NAME" & vbCrLf
strSQL = strSQL & "FROM" & vbCrLf
strSQL = strSQL & " 'LDAP://" & strDomain & "'" & vbCrLf
strSQL = strSQL & "WHERE" & vbCrLf
strSQL = strSQL & " OBJECTCLASS='computer'" & vbCrLf
strSQL = strSQL & "ORDER BY" & vbCrLf
strSQL = strSQL & " NAME"
.CommandText = strSQL
.Properties("Page Size") = 1000
.Properties("Searchscope") = ADS_SCOPE_SUBTREE
End With
Set snpData = comData.Execute
If Err <> 0 Then
intResult = MsgBox("An error happened while reading the computer list from Active Directory" & vbCrLf & Err.Description, 16, "Oh NO!")
Exit Sub
End If
strSQL = "SELECT * FROM Win32_ComputerSystem"
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery(strSQL, "WQL", wbemFlagReturnImmediately + wbemFlagForwardOnly)
strSQLTable = "CREATE TABLE COMPUTER_LIST (" & vbCrLf
strSQLTable = strSQLTable & " COMPUTER_NAME VARCHAR2(100)," & vbCrLf
strSQLInsert = "INSERT INTO COMPUTER_LIST VALUES (" & vbCrLf
intColumns = 1
With comDataInsert
.Parameters.Append .CreateParameter("computer_name", adVarChar, adParamInput, 100, " ")
For Each objItem In colItems
For Each objProperty In objItem.Properties_
'We are in the header row
intColumns = intColumns + 1
strSQLTable = strSQLTable & " " & Replace(CStr(objProperty.Name), " ", "_") & " VARCHAR2(100)," & vbCrLf
'This method seems to be having problems
'strSQLInsert = strSQLInsert & " ?," & vbCrLf
'.Parameters.Append .CreateParameter("value" & FormatNumber(intColumns, 0), adVarChar, adParamInput, 100, " ")
Next
Next
'This method seems to be having problems
'strSQLInsert = Left(strSQLInsert, Len(strSQLInsert) - 3) & ")"
'.CommandText = strSQLInsert
'.CommandType = adCmdText
'.CommandTimeout = 30
'.ActiveConnection = dbDatabase
End With
strSQLTable = strSQLTable & " PRIMARY KEY (COMPUTER_NAME))"
dbDatabase.Execute strSQLTable
'Alternate method should also use bind variables
strSQLInsert = "SELECT" & vbCrLf
strSQLInsert = strSQLInsert & " *" & vbCrLf
strSQLInsert = strSQLInsert & "FROM" & vbCrLf
strSQLInsert = strSQLInsert & " COMPUTER_LIST" & vbCrLf
strSQLInsert = strSQLInsert & "WHERE" & vbCrLf
strSQLInsert = strSQLInsert & " 1=2"
dynDataInsert.Open strSQLInsert, dbDatabase, adOpenKeyset, adLockOptimistic
strSQL = "SELECT * FROM Win32_ComputerSystem"
dbDatabase.BeginTrans
If snpData.State = 1 Then
Do While Not (snpData.EOF)
If PingTest(CStr(snpData.Fields("Name").Value)) = True Then
Err = 0 'Reset the error indicator
strComputer = CStr(snpData.Fields("Name").Value)
strSpeech = "Checking, " & strComputer
objSpeech.Speak strSpeech
Err = 0
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
If Err = 0 Then
Set colItems = objWMIService.ExecQuery(strSQL, "WQL", wbemFlagReturnImmediately + wbemFlagForwardOnly)
intColumn = 1
'This method seems to be having problems
'comDataInsert("computer_name") = Left(CStr(strComputer), 100)
dynDataInsert.AddNew
dynDataInsert("computer_name") = Left(CStr(strComputer), 100)
For Each objItem In colItems
intColumn = 1
For Each objProperty In objItem.Properties_
intColumn = intColumn + 1
If Not (IsNull(objProperty.Value)) Then
If VarType(objProperty.Value) <> 8204 Then
'This method seems to be having problems
'comDataInsert("value" & FormatNumber(intColumn, 0)) = Left(objProperty.Value, 100)
dynDataInsert(Replace(CStr(objProperty.Name), " ", "_")) = Left(objProperty.Value, 100)
End If
End If
Next
Next
'This method seems to be having problems
'comDataInsert.Execute
'Alternate method should also use bind variables
dynDataInsert.Update
End If
Else
strComputer = CStr(snpData.Fields("Name").Value)
strSpeech = "Could Not Ping, " & strComputer
objSpeech.Speak strSpeech
End If
snpData.MoveNext
Loop
snpData.Close
strSpeech = "Done!"
objSpeech.Speak strSpeech
Else
If Err <> 0 Then
intResult = MsgBox("An error happened while connecting to Active Directory" & vbCrLf & Err.Description, 16, "Oh NO!")
End If
End If
dbDatabase.CommitTrans
Set objWMIService = Nothing
Set colItems = Nothing
Set objItem = Nothing
Set objProperty = Nothing
Set objSpeech = Nothing
Set dbDatabase = Nothing
Set dynDataInsert = Nothing
Set comDataInsert = Nothing
Set snpData = Nothing
End Sub
Function PingTest(strComputer)
Dim intPosition
Dim objShell
Dim objExec
Dim strLine
Dim strCommand
On Error Resume Next
PingTest = False
Set objShell = CreateObject("wscript.shell")
'command to execute
strCommand = "PING -i 10 -w 10 -n 1 " & strComputer
'Create Exec object
Set objExec = objShell.Exec(strCommand)
'skip lines that contain information about our DNS server
Do While objExec.StdOut.AtEndOfStream <> True
strLine = objExec.StdOut.ReadLine
intPosition = InStr(UCase(strLine), "RECEIVED =")
If intPosition > 0 Then
If InStr(strLine, "TTL expired in transit") = 0 Then
If Trim(Mid(strLine, intPosition + 10, 2)) = "1" Then
PingTest = True
Else
PingTest = False
End If
Else
PingTest = False
End If
Exit Do
End If
Loop
Set objShell = Nothing
Set objExec = Nothing
End Function
Yes, it is that easy… to have the computer talk to you.
Recent Comments