dUkk

'==============================================================================
'|                                                                            |
'|   Most important thing while coding scripts or whatever is  -  sign it :)  |
'|                                                                            |
'|                           (c) dUkk 2008                                    |
'==============================================================================


Const ADS_SCOPE_SUBTREE = 2
Const ADS_CHASE_REFERRALS_ALWAYS = &H60
Dim TotalAccProcessed
Dim RootDomainLDAP

'check to see if we launched by correct interpreter(if not - relaunch correct)
if Not isCScript() Then
        set oShell = CreateObject("WScript.Shell")
        set arguments = WScript.Arguments
        sCMD = "cscript //nologo domgroupsenum.vbs"
        For Each cmdArg in arguments
            sCMD = sCMD & " " & cmdArg
        Next
        oShell.Run sCMD
        WScript.Quit()
End If

Set objArgs = WScript.Arguments
if objArgs.Count < 2 Then
   WScript.Echo "Enumerate all groups in specified domain"
   WScript.Echo "and return all as tab delimited user specified text file"
   WScript.Echo "ALL QUERYs are RECURSIVE!"
   WScript.Echo "USAGE: domgroupsenum.vbs <LDAP query> <outfile.txt" & vbCrLf & vbCrLf
   WScript.Echo "Example queryes:"
   WScript.Echo "LDAP://dc=mydomain,dc=com              - to enum groups in *all* OUs on mydomain.com domain"
   WScript.Echo "LDAP://ou=Groups,dc=mydomain,dc=com    - to start enum groups at 'Groups' OU on mydomain.com domain"
   WScript.Echo "LDAP://domainserv/dc=mydomain,dc=com   - to enum *all* groups on mydomain.com domain at specified DC" & vbCrLf & vbCrLf
   WScript.Echo "Press ENTER to quit"
   WScript.StdIn.ReadLine()
   WScript.Quit
Else
   LDAPQuery = objArgs(0)
End if


On Error Resume Next
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")

objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.Properties("Chase referrals") = ADS_CHASE_REFERRALS_ALWAYS
objCommand.Properties("TimeOut") = 120 'in seconds
objCommand.Properties("Cache Results") = False


Set cf = CreateObject("Scripting.FileSystemObject")

objCommand.CommandText = "SELECT primaryGroupToken, Name, description, member, groupType FROM '" & LDAPQuery & "' WHERE objectCategory='group'"
Set objRecordSet = objCommand.Execute
If objRecordSet.BOF Then
   WScript.Echo "ERROR querying: " & LDAPQuery
   WScript.Quit
Else
   objRecordSet.MoveFirst
End If

RootDomainLDAP=ConstructGlobalDomain(LDAPQuery)
Set cs = cf.OpenTextfile(objArgs(1), 2, True)
If Err.Number <> 0 Then
   WScript.Echo "Can't create output file!" & vbCrLf
   WScript.Quit
End If

