Rich Rumble
asked on
Mutl-thread wmi/vbs script usage
Reference:
https://www.experts-exchange.com/questions/24137674/speed-up-group-membership.html?anchorAnswerId=23659710#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
https://www.experts-exchange.com/questions/24137674/speed-up-group-membership.html?anchorAnswerId=23659710#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)
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
ASKER
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
https://www.experts-exchange.com/questions/21986624/Combine-these-two-WSH-scripts.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
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
https://www.experts-exchange.com/questions/21986624/Combine-these-two-WSH-scripts.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'
ASKER
test is actually "test group" with 25 servers in it... will the space make a difference?
-rich
-rich
> 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:"(&(objectClas
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 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
ASKER
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
-rich
Okay so today was a bit ambitious.
Forgot quite how much you have to account for when enumerating permissions :)
Chris
ASKER
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
-rich
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:GetLocalGroup
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
ASKER
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
-rich
Not to worry, I can put that one together tomorrow which should let us debug it properly.
Chris
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
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
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
Ignore the bit about being unable to enumerate Share permissions. Missed the Win32_LogicalShareSecurity
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
ASKER
You are a machine! I'm going to test now.
-rich
-rich
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:GetLocalGroup
Shares:
cscript MultiThread.vbs /ChildScript:GetSharesChil
BIOS Settings:
cscript MultiThread.vbs /ChildScript:GetBIOSSettin
Chris
Multithread.txt
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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
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
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:"(&(objectClas
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
ASKER
Nice! I didn't realize... but that makes sense! Wow... there aren't enough points! Thanks a million, I'll award now.
-rich
-rich
ASKER
This is truly a great script, quality, quality stuff!
-rich
-rich
Glad it all worked :)
Chris
The child script is called like this:
"C:\WINDOWS\system32\cscri
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