Find Process running on all computers in domain

Here's a quick VBScript to search all computers within a domain (technically whichever LDAP object/container you specify as "search root"). It does this by pulling all computers from an AD OU/container, then testing a WMI connection, and finally performing the process search. It'd have been nice to made it all multi-threaded, but i don't think VBScript supports event handlers and such.

FYI, the reason I sub'ed it all out is because of VBScript's crappy error handling.. by doing this I can limit the scope of the error handling to be able to appropriately "go with the flow" if a computer's disconnected, yet still throw errors later on.
Language:
VBScript
Keywords:
ADSI; WMI
Code Snippet

Sub EchoColCount(descr, obj())
  wscript.echo(descr & ": " & ubound(obj)+1 )
End Sub
Sub EchoColContents(descr, obj())
  outMsg = descr & ":" & vbcrlf
  for each Result in obj
    outmsg = outmsg & " " & Result & ","
  Next
  outmsg = left(outmsg, len(outmsg) - 1)
  wscript.echo(outmsg)
End Sub
Sub EchoError(objErr)
  on error resume next
  outmsg = ""
  outmsg = outmsg & "err Num: " & objErr.Number & vbcrlf
  outmsg = outmsg & "Err Src: " & objErr.Source & vbcrlf
  outmsg = outmsg & "Err Desc: " & objErr.Description
  wscript.Echo(outmsg)
End Sub

'''''''''''''''''''' Load computers from AD
dim Comps()
redim Comps(-1)

 
'this is implemented as a sub to allow recursion within OUs, and uses a global list (as opposed to byref array or something)
Sub CollectComputers(LDAPRoot)
  ADQuery = "LDAP://" & LDAPRoot
  'wscript.echo(ADQuery)
  Set colADObj = GetObject(ADQuery)
  For Each objADObj in colADObj
    'wscript.echo " -=" & colADObj.class & "=- "
    if objADObj.class = "organizationalUnit" then
      'wscript.echo "OU Name: " & objADObj.Name & " -==- " & objADObj.AdsPath
      NewQry = objADObj.AdsPath '.Name & ", " & LDAPRoot
      if ucase(Left(NewQry,7)) = "LDAP://" then NewQry = Right(NewQry, Len(NewQry) - 7)
      CollectComputers(NewQry)
    elseif objADObj.class = "computer" then
      redim preserve Comps(ubound(Comps)+1)
      CompName = objADObj.Name
      if ucase(left(CompName,3)) = "CN=" then CompName = Right(CompName,len(CompName) - 3)
        Comps(ubound(Comps)) = CompName
        'Comps(ubound(Comps)) = objADObj.CN
    else
    end if
  Next
End Sub

 
'this one is gold... for domain (NT/lanman name, not Active Dir FQDN) and/or workgroup
Sub CollectComputersWorkgroup(workgroup)
  Dim domain 'As IADsDomain, IADsContainer, IADs
  Dim computer 'As IADsComputer, IADs
 
  Set domain = GetObject("WinNT://" & workgroup)
  domain.Filter = Array("Computer")
 
  For Each computer In domain
    redim preserve Comps(ubound(Comps)+1)
    CompName = computer.Name
    Comps(ubound(Comps)) = CompName
  Next
End Sub
 
'this unfortunately grabs the shares listed in my network places... so not as useful for simple computer names
Sub CollectComputersNetworkNeighborhood
  Const NETHOOD = &H13&
 
  Set objShell = CreateObject("Shell.Application")
  Set objFolder = objShell.Namespace(NETHOOD)
  Set objFolderItem = objFolder.Self
  'Wscript.Echo objFolderItem.Path
  Set colItems = objFolder.Items
  For Each objItem in colItems
    redim preserve Comps(ubound(Comps)+1)
    CompName = objItem.Name
    Comps(ubound(Comps)) = CompName
  Next
End Sub

 
'this one is the same as above, with the addition of "entire network" and "add new network place"... also not useful :(
Sub CollectComputersMyNetworkPlaces
  Const MY_NETWORK_PLACES = &H12&
 
  Set objShell = CreateObject("Shell.Application")
  Set objFolder = objShell.Namespace(MY_NETWORK_PLACES)
  Set objFolderItem = objFolder.Self
  'Wscript.Echo objFolderItem.Path
  Set colItems = objFolder.Items
  For Each objItem in colItems
    redim preserve Comps(ubound(Comps)+1)
    CompName = objItem.Name
    Comps(ubound(Comps)) = CompName
  Next
End Sub

 
'CollectComputersWorkgroup "WORKGROUP"
CollectComputers("DC=Domain, DC=Priv")
EchoColCount "total computers found", Comps
EchoColContents "computers found", Comps
 
''''''''''''''''''''' Check which computers are accessible
dim GoodComputers()
redim GoodComputers(-1)
 
Sub CheckComputers
  on error resume next
  for each objComputer in Comps
    strComputer = objComputer '.CN
    'wscript.Echo objComputer
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    if err.Number = 0 then
      redim preserve GoodComputers(ubound(GoodComputers)+1)
      GoodComputers(ubound(GoodComputers)) = strComputer
    end if
    Set objWMIService = Nothing
  Next
End Sub
 
CheckComputers
EchoColCount "good computer count", GoodComputers
EchoColContents "good computers", GoodComputers
 
'''''''''''''''''''''' collect results
dim Results()
redim Results(-1)
 
Sub CollectResults
  for each objComputer in GoodComputers
    strComputer = objComputer '.CN
    'wscript.Echo objComputer
    on error resume next 'goto SkipComputer
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    if err.Number = 0 then
      Set colItems = objWMIService.ExecQuery _
        ("Select * from Win32_Process Where Name = 'Logo1_.exe' OR Name = 'rundl123.exe'")
      if err.Number <> 0 then EchoError Err
      For Each objItem in colItems
        Wscript.echo(strComputer & " is running " & objItem.Name)
        if err.Number <> 0 then EchoError Err
        redim preserve Results(ubound(Results)+1)
        Results(ubound(Results)) = strComputer
      Next
    end if
  Next
End Sub
 
CollectResults
EchoColContents "Results", Results
 
wscript.echo("done")


Created 2012-02-06
comments powered by Disqus
Login