Do Until objRecordSet.EOF
       GroupName=objRecordSet.Fields("Name").Value
       arrField = objRecordSet.Fields("description")
       if IsArray(arrField) Then
          For Each strItem In arrField
              GroupDescr = strItem
          Next
       elseif Not IsNull(arrField) Then
          GroupDescr = arrField.Value
       else
          GroupDescr = ""
       End if
       If Err.Number <> 0 Then
          WScript.Echo "ERROR querying GroupName and GroupDescr: " & Err.Description & vbCrLf
       End If

       Select Case objRecordSet.Fields("groupType")
       Case 2
            GroupType="Global" '"This is a global distribution group."
       Case 4
            GroupType="Local" '"This is a domain local distribution group."
       Case 8
            GroupType="Universal" '"This is a universal distribution group."
       Case -2147483646
            GroupType="Global" '"This is a global security group."
       Case -2147483644
            GroupType="Local" '"This is a domain local security group."
       Case -2147483643
            GroupType="Local" '"This is a domain local security group created by system."
       Case -2147483640
            GroupType="Universal" '"This is a universal security group."
       Case else
            GroupType=""
       End Select
       If Err.Number <> 0 Then
          WScript.Echo "ERROR querying GroupType: " & Err.Description & vbCrLf
       End If

       arrField = objRecordSet.Fields("member")
       if IsArray(arrField) Then
          For Each strItem In arrField
              Set objGroup = GetObject("LDAP://" & strItem)
              Select Case objGroup.sAMAccountType
              Case 805306368
                   GroupMemberType="User"
              Case 805306369
                   GroupMemberType="User"
              Case 268435456
                   GroupMemberType="Global"
              Case 536870912
                   GroupMemberType="Local"
              Case else
                   GroupMemberType="Contact"
              End Select
              If InStr(1, objGroup.sAMAccountName, "$", 1) < 1 Then
                 'if GroupMemberType <> "Contact" Then
                 cs.write MaskValueIfEmpty(GroupName, "") & vbTab 'GROUPNAME
                 cs.write MaskValueIfEmpty(GroupDescr, "") & vbTab 'GROUPDESCRIPTION
                 cs.write MaskValueIfEmpty(GroupType, "") & vbTab 'GROUP TYPE
                 cs.write objGroup.samAccountName & vbTab 'GROUP:MEMBER NAME
                 cs.write GroupMemberType & vbCrLf 'GROUP:MEMBER TYPE
                 'End If
              End If
              Set objGroup = Nothing
          Next
       elseif Not IsNull(arrField) Then
           cs.write MaskValueIfEmpty(GroupName, "") & vbTab 'GROUPNAME
           cs.write MaskValueIfEmpty(GroupDescr, "") & vbTab 'GROUPDESCRIPTION
           cs.write MaskValueIfEmpty(GroupType, "") & vbTab 'GROUP TYPE

           cs.write MaskValueIfEmpty(arrField.Value, "") & vbTab 'GROUP:MEMBER NAME
           cs.write "" & vbCrLf
       else
           cs.write MaskValueIfEmpty(GroupName, "") & vbTab 'GROUPNAME
           cs.write MaskValueIfEmpty(GroupDescr, "") & vbTab 'GROUPDESCRIPTION
           cs.write MaskValueIfEmpty(GroupType, "") & vbTab 'GROUP TYPE

           cs.write "" & vbTab 'GROUP:MEMBER NAME
           cs.write "" & vbCrLf 'GROUP:MEMBER TYPE
       End if
       If Err.Number <> 0 Then
          WScript.Echo "ERROR working with GroupMember: " & Err.Description & vbCrLf
       End If

       EnumPrimaryMembers(objRecordSet.Fields("primaryGroupToken"))

    TotalAccProcessed = TotalAccProcessed + 1
    objRecordSet.MoveNext
Loop


WScript.Echo "Total groups Listed: " & TotalAccProcessed


Set objConnection = Nothing
Set objCommand = Nothing

cs.Close
WScript.Quit




































'return members for specified by token group
Function EnumPrimaryMembers(intGroupToken)
On Error Resume Next
Dim objConnection2
Dim objCommand2
Dim objRecordset2
Set objConnection2 = CreateObject("ADODB.Connection")
Set objCommand2 = CreateObject("ADODB.Command")
objConnection2.Open "Provider=ADsDSOObject;"
objCommand2.ActiveConnection = objConnection2
objCommand2.Properties("Page Size") = 1000
objCommand2.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand2.Properties("Chase referrals") = ADS_CHASE_REFERRALS_ALWAYS
objCommand2.Properties("TimeOut") = 120 'in seconds
objCommand2.Properties("Cache Results") = False
objCommand2.CommandText = "SELECT sAMAccountName, sAMAccountType FROM '" & RootDomainLDAP & "' WHERE primaryGroupID=" & intGroupToken
Set objRecordSet2 = objCommand2.Execute
if Err.Number <> 0 Then
   WScript.Echo "CRITICAL ERROR in EnumPrimaryMembers(): " & Err.Description & vbCrLf
   WScript.Echo "In Params: " & intGroupToken & " LDAP " & RootDomainLDAP
