Mutl-thread wmi/vbs script usage

Reference:
http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_24137674.html#a23659710
How to add a basic limitation, instead of running against the entire domain, how do I set a limit to say the first 100 computers, perhaps aplhabetically. If it's possible to add an exclusion for certain types of object class's ? Maybe even a csv of computer names to exclude?
Also, does the child script just need to do something like
    On Error Resume Next
    arrComputers = Array(".")
    For Each strComputer In arrComputers
In order to work? Or does strComputer or arrComputers need to used a certain way?
-rich
Option Explicit
 
' Searches the domain for computers, executes a child script under a number of seperate processes for each
' batch of computers. Passes computer list to child as a semi-colon delimited list.
' 
' Uses Win32_Process to monitor threads.
'
' Author: Chris Dent
' Last Modified: 17/02/2009
 
Sub UsageText
  Dim strUsage : strUsage = "Usage:" & vbCrLf & vbCrLf
  strUsage = strUsage & WScript.ScriptName & " /ChildScript:<ScriptName> [/FinalScript:<ScriptName>]" & vbCrLf
  strUsage = strUsage & "        [/NumComputers:<Integer>] [/NumThreads:<Integer>]" & vbCrLf
  strUsage = strUsage & "        [/Server:<Name>] [/BaseDN:<Distinguished Name>] [/LDAPFilter:<Filter String>]" & vbCrLf
  strUsage = strUsage & "        [/GlobalCatalog] [/OneLevel]" & vbCrLf & vbCrLf
  strUsage = strUsage & "Required arguments:" & vbCrLf & vbCrlf
  strUsage = strUsage & "    ChildScript       Script to execute as batch job" & vbCrLf & vbCrLf
  strUsage = strUsage & "Optional arguments: " & vbCrlf & vbCrLf
  strUsage = strUsage & "    FinalCommand      Command to execute after all processing is complete." & vbCrLf
  strUsage = strUsage & "    NumComputers      Maximum number of computer objects to assign to each batch. (Default 10)" & vbCrLf
  strUsage = strUsage & "    NumThreads        Maximum number of threads to execute simultaneously. (Default 10)" & vbCrLf
  strUsage = strUsage & "    Server            LDAP server for query. (Default logon server)" & vbCrLf
  strUsage = strUsage & "    BaseDN            Base distinguished name or OU used for search. (Default current domain)" & vbCrLf
  strUsage = strUsage & "    LDAPFilter        LDAP Filter used when performing search. (Default objectClass=computer)" & vbCrLf
  strUsage = strUsage & "    GlobalCatalog     Execute the search against a Global Catalog." & vbCrLf
  strUsage = strUsage & "    OneLevel          Execute the search for this level only (Default subtree)." & vbCrLf
 
  WScript.Echo strUsage
  WScript.Quit
End Sub
 
Function GetArgs
  Dim objArgs : Set objArgs = CreateObject("Scripting.Dictionary")
 
  Dim strChildScript : strChildScript = WScript.Arguments.Named("ChildScript")
  If strChildScript = "" Then
    UsageText
  End If
  Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")  
  If Not objFSO.FileExists(strChildScript) Then
    WScript.Echo "ERROR: Child script not found" & vbCrLf
    UsageText
  End If
  objArgs.Add "ChildScript", strChildScript
  Set objFSO = Nothing
 
  If WScript.Arguments.Named("FinalCommand") <> "" Then
    objArgs.Add "FinalCommand", WScript.Arguments.Named("FinalCommand")
  End If
 
  Dim strNumComputers : strNumComputers = WScript.Arguments.Named("NumComputers")
  If strNumComputers <> "" Then
    If IsNumeric(strNumComputers) Then
      objArgs.Add "NumComputers", CInt(strNumComputers)
    Else
      WScript.Echo "ERROR: NumComputers must be an integer value" & vbCrLf
    End If
  Else
    objArgs.Add "NumComputers", 10
  End If
 
  Dim strNumThreads : strNumThreads = WScript.Arguments.Named("NumThreads")
  If strNumThreads <> "" Then
    If IsNumeric(strNumThreads) Then
      objArgs.Add "NumThreads", CInt(strNumThreads)
    Else
      WScript.Echo "ERROR: NumThreads must be an integer value" & vbCrLf
    End If
  Else
    objArgs.Add "NumThreads", 10
  End If
 
  objArgs.Add "Server", ""  
  If WScript.Arguments.Named("Server") <> "" Then
    objArgs("Server") = WScript.Arguments.Named("Server") & "/"
  End If
 
  If WScript.Arguments.Named("BaseDN") <> "" Then
    objArgs.Add "BaseDN", WScript.Arguments.Named("BaseDN")
  End If
  If Not objArgs.Exists("BaseDN") Then
    Dim objRootDSE : Set objRootDSE = GetObject("LDAP://" & objArgs("Server") & "RootDSE")
    objArgs.Add "BaseDN", objRootDSE.Get("defaultNamingContext")
    Set objRootDSE = Nothing
  End If
 
  objArgs.Add "LDAPFilter", "(objectClass=computer)"
  If WScript.Arguments.Named("LDAPFilter") <> "" Then
    objArgs("LDAPFilter") = WScript.Arguments.Named("LDAPFilter")
  End If
 
  objArgs.Add "Port", "LDAP"
  objArgs.Add "Scope", "subtree"
  
  Dim strArg
  For Each strArg in WScript.Arguments
    If LCase(strArg) = "/globalcatalog" Then
      objArgs("Port") = "GC"
    ElseIf LCase(strArg) = "/onelevel" Then
      objArgs("Scope") = "onelevel"
    End If
  Next
 
  Set GetArgs = objArgs
End Function
 
