Query Active Directory, WMI, and Upload to Database

23 01 2010

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.


Comments : 2 Comments »

Categories : VBS