End If
Do Until objRecordset2.EOF
    Select Case objRecordset2.Fields("sAMAccountType")
    Case 805306368
          GroupMemberType="User"
    Case 805306369
          GroupMemberType="User"
    Case 268435456
          GroupMemberType="Global"
    Case 536870912
          GroupMemberType="Local"
    Case 805306370
          GroupMemberType="Computer"
    Case else
          GroupMemberType=objRecordset2.Fields("sAMAccountType")'"Contact"
    End Select
    If InStr(1, objRecordset2.Fields("sAMAccountName").Value, "$", 1) < 1 Then
       cs.write MaskValueIfEmpty(GroupName, "") & vbTab 'GROUPNAME
       cs.write MaskValueIfEmpty(GroupDescr, "") & vbTab 'GROUPDESCRIPTION
       cs.write MaskValueIfEmpty(GroupType, "") & vbTab 'GROUP TYPE
       cs.write objRecordset2.Fields("sAMAccountName").Value & vbTab 'GROUP:MEMBER NAME
       cs.write GroupMemberType & vbCrLf 'GROUP:MEMBER TYPE
    End If
    objRecordset2.MoveNext
Loop
objConnection2.Close
Set objConnection2 = Nothing
Set objCommand2 = Nothing
End Function

Function ConstructGlobalDomain(ldap)
   On Error Resume Next
   Dim Arr
   Dim outstr
   Arr = Split(ldap, ",", -1, 1)
   For i = 0 TO UBound(Arr)
     'we interested only in "DC"
     If InStr(1, lcase(Arr(i)), "dc", 1) > 0 Then
        If Len(outstr) > 0 Then outstr = outstr + ","
        outstr=outstr + Arr(i)
     End If
   Next
   'prepend LDAP:// of not here already
   if InStr(1, lcase(outstr), "ldap://", 1) > 0 Then
      ConstructGlobalDomain=outstr
   else
      ConstructGlobalDomain="LDAP://" & outstr
   End If
   if Err.Number <> 0 Then
      Wscript.Echo "ConstructGlobalDomain() Error: " & vbCrLf & " , Description: " & Err.Description & vbCrLf
   End If
   On Error Goto 0
End Function

'fixup string value if it is empty or null
Function MaskValueIfEmpty(Original, default)
      if IsNull(Original) OR Len(Original) < 1 Then
         MaskValueIfEmpty = default
      Else
         MaskValueIfEmpty = Original
      End If
End Function

' convert OctetString (byte array) to Hex string
Function OctetToHex(Octet)
    OctetToHex = ""
    For I = LBound(Octet) + 1 To UBound(Octet)
        OctetToHex = OctetToHex & Right("0" & Hex(AscB(MidB(Octet, I, 1))), 2)
    Next
End Function

' convert Sid hex string to string
Function HexSidToString(HexSid)
    Dim OctetSid, NumTmp
    ReDim OctetSid(Len(HexSid) / 2 - 1)
    For I = LBound(OctetSid) To UBound(OctetSid)
        OctetSid(I) = CInt("&H" & Mid(HexSid, 2 * I + 1, 2))
    Next
    HexSidToString = "S-" & OctetSid(0) & "-" & OctetSid(1) & "-" & OctetSid(8)
    NumTmp = OctetSid(15)
    NumTmp = NumTmp * 256 + OctetSid(14)
    NumTmp = NumTmp * 256 + OctetSid(13)
    NumTmp = NumTmp * 256 + OctetSid(12)
    HexSidToString = HexSidToString & "-" & CStr(NumTmp)
    NumTmp = OctetSid(19)
    NumTmp = NumTmp * 256 + OctetSid(18)
    NumTmp = NumTmp * 256 + OctetSid(17)
    NumTmp = NumTmp * 256 + OctetSid(16)
    HexSidToString = HexSidToString & "-" & CStr(NumTmp)
    NumTmp = OctetSid(23)
    NumTmp = NumTmp * 256 + OctetSid(22)
    NumTmp = NumTmp * 256 + OctetSid(21)
    NumTmp = NumTmp * 256 + OctetSid(20)
    HexSidToString = HexSidToString & "-" & CStr(NumTmp)
    NumTmp = OctetSid(25)
    NumTmp = NumTmp * 256 + OctetSid(24)
    HexSidToString = HexSidToString & "-" & CStr(NumTmp)
End Function

Function isCScript()
 dim cmdline
 cmdline = WScript.FullName
 set tst = new regexp
 tst.Pattern = "cscript.exe"
 IsCScript=tst.test(WScript.FullName)
End Function