Function GetComputersFromAD(objArgs)
  ' Returns an array containing all computers in AD. Performed here so we do not have to maintain 
  ' a connection to AD for any longer than necessary. Valid Ports are LDAP or GC.
 
  Dim objConnection : Set objConnection = CreateObject("ADODB.Connection")
  objConnection.Provider = "ADsDSOObject"
  objConnection.Open "Active Directory Provider"
 
  Dim objCommand : Set objCommand = CreateObject("ADODB.Command")
  Set objCommand.ActiveConnection = objConnection
  objCommand.Properties("Page Size") = 1000
 
  objCommand.CommandText = "<" & objArgs("Port") & "://" & objArgs("Server") & objArgs("BaseDN") & _
    ">;" & objArgs("LDAPFilter") & ";" & "name;" & objArgs("Scope")
  
  Dim objRecordSet : Set objRecordSet = objCommand.Execute
 
  Dim arrComputers()
  Dim i : i = 0
 
  Do Until objRecordSet.EOF
    ReDim Preserve arrComputers(i)
    arrComputers(i) = objRecordSet.Fields("name").Value
    i = i + 1
    objRecordSet.MoveNext
  Loop
 
  Set objRecordSet = Nothing
  Set objCommand = Nothing
  Set objConnection = Nothing
 
  GetComputersFromAD = arrComputers
End Function
 
Function BatchGenerator(arrComputers, objArgs)
  Dim intTotalComputers : intTotalComputers = UBound(arrComputers) + 1
  Dim intPerThread : intPerThread = objArgs("NumComputers")
 
  ' Reduce the maximum number per thread if it will leave threads in the pool doing nothing
  If (intTotalComputers / objArgs("NumThreads")) < objArgs("NumComputers") Then
    intPerThread = Round(intTotalComputers / objArgs("NumThreads"))
  End If
 
  Dim intCurrentBatchCount : intCurrentBatchCount = 0
  Dim intBatchNo : intBatchNo = 0
  Dim arrBatches() : ReDim arrBatches(intBatchNo)
  Dim strComputer
  For Each strComputer in arrComputers
    If intCurrentBatchCount = intPerThread Then
      intCurrentBatchCount = 0
      intBatchNo = intBatchNo + 1
      ReDim Preserve arrBatches(intBatchNo)
    End If
 
    intCurrentBatchCount = intCurrentBatchCount + 1
    arrBatches(intBatchNo) = arrBatches(intBatchNo) & strComputer & ";"
  Next
  For intBatchNo = 0 to UBound(arrBatches)
    arrBatches(intBatchNo) = Left(arrBatches(intBatchNo), Len(arrBatches(intBatchNo)) - 1)
  Next
 
  BatchGenerator = arrBatches
End Function
 
Sub ThreadManager(arrBatches, objArgs)
  ' Starts multiple script processes and waits for completion
 
  Dim objShell : Set objShell = CreateObject("WScript.Shell")
 
  ' Execute thread for each batch
  Dim i : i = 0
  Do Until i = (UBound(arrBatches) + 1)
    If GetProcessCount(objArgs("ChildScript")) < objArgs("NumThreads") Then
      WScript.Echo "Starting Batch " & (i + 1) & " of " & (UBound(arrBatches) + 1) 
      objShell.Run "cscript.exe " & objArgs("ChildScript") & " " & arrBatches(i), 0, False
      i = i + 1
    Else
      WScript.Sleep 10000
    End If
  Loop
 
  ' Wait for completion of remaining threads
  Do Until GetProcessCount(objArgs("ChildScript")) = 0
    WScript.Sleep 10000
  Loop
 
  Set objShell = Nothing
End Sub
 
Function GetProcessCount(strChildScript)
  ' Returns the number of cscript or wscript processes executing ChildScript.
 
  Dim objWMI : Set objWMI = GetObject("winmgmts:\\.\root\cimv2")
  Dim colItems : Set colItems = _
    objWMI.ExecQuery("SELECT CommandLine, Name, ProcessId " & _
    "FROM Win32_Process WHERE Name LIKE '_script.exe' AND CommandLine LIKE '% " & _
    strChildScript & " %'")
 
  GetProcessCount = colItems.Count
 
  Set colItems = Nothing
  Set objWMI = Nothing
End Function
 
Sub ExecuteFinal(objArgs)
 
  If objArgs.Exists("FinalCommand") Then
    Dim objShell : Set objShell = CreateObject("WScript.Shell")
    objShell.Run objArgs("FinalCommand"), 0, True
    Set objShell = Nothing
  End If
End Sub
 
'
' Main code
'
 
Dim objArgs : Set objArgs = GetArgs
Dim arrComputers : arrComputers = GetComputersFromAD(objArgs)
Dim arrBatches : arrBatches = BatchGenerator(arrComputers, objArgs)
ThreadManager arrBatches, objArgs
ExecuteFinal(objArgs)

Open in new window

LVL 38
Rich RumbleSecurity SamuraiAsked:
Who is Participating?
 
Chris DentPowerShell DeveloperCommented:
0
 
Chris DentPowerShell DeveloperCommented:

The child script is called like this:

"C:\WINDOWS\system32\cscript.exe" ChildScript.vbs Computer1;Computer2;Computer3;Computer4

That means the child script has to read that argument (it's the only one passed), split the names, then loop as normal. e.g.:

arrComputers = Split(WScript.Arguments(0), ";")
For Each strComputer in arrComputers
  ' .. Do Stuff
Next

In the case of our earlier scripts that was something like:

arrComputers = Split(WScript.Arguments(0), ";")
For Each strComputer in arrComputers
  Ping
  If Pinged
    GetLocalGroupMembers
  End If
Next

Chris
0
 
Chris DentPowerShell DeveloperCommented:

Limiters...

At the moment it accepts BaseDN, Scope (OneLevel or SubTree), Port (LDAP or GC), and an LDAP Filter as arguments.

That makes for a pretty powerful set. Just not many of those mentioned ;)

> instead of running against the entire domain,

BaseDN and OneLevel can reduce the scope of the query. Changing the default Port to GC can increase the scope.

> how do I set a limit to say the first 100 computers

We could add a counter. Does anyone actually use those limits though? After all, you can't select the second 100, so I'm not certain how the return can be very useful. Never saw the point in -limit with dsquery either :)

> perhaps aplhabetically

This one is easy... but only if we change the CommandText to the SQL form which opens up ORDER BY. However, doing so means we lose the LDAP filter and complex filtering becomes much more difficult.

> If it's possible to add an exclusion for certain types of object class's ?

Covered by the LDAP Filter, default filter limits the class to Computer. It is possible to limit the search based on most attributes, including Operating System, etc.

> Maybe even a csv of computer names to exclude?

We could write those into the LDAP filter, that works well if we need to exclude a small number (1 - 5). If we're talking about excluding tens or hundreds can we not exclude those by modifying the base DN or the scope?

Chris
0
Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
Rich RumbleSecurity SamuraiAuthor Commented:
Good points. We'll skip the exclusions. What would one type to use an object group that is buried... Top-Domain -> Severs -> NOC -> Test (test contains 25 servers)
I just did a basic test below, does the child have to create it's own output file?
The script below was a test, but I didn't have it output to a file.
What I ultimately want to do is figure out the permissions assigned to shares. I'm not sure if both NTFS and Share level permissions are able to be enumerated, but I'd like both if possible.
http://msdn.microsoft.com/en-us/library/aa394188.aspx
http://msdn.microsoft.com/en-us/library/aa394176(VS.85).aspx
http://www.experts-exchange.com/Programming/Languages/Visual_Basic/Q_21986624.html
I don't want recursion of groups, but would like the option of passing an option to the child to just show usernames/groups allowed on the share... or like you did with the recursion script last, have two outputs... one is just usernames (groups) for the share, and the other lists the perms each user/group has?
-rich
On Error Resume Next
 
arrComputers = Split(WScript.Arguments(0), ";")
For Each strComputer in arrComputers
' .. Do Stuff
'arrComputers = Array(".")
'For Each strComputer In arrComputers
 
   Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
   Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_BIOS",,48)
   WScript.Echo "Computer: " & strComputer
 
   For Each objItem In colItems
      Wscript.Echo  "<BuildNumber>" & objItem.BuildNumber & "</BuildNumber>"
      Wscript.Echo  "<ReleaseDate>" & WMIDateStringToDate(objItem.ReleaseDate) & "</ReleaseDate>"
      Wscript.Echo  "<Description>" & objItem.Description & "</Description>"
      Wscript.Echo  "<Manufacturer>" & objItem.Manufacturer & "</Manufacturer>"
      Wscript.Echo  "<Name>" & objItem.Name & "</Name>"
      Wscript.Echo  "<SerialNumber>" & objItem.SerialNumber & "</SerialNumber>"
      Wscript.Echo  "<Status>" & objItem.Status & "</Status>"
      Wscript.Echo  "<Version>" & objItem.Version & "</Version>"
   Next
Next'

Open in new window

0
 
Rich RumbleSecurity SamuraiAuthor Commented:
test is actually "test group" with 25 servers in it... will the space make a difference?
-rich
0
 
Chris DentPowerShell DeveloperCommented:

> will the space make a difference?

Yes :)

We'd create an LDAP filter that returns only computers that belong to that group. For example:

/LDAPFilter:"(&(objectClass=computer)(memberOf=CN=test group,OU=NOC,OU=Servers,DC=Top-Domain))"

Assuming that Test Group is really a group object with members. If it were an OU we would set Base DN instead:

/BaseDN:"OU=Test Group,OU=NOC,OU=Servers,DC=Top-Domain"

Top-Domain should be replaced with the full domain component path in each case. For "domain.com" that would be "DC=domain,DC=com".

> I just did a basic test below, does the child have to create it's own output file?

Yes. The script above is only responsible for finding the systems to search and executing the child scripts then any final script. Continuing the previous question I would have added a new FinalScript which would gather up all the .results files, combine them and do all the rest of the bits we needed.

I have to go to do some exercise in a minute, but I should be able to put together something to deal with this by the end of tomorrow.

Chris
0
 
Rich RumbleSecurity SamuraiAuthor Commented:
Cool, thought so... this is a very interesting process I think, these kinds of scripts could help admins do a lot of work a lot faster!
-rich
0
 
Chris DentPowerShell DeveloperCommented:

Okay so today was a bit ambitious.

Forgot quite how much you have to account for when enumerating permissions :)

Chris
0
 
Rich RumbleSecurity SamuraiAuthor Commented:
Yeah, I thought it might be tougher... if it's any easier, I'd only want output for permissions they have enabled... but it's probably just as easy to do them all at once anyway. I will want to add other routines into the child script, to do a basic inventory while I'm at it. The output is a question I have, how do I get it to output a file name like result1, result2 for process 1 and process 2 etc... or how can all the process's dump to one file, which is what I'd prefer ultimately.
-rich
0
 
Chris DentPowerShell DeveloperCommented:

Okay, well while you're waiting I'll give you the completed versions of the previous script (after a bit of playing this morning).

The command to execute the scripts (the filter can change depending on your requirements):

cscript MultiThead.vbs /ChildScript:GetLocalGroupsChild.vbs /FinalCommand:GetLocalGroupsFinal.vbs /LDAPFilter:"(&(objectClass=computer)(frscomputerreferencebl=*))"

The changes are minor and only to Multithread, each is logged at the top of the script. Mostly to allow me to watch the processes start and finish (hard-coded constants to enable / disable that) :)

I also included the child template, it's what the script to enumerate permissions uses as a base.

Chris
Multithread.txt
GetLocalGroupsChild.txt
GetLocalGroupsFinal.txt
ChildTemplate.txt
0
 
Rich RumbleSecurity SamuraiAuthor Commented:
Ok so that just did the GC's, very well I might add. I've tried to do a basic win32_bios in the childtemplate, changing the wscript.echos to strOutput = strOutput & but no output/results files...
-rich
0
 
Chris DentPowerShell DeveloperCommented:

Not to worry, I can put that one together tomorrow which should let us debug it properly.

Chris
0
 
Chris DentPowerShell DeveloperCommented:

Here's a working child script for the BIOS enumeration above.

Chris
Option Explicit
 
Function Ping(strComputer)
  Dim objShell : Set objShell = CreateObject("WScript.Shell")
  Dim booCode : booCode = objShell.Run("Ping -n 3 -w 1000 " & strComputer, 0, True)
  If booCode = 0 Then
    Ping = True
  Else
    Ping = False
  End If
End Function
 
Function WMIDateStringToDate(dtmDate)
  WMIDateStringToDate = CDate(Mid(dtmDate, 5, 2) & "/" & _
    Mid(dtmDate, 7, 2) & "/" & Left(dtmDate, 4) _
    & " " & Mid (dtmDate, 9, 2) & ":" & Mid(dtmDate, 11, 2) & ":" & Mid(dtmDate,13, 2))
End Function
 
'
' Main code
'
 
Dim objArgs : Set objArgs = WScript.Arguments
Dim strComputers : strComputers = objArgs(0)
Dim strThreadNumber : strThreadNumber = objArgs(1)
 
Dim strOutput : strOutput = ""
 
Dim arrComputers : arrComputers = Split(strComputers, ";")
Dim strComputer
For Each strComputer In arrComputers
  If Ping(strComputer) = True Then
    strOutput = strOutput & "<Computer>" & vbCrLf & "<ComputerName>" & _
      strComputer & "</ComputerName>" & vbCrlf
    strOutput = strOutput & "<Status>Alive</Status>" & vbCrLf
 
    ' User defined code here
 
    Dim objWMIService : Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
    Dim colItems : Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_BIOS", "WQL", 48)
 
    Dim objItem
    For Each objItem In colItems
      strOutput = strOutput & "<BuildNumber>" & objItem.BuildNumber & "</BuildNumber>" & vbCrLf
      strOutput = strOutput & "<ReleaseDate>" & WMIDateStringToDate(objItem.ReleaseDate) & "</ReleaseDate>" & vbCrLf
      strOutput = strOutput & "<Description>" & objItem.Description & "</Description>" & vbCrLf
      strOutput = strOutput & "<Manufacturer>" & objItem.Manufacturer & "</Manufacturer>" & vbCrLf
      strOutput = strOutput & "<Name>" & objItem.Name & "</Name>" & vbCrLf
      strOutput = strOutput & "<SerialNumber>" & objItem.SerialNumber & "</SerialNumber>" & vbCrLf
      strOutput = strOutput & "<BIOSStatus>" & objItem.Status & "</BIOSStatus>" & vbCrLf
      strOutput = strOutput & "<Version>" & objItem.Version & "</Version>" & vbCrLf
    Next
 
    Set colItems = Nothing
    Set objWMIService = Nothing
 
    ' End of user defined code
 
    strOutput = strOutput & "</Computer>" & vbCrLf
 
  Else
    strOutput = strOutput & "<Computer>" & vbCrLf & _
      "<ComputerName>" & strComputer & "</ComputerName>" & vbCrlf & "<Status>NoResponse</Status>" & vbCrLf & _
      "</Computer>" & vbCrLf
  End If
Next
 
Dim objFileSystem : Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Dim objFile : Set objFile = objFileSystem.OpenTextFile(strThreadNumber & ".results", 2, True, 0)
 
objFile.Write strOutput
 
Set objFile = Nothing
Set objFileSystem = Nothing

Open in new window

0
 
Chris DentPowerShell DeveloperCommented:

And a working version of the child script for enumeration of shares. I wish I could read and list the share permissions as well, but it's not looking promising (WMI provides access to create, delete and change, but not to read).

Can you let me know any thoughts you have on the output I'm generating here?

Cheers,

Chris
Option Explicit
 
' WMI Constants
 
Const WBEM_RETURN_IMMEDIATELY = &h10
Const WBEM_FORWARD_ONLY = &h20
 
' Constants and storage arrays for Permission settings
 
' GetSecurityDescriptor Return values (http://msdn.microsoft.com/en-us/library/aa390773(VS.85).aspx)
 
Dim objReturnCodes : Set objReturnCodes = CreateObject("Scripting.Dictionary")
Const SUCCESS = 0
Const ACCESS_DENIED = 2
Const UNKNOWN_FAILURE = 8
Const PRIVILEGE_MISSING = 9
Const INVALID_PARAMETER = 21
 
' Security Descriptor Control Flags (http://msdn.microsoft.com/en-us/library/aa394180(VS.85).aspx)
 
Dim objControlFlags : Set objControlFlags = CreateObject("Scripting.Dictionary")
objControlFlags.Add 32768, "SelfRelative"
objControlFlags.Add 8192, "SACLProtected"
objControlFlags.Add 4096, "DACLProtected"
objControlFlags.Add 2048, "SACLAutoInherited"
objControlFlags.Add 1024, "DACLAutoInherited"
objControlFlags.Add 512, "SACLAutoInheritedReq"
objControlFlags.Add 256, "DACLAutoInheritedReq"
objControlFlags.Add 32, "SACLDefaulted"
objControlFlags.Add 16, "SACLPresent"
objControlFlags.Add 8, "DACLDefaulted"
objControlFlags.Add 4, "DACLPresent"
objControlFlags.Add 2, "GroupDefaulted"
objControlFlags.Add 1, "OwnerDefaulted"
 
' ACE Access Rights (System.Enum: System.Security.AccessControl.FileSystemRights)
 
Dim objAccessRights : Set objAccessRights = CreateObject("Scripting.Dictionary")
objAccessRights.Add 2032127, "FullControl"
objAccessRights.Add 1048576, "Synchronize"
objAccessRights.Add 524288, "TakeOwnership"
objAccessRights.Add 262144, "ChangePermissions"
objAccessRights.Add 197055, "Modify"
objAccessRights.Add 131241, "ReadAndExecute"
objAccessRights.Add 131209, "Read"
objAccessRights.Add 131072, "ReadPermissions"
objAccessRights.Add 65536, "Delete"
objAccessRights.Add 278, "Write"
objAccessRights.Add 256, "WriteAttributes"
objAccessRights.Add 128, "ReadAttributes"
objAccessRights.Add 64, "DeleteSubdirectoriesAndFiles"
objAccessRights.Add 32, "ExecuteFile"
objAccessRights.Add 16, "WriteExtendedAttributes"
objAccessRights.Add 8, "ReadExtendedAttributes"
objAccessRights.Add 4, "AppendData"
objAccessRights.Add 2, "CreateFiles"
objAccessRights.Add 1, "ReadData"
 
' ACE Types (System.Enum: System.Security.AccessControl.FileSystemRights)
 
Dim objAceTypes : Set objAceTypes = CreateObject("Scripting.Dictionary")
objAceTypes.Add 0, "Allow"
objAceTypes.Add 1, "Deny"
objAceTypes.Add 2, "Audit"
 
' ACE Flags
 
Dim objAceFlags : Set objAceFlags = CreateObject("Scripting.Dictionary")
objAceFlags.Add 128, "FailedAccess"
objAceFlags.Add 64, "SuccessfulAccess"
objAceFlags.Add 31, "ValidInheritFlags"
objAceFlags.Add 16, "Inherited"
objAceFlags.Add 8, "InheritOnly"
objAceFlags.Add 4, "NoPropagateInherit"
objAceFlags.Add 2, "ContainerInherit"
objAceFlags.Add 1, "ObjectInherit"
 
Function Ping(strComputer)
  Dim objShell : Set objShell = CreateObject("WScript.Shell")
  Dim booCode : booCode = objShell.Run("Ping -n 3 -w 1000 " & strComputer, 0, True)
  If booCode = 0 Then
    Ping = True
  Else
    Ping = False
  End If
End Function
 
Function EnumNTFSSecurity(objWMI, strPath)
  ' Reads an NTFS Security Descriptor and returns it in XML form.
 
  Dim objSecuritySettings : Set objSecuritySettings = objWMI.Get("Win32_LogicalFileSecuritySetting='" & strPath & "'")
  Dim objSD : objSecuritySettings.GetSecurityDescriptor objSD
 
  Dim strDomain : strDomain = objSD.Owner.Domain
  If strDomain <> "" Then strDomain = strDomain & "\"
  Dim strReturn : strReturn = "<Owner>" & strDomain & objSD.Owner.Name & "</Owner>" & vbCrLf
 
  Dim dblControlFlags : dblControlFlags = objSD.ControlFlags : Dim dblFlag
  strReturn = strReturn & "<ControlFlagsNumeric>" & dblControlFlags & "</ControlFlagsNumeric>" & vbCrLf
  strReturn = strReturn & "<ControlFlags>"
  For Each dblFlag in objControlFlags
    If dblControlFlags >= dblFlag Then
      strReturn = strReturn & objControlFlags(dblFlag) & ","
      dblControlFlags = dblControlFlags - dblFlag
    End If
  Next
  If objSD.ControlFlags > 0 Then
    strReturn = Left(strReturn, Len(strReturn) - 1) 
  End If
  strReturn = strReturn & "</ControlFlags>" & vbCrLf
 
  ' Enumerate DACL
 
  strReturn = strReturn & "<DACL>" & vbCrLf
 
  Dim objAce
  For Each objAce in objSD.dACL
    strReturn = strReturn & EnumAce(objAce)
  Next
  strReturn = strReturn & "</DACL>" & vbCrLf
 
  ' Enumerate SACL
 
  strReturn = strReturn & "<SACL>" & vbCrLf
  If Not IsNull(objSD.sACL) Then
    For Each objAce in objSD.sACL
      strReturn = strReturn & EnumAce(objAce)
    Next
  End If
  strReturn = strReturn & "</SACL>" & vbCrLf
 
  EnumNTFSSecurity = strReturn
End Function
 
Function EnumAce(objAce)
  Dim strReturn : strReturn = "<ACE>" & vbCrLf
 
  Dim strDomain : strDomain = objAce.Trustee.Domain
  If strDomain <> "" Then strDomain = strDomain & "\"
  strReturn = strReturn & "<Trustee>" & strDomain & objAce.Trustee.Name & "</Trustee>" & vbCrLf
 
  Dim dblAccessMask : dblAccessMask = objAce.AccessMask : Dim dblAccess
  strReturn = strReturn & "<AccessMaskNumeric>" & dblAccessMask & "</AccessMaskNumeric>" & vbCrLf
 
  strReturn = strReturn & "<AccessMask>"
  For Each dblAccess in objAccessRights
    If dblAccessMask >= dblAccess Then
      strReturn = strReturn & objAccessRights(dblAccess) & ","
      dblAccessMask = dblAccessMask - dblAccess
    End If
  Next
  If objAce.AccessMask > 0 Then
    strReturn = Left(strReturn, Len(strReturn) - 1)
  End If
  strReturn = strReturn & "</AccessMask>" & vbCrLf
 
  strReturn = strReturn & "<ACETypeNumeric>" & objAce.AceType & "</ACETypeNumeric>" & vbCrLf
  strReturn = strReturn & "<ACEType>" & objAceTypes(objAce.AceType) & "</ACEType>" & vbCrLf
 
  Dim dblAceFlags : dblAceFlags = objAce.AceFlags : Dim dblFlag
  strReturn = strReturn & "<ACEFlagsNumeric>" & dblAceFlags & "</ACEFlagsNumeric>" & vbCrLf
  strReturn = strReturn & "<ACEFlags>"
  For Each dblFlag in objAceFlags
    If dblAceFlags >= dblFlag Then
      strReturn = strReturn & objAceFlags(dblFlag) & ","
      dblAceFlags = dblAceFlags - dblFlag
    End If
  Next
  If objAce.AceFlags > 0 Then
    strReturn = Left(strReturn, Len(strReturn) - 1)
  End If
  strReturn = strReturn & "</ACEFlags>" & vbCrLf & "</ACE>" & vbCrlf
 
  EnumAce = strReturn
End Function
 
'
' Main code
'
 
Dim objArgs : Set objArgs = WScript.Arguments
Dim strComputers : strComputers = objArgs(0)
Dim strThreadNumber : strThreadNumber = objArgs(1)
 
Dim strOutput : strOutput = ""
 
Dim arrComputers : arrComputers = Split(strComputers, ";")
Dim strComputer
For Each strComputer In arrComputers
  If Ping(strComputer) = True Then
    strOutput = strOutput & "<Computer>" & vbCrLf & "<ComputerName>" & _
      strComputer & "</ComputerName>" & vbCrlf
    strOutput = strOutput & "<Status>Alive</Status>" & vbCrLf
 
    Dim objWMI : Set objWMI = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
    Dim colItems : Set colItems = objWMI.ExecQuery("SELECT * FROM Win32_Share", "WQL",_
      WBEM_RETURN_IMMEDIATELY + WBEM_FORWARD_ONLY)
 
    strOutput = strOutput & "<Shares>" & vbCrLf
 
    Dim objItem
    For Each objItem in colItems
      strOutput = strOutput & "<Share>" & vbCrLf
      strOutput = strOutput & "<ShareName>" & objItem.Name & "</ShareName>" & vbCrLf
      strOutput = strOutput & "<LocalPath>" & objItem.Path & "</LocalPath>"
      strOutput = strOutput & "<Description>" & objItem.Description & "</Description>" & vbCrLf
 
      ' Types do not strictly conform to values in http://msdn.microsoft.com/en-us/library/aa394435(VS.85).aspx
      ' VbScript will not display uint32 values in quite the same way.
 
      strOutput = strOutput & "<TypeNumeric>" & objItem.Type & "</TypeNumeric>" & vbCrLf
 
      Dim strType : strType = ""
      Select Case objItem.Type
        Case 0 : strType = "Disk Drive"
        Case 1 : strType = "Print Queue"
        Case 2 : strType = "Device"
        Case 3 : strType = "IPC"
        Case -2147483648 : strType = "Disk Drive Admin"
        Case -2147483649 : strType = "Print Queue Admin"
        Case -2147483650 : strType = "Device Admin"
        Case -2147483645 : strType = "IPC Admin"
      End Select
 
      strOutput = strOutput & "<Type>" & strType & "</Type>" & vbCrLf
      strOutput = strOutput & "<ShareStatus>" & objItem.Status & "</ShareStatus>" & vbCrLf
 
      If objItem.Type = "0" Or objItem.Type = "-2147483648" Then
        strOutput = strOutput & "<NTFSSecurity>" & EnumNTFSSecurity(objWMI, objItem.Path) & "</NTFSSecurity>" & vbCrLf
      End If
 
      strOutput = strOutput & "</Share>" & vbCrLf
    Next
    Set objWMI = Nothing
 
    strOutput = strOutput & "</Shares>" & vbCrLf
    strOutput = strOutput & "</Computer>" & vbCrLf
 
  Else
 
    strOutput = strOutput & "<Computer>" & vbCrLf & _
      "<ComputerName>" & strComputer & "</ComputerName>" & vbCrlf & "<Status>NoResponse</Status>" & vbCrLf & _
      "</Computer>" & vbCrLf
  End If
Next
 
Dim objFileSystem : Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Dim objFile : Set objFile = objFileSystem.OpenTextFile(strThreadNumber & ".results", 2, True, 0)
 
objFile.Write strOutput
 
Set objFile = Nothing
Set objFileSystem = Nothing

Open in new window

0
 
Chris DentPowerShell DeveloperCommented:

Just in case...

Both of the above will need a final script to combine the results into a single file (in the same way as we've done for the group report).

Chris
0
 
Chris DentPowerShell DeveloperCommented:

Ignore the bit about being unable to enumerate Share permissions. Missed the Win32_LogicalShareSecurity class. It's much better now.

Chris
Option Explicit
 
' WMI Constants
 
Const WBEM_RETURN_IMMEDIATELY = &h10
Const WBEM_FORWARD_ONLY = &h20
 
' Constants and storage arrays for Permission settings
 
' GetSecurityDescriptor Return values (http://msdn.microsoft.com/en-us/library/aa390773(VS.85).aspx)
 
Dim objReturnCodes : Set objReturnCodes = CreateObject("Scripting.Dictionary")
Const SUCCESS = 0
Const ACCESS_DENIED = 2
Const UNKNOWN_FAILURE = 8
Const PRIVILEGE_MISSING = 9
Const INVALID_PARAMETER = 21
 
' Security Descriptor Control Flags (http://msdn.microsoft.com/en-us/library/aa394180(VS.85).aspx)
 
Dim objControlFlags : Set objControlFlags = CreateObject("Scripting.Dictionary")
objControlFlags.Add 32768, "SelfRelative"
objControlFlags.Add 8192, "SACLProtected"
objControlFlags.Add 4096, "DACLProtected"
objControlFlags.Add 2048, "SACLAutoInherited"
objControlFlags.Add 1024, "DACLAutoInherited"
objControlFlags.Add 512, "SACLAutoInheritedReq"
objControlFlags.Add 256, "DACLAutoInheritedReq"
objControlFlags.Add 32, "SACLDefaulted"
objControlFlags.Add 16, "SACLPresent"
objControlFlags.Add 8, "DACLDefaulted"
objControlFlags.Add 4, "DACLPresent"
objControlFlags.Add 2, "GroupDefaulted"
objControlFlags.Add 1, "OwnerDefaulted"
 
' ACE Access Rights (System.Enum: System.Security.AccessControl.FileSystemRights)
 
Dim objAccessRights : Set objAccessRights = CreateObject("Scripting.Dictionary")
objAccessRights.Add 2032127, "FullControl"
objAccessRights.Add 1048576, "Synchronize"
objAccessRights.Add 524288, "TakeOwnership"
objAccessRights.Add 262144, "ChangePermissions"
objAccessRights.Add 197055, "Modify"
objAccessRights.Add 131241, "ReadAndExecute"
objAccessRights.Add 131209, "Read"
objAccessRights.Add 131072, "ReadPermissions"
objAccessRights.Add 65536, "Delete"
objAccessRights.Add 278, "Write"
objAccessRights.Add 256, "WriteAttributes"
objAccessRights.Add 128, "ReadAttributes"
objAccessRights.Add 64, "DeleteSubdirectoriesAndFiles"
objAccessRights.Add 32, "ExecuteFile"
objAccessRights.Add 16, "WriteExtendedAttributes"
objAccessRights.Add 8, "ReadExtendedAttributes"
objAccessRights.Add 4, "AppendData"
objAccessRights.Add 2, "CreateFiles"
objAccessRights.Add 1, "ReadData"
 
' ACE Types (System.Enum: System.Security.AccessControl.FileSystemRights)
 
Dim objAceTypes : Set objAceTypes = CreateObject("Scripting.Dictionary")
objAceTypes.Add 0, "Allow"
objAceTypes.Add 1, "Deny"
objAceTypes.Add 2, "Audit"
 
' ACE Flags
 
Dim objAceFlags : Set objAceFlags = CreateObject("Scripting.Dictionary")
objAceFlags.Add 128, "FailedAccess"
objAceFlags.Add 64, "SuccessfulAccess"
objAceFlags.Add 31, "ValidInheritFlags"
objAceFlags.Add 16, "Inherited"
objAceFlags.Add 8, "InheritOnly"
objAceFlags.Add 4, "NoPropagateInherit"
objAceFlags.Add 2, "ContainerInherit"
objAceFlags.Add 1, "ObjectInherit"
 
Function Ping(strComputer)
  Dim objShell : Set objShell = CreateObject("WScript.Shell")
  Dim booCode : booCode = objShell.Run("Ping -n 3 -w 1000 " & strComputer, 0, True)
  If booCode = 0 Then
    Ping = True
  Else
    Ping = False
  End If
End Function
 
Function EnumNTFSSecurity(objWMI, strPath)
  ' Reads an NTFS Security Descriptor and returns it in XML form.
 
  Dim objSecuritySettings : Set objSecuritySettings = objWMI.Get("Win32_LogicalFileSecuritySetting='" & strPath & "'")
  Dim objSD : objSecuritySettings.GetSecurityDescriptor objSD
 
  Dim strDomain : strDomain = objSD.Owner.Domain
  If strDomain <> "" Then strDomain = strDomain & "\"
  Dim strReturn : strReturn = "<Owner>" & strDomain & objSD.Owner.Name & "</Owner>" & vbCrLf
 
  Dim dblControlFlags : dblControlFlags = objSD.ControlFlags : Dim dblFlag
  strReturn = strReturn & "<ControlFlagsNumeric>" & dblControlFlags & "</ControlFlagsNumeric>" & vbCrLf
  strReturn = strReturn & "<ControlFlags>"
  For Each dblFlag in objControlFlags
    If dblControlFlags >= dblFlag Then
      strReturn = strReturn & objControlFlags(dblFlag) & ","
      dblControlFlags = dblControlFlags - dblFlag
    End If
  Next
  If objSD.ControlFlags > 0 Then
    strReturn = Left(strReturn, Len(strReturn) - 1) 
  End If
  strReturn = strReturn & "</ControlFlags>" & vbCrLf
 
  ' Enumerate DACL
 
  strReturn = strReturn & "<DACL>" & vbCrLf
 
  Dim objAce
  For Each objAce in objSD.dACL
    strReturn = strReturn & EnumAce(objAce)
  Next
  strReturn = strReturn & "</DACL>" & vbCrLf
 
  ' Enumerate SACL
 
  strReturn = strReturn & "<SACL>" & vbCrLf
  If Not IsNull(objSD.sACL) Then
    For Each objAce in objSD.sACL
      strReturn = strReturn & EnumAce(objAce)
    Next
  End If
  strReturn = strReturn & "</SACL>" & vbCrLf
 
  EnumNTFSSecurity = strReturn
End Function
 
Function EnumShareSecurity(objWMI, strName)
  ' Reads a Share Security Descriptor and returns it in XML form.
 
  Dim objSecuritySettings : Set objSecuritySettings = objWMI.Get("Win32_LogicalShareSecuritySetting='" & strName & "'")
  Dim objSD : objSecuritySettings.GetSecurityDescriptor objSD
 
  Dim dblControlFlags : dblControlFlags = objSD.ControlFlags : Dim dblFlag
  Dim strReturn : strReturn = strReturn & "<ControlFlagsNumeric>" & dblControlFlags & "</ControlFlagsNumeric>" & vbCrLf
  strReturn = strReturn & "<ControlFlags>"
  For Each dblFlag in objControlFlags
    If dblControlFlags >= dblFlag Then
      strReturn = strReturn & objControlFlags(dblFlag) & ","
      dblControlFlags = dblControlFlags - dblFlag
    End If
  Next
  If objSD.ControlFlags > 0 Then
    strReturn = Left(strReturn, Len(strReturn) - 1) 
  End If
  strReturn = strReturn & "</ControlFlags>" & vbCrLf
 
  ' Enumerate DACL
 
  strReturn = strReturn & "<DACL>" & vbCrLf
 
  Dim objAce
  For Each objAce in objSD.dACL
    strReturn = strReturn & EnumAce(objAce)
  Next
  strReturn = strReturn & "</DACL>" & vbCrLf
 
  EnumShareSecurity = strReturn
End Function
 
Function EnumAce(objAce)
  Dim strReturn : strReturn = "<ACE>" & vbCrLf
 
  Dim strDomain : strDomain = objAce.Trustee.Domain
  If strDomain <> "" Then strDomain = strDomain & "\"
  strReturn = strReturn & "<Trustee>" & strDomain & objAce.Trustee.Name & "</Trustee>" & vbCrLf
 
  Dim dblAccessMask : dblAccessMask = objAce.AccessMask : Dim dblAccess
  strReturn = strReturn & "<AccessMaskNumeric>" & dblAccessMask & "</AccessMaskNumeric>" & vbCrLf
 
  strReturn = strReturn & "<AccessMask>"
  For Each dblAccess in objAccessRights
    If dblAccessMask >= dblAccess Then
      strReturn = strReturn & objAccessRights(dblAccess) & ","
      dblAccessMask = dblAccessMask - dblAccess
    End If
  Next
  If objAce.AccessMask > 0 Then
    strReturn = Left(strReturn, Len(strReturn) - 1)
  End If
  strReturn = strReturn & "</AccessMask>" & vbCrLf
 
  strReturn = strReturn & "<ACETypeNumeric>" & objAce.AceType & "</ACETypeNumeric>" & vbCrLf
  strReturn = strReturn & "<ACEType>" & objAceTypes(objAce.AceType) & "</ACEType>" & vbCrLf
 
  Dim dblAceFlags : dblAceFlags = objAce.AceFlags : Dim dblFlag
  strReturn = strReturn & "<ACEFlagsNumeric>" & dblAceFlags & "</ACEFlagsNumeric>" & vbCrLf
  strReturn = strReturn & "<ACEFlags>"
  For Each dblFlag in objAceFlags
    If dblAceFlags >= dblFlag Then
      strReturn = strReturn & objAceFlags(dblFlag) & ","
      dblAceFlags = dblAceFlags - dblFlag
    End If
  Next
  If objAce.AceFlags > 0 Then
    strReturn = Left(strReturn, Len(strReturn) - 1)
  End If
  strReturn = strReturn & "</ACEFlags>" & vbCrLf & "</ACE>" & vbCrlf
 
  EnumAce = strReturn
End Function
 
'
' Main code
'
 
Dim objArgs : Set objArgs = WScript.Arguments
Dim strComputers : strComputers = objArgs(0)
Dim strThreadNumber : strThreadNumber = objArgs(1)
 
Dim strOutput : strOutput = ""
 
Dim arrComputers : arrComputers = Split(strComputers, ";")
Dim strComputer
For Each strComputer In arrComputers
  If Ping(strComputer) = True Then
    strOutput = strOutput & "<Computer>" & vbCrLf & "<ComputerName>" & _
      strComputer & "</ComputerName>" & vbCrlf
    strOutput = strOutput & "<Status>Alive</Status>" & vbCrLf
 
    Dim objWMI : Set objWMI = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
    Dim colItems : Set colItems = objWMI.ExecQuery("SELECT * FROM Win32_Share", "WQL",_
      WBEM_RETURN_IMMEDIATELY + WBEM_FORWARD_ONLY)
 
    strOutput = strOutput & "<Shares>" & vbCrLf
 
    Dim objItem
    For Each objItem in colItems
      strOutput = strOutput & "<Share>" & vbCrLf
      strOutput = strOutput & "<ShareName>" & objItem.Name & "</ShareName>" & vbCrLf
      strOutput = strOutput & "<LocalPath>" & objItem.Path & "</LocalPath>"
      strOutput = strOutput & "<Description>" & objItem.Description & "</Description>" & vbCrLf
 
      ' Types do not strictly conform to values in http://msdn.microsoft.com/en-us/library/aa394435(VS.85).aspx
      ' VbScript will not display uint32 values in quite the same way.
 
      strOutput = strOutput & "<TypeNumeric>" & objItem.Type & "</TypeNumeric>" & vbCrLf
 
      Dim strType : strType = ""
      Select Case objItem.Type
        Case 0 : strType = "Disk Drive"
        Case 1 : strType = "Print Queue"
        Case 2 : strType = "Device"
        Case 3 : strType = "IPC"
        Case -2147483648 : strType = "Disk Drive Admin"
        Case -2147483649 : strType = "Print Queue Admin"
        Case -2147483650 : strType = "Device Admin"
        Case -2147483645 : strType = "IPC Admin"
      End Select
 
      strOutput = strOutput & "<Type>" & strType & "</Type>" & vbCrLf
      strOutput = strOutput & "<ShareStatus>" & objItem.Status & "</ShareStatus>" & vbCrLf
 
      If objItem.Type = "0" Or objItem.Type = "-2147483648" Then
        strOutput = strOutput & "<NTFSSecurity>" & EnumNTFSSecurity(objWMI, objItem.Path) & "</NTFSSecurity>" & vbCrLf
      End If
 
      If objItem.Type = 0 Then
        strOutput = strOutput & "<ShareSecurity>" & EnumShareSecurity(objWMI, objItem.Name) & "</ShareSecurity>" & vbCrLf
      End If
 
      strOutput = strOutput & "</Share>" & vbCrLf
    Next
    Set objWMI = Nothing
 
    strOutput = strOutput & "</Shares>" & vbCrLf
    strOutput = strOutput & "</Computer>" & vbCrLf
 
  Else
 
    strOutput = strOutput & "<Computer>" & vbCrLf & _
      "<ComputerName>" & strComputer & "</ComputerName>" & vbCrlf & "<Status>NoResponse</Status>" & vbCrLf & _
      "</Computer>" & vbCrLf
  End If
Next
 
Dim objFileSystem : Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Dim objFile : Set objFile = objFileSystem.OpenTextFile(strThreadNumber & ".results", 2, True, 0)
 
objFile.Write strOutput
 
Set objFile = Nothing
Set objFileSystem = Nothing

Open in new window

0
 
Rich RumbleSecurity SamuraiAuthor Commented:
You are a machine! I'm going to test now.
-rich
0
 
Chris DentPowerShell DeveloperCommented:

A couple more updates in the attached. This set of commands will execute the attached.

Thread Testing:

cscript MultiThread.vbs /ChildScript:ChildTest.vbs

Local Groups:

cscript MultiThead.vbs /ChildScript:GetLocalGroupsChild.vbs /FinalCommand:GetLocalGroupsFinal.vbs /LDAPFilter:"(&(objectClass=computer)(frscomputerreferencebl=*))"

Shares:

cscript MultiThread.vbs /ChildScript:GetSharesChild.vbs /FinalCommand:"CollateResults.vbs Shares.xml Shares.dtd"

BIOS Settings:

cscript MultiThread.vbs /ChildScript:GetBIOSSettingsChild.vbs /FinalCommand:"CollateResults.vbs BIOSSettings.xml BIOSSettings.dtd"

Chris
Multithread.txt
0
 
Rich RumbleSecurity SamuraiAuthor Commented:
I changed the sharechild script a little to filter out ipc,admin and the default (c$) shares
Lines 229 and 230 to:
Dim colItems : Set colItems = objWMI.ExecQuery("SELECT * FROM Win32_Share WHERE Type = '0'",,48 )
The ,,48 I think is shorthand for
"WQL", WBEM_RETURN_IMMEDIATELY + WBEM_FORWARD_ONLY
http://msdn.microsoft.com/en-us/library/aa393980.aspx
I'm going to work on these a bit, you've more than answered the question... is there a way to run against 1 computer by name with the filter, just for test purposes?
-rich
0
 
Chris DentPowerShell DeveloperCommented:

Fair enough :) I was hoping to get the Share Security Descriptor for the admin shares, but it died on me so admin shares only return a basic amount of information anyway.

Yeah, 48 is short-hand for those. I normally include the constant names for clarity rather than length :)

And finally, yes :)

/LDAPFilter:"(&(objectClass=computer)(name=PCName))"

Otherwise you can just fire the child script off on its own with:

cscript ChildScript.vbs PCName 1

Where 1 is just an arbitrary thread number.

Chris
0
 
Rich RumbleSecurity SamuraiAuthor Commented:
Nice! I didn't realize... but that makes sense! Wow... there aren't enough points! Thanks a million, I'll award now.
-rich
0
 
Rich RumbleSecurity SamuraiAuthor Commented:
This is truly a great script, quality, quality stuff!
-rich
0
 
Chris DentPowerShell DeveloperCommented:

Glad it all worked :)

Chris
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.