' Alan dot Kaplan at VA dot Gov 2-28-12
' This is a variation of EnumLocalGroup.vbs
' VBScript program to enumerate members of a local group.
' Copyright (c) 2007 Richard L. Mueller
' Hilltop Lab web site - http://www.rlmueller.net
' I added error handling, a way to write the data out to file, and 
' a way to avoid and report recursive group nesting.


Option Explicit
WScript.TimeOut = 20 'Just in case we get hung somewhere.

Dim fso,logfile, appendout
Dim wshShell: Set wshShell = WScript.CreateObject("WScript.Shell")

'setup log
Const ForAppend = 8
set fso = CreateObject("Scripting.FileSystemObject")


Dim aGroups: aGroups = Array()
Dim objNetwork, objLocalGroup

' These attributes must be declared in the main program,
' so they are global in scope.
Dim objTrans, strComputer, strNetBIOSDomain

' Constants for the NameTranslate object.
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1

' Determine NetBIOS name of domain and local computer.
Set objNetwork = CreateObject("Wscript.Network")
strNetBIOSDomain = objNetwork.UserDomain
strComputer = objNetwork.ComputerName
Set objNetwork = Nothing


' Bind to local Administrators group.
Set objLocalGroup = GetObject("WinNT://" & strComputer  & "/Administrators,group")
logfile = wshShell.ExpandEnvironmentStrings("%userprofile%") & "\desktop\" & strComputer & "_Admins.txt"
If fso.FileExists(logfile) Then fso.DeleteFile logfile,True

Set appendout = fso.OpenTextFile(logfile, ForAppend, True)

' Enumerate members of the local group.
Call EnumLocalGroup(objLocalGroup)

wshShell.Run logfile 

' =========== Functions and subs 
Sub EnumLocalGroup(ByVal objGroup)
    ' Subroutine to enumerate members of local group.
    ' The variable strComputer has global scope.

    Dim objMember
    ' Enumerate direct members of group.
    For Each objMember In objGroup.Members

	EchoAndLog  objMember.AdsPath

 ' Test if member is a group.
        If (LCase(objMember.Class) = "group") Then
            ' Nested group. Test if objMember is a local group.
            If (InStr(LCase(objMember.AdsPath), "/" _
                    & LCase(strComputer) & "/") > 0) Then
                ' objMember is a local group.
                ' Call sub recursively to enumerate nested local group.
                Call EnumLocalGroup(objMember)
            ElseIf (InStr(LCase(objMember.AdsPath), _
                    "/nt authority/") > 0) Then
                ' objMember is local implicit group (special identity).
                ' Membership cannot be enumerated.
            Else
                ' objMember is a domain group.
                ' Call sub that uses LDAP provider to enumerate
                ' nested domain group. objMember is bound with
                ' WinNT provider.
	        	 If isNewGroup(aGroups, objMember.Adspath) Then 
	            	' Call sub recursively. objMember bound with LDAP. Original code
	            	Call EnumDomainGroup(objMember, True)
	            End If 
            End If
        End If
    Next
End Sub

Sub EnumDomainGroup(ByVal objDomainGroup, ByVal blnNT)
    ' Subroutine to enumerate members of domain group.
    ' blnNT is True if objDomainGroup is bound with WinNT,
    ' False if bound with LDAP.
    ' The variables objTrans and strNetBIOSDomain have global scope.
    On Error Resume Next 
    Dim strNTName, strGroupDN, objGroup, objMember

    ' Check if this function called before.
    If (IsEmpty(objTrans) = True) Then
        ' objDomainGroup must be bound with WinNT.
        ' Setup NameTranslate. Connect to Global Catalog.
        Set objTrans = CreateObject("NameTranslate")
        objTrans.Init ADS_NAME_INITTYPE_GC, ""

        ' Convert NetBIOS name of group to Distinguished Name.
        strNTName = strNetBIOSDomain & "\" & objDomainGroup.Name
        objTrans.Set ADS_NAME_TYPE_NT4, strNTName
        strGroupDN = objTrans.Get(ADS_NAME_TYPE_1779)
        ' Escape any forward slash characters, "/", with the backslash
        ' escape character. All other characters that should be escaped are.
        strGroupDN = Replace(strGroupDN, "/", "\/")
    Else
        ' NameTranslate already setup. Check if objDomainGroup
        ' bound with WinNT.
        If (blnNT = True) Then
            ' Convert NetBIOS name of group to Distinguished Name.
            strNTName = strNetBIOSDomain & "\" & objDomainGroup.Name
           
            objTrans.Set ADS_NAME_TYPE_NT4, strNTName
            strGroupDN = objTrans.Get(ADS_NAME_TYPE_1779)
            
            If Err <> 0 Then 
	            EchoAndLog "	!!! Could not enumerate membership of " & strNTName
				Exit Sub 
            End If
            ' Escape any forward slash characters, "/", with the backslash
	        ' escape character. All other characters that should be escaped are.
	        strGroupDN = Replace(strGroupDN, "/", "\/")
        Else
            ' objDomainGroup bound with LDAP. Retrieve Distinguished Name.
            strGroupDN = objDomainGroup.distinguishedName
            ' Escape any forward slash characters, "/", with the backslash
            ' escape character. All other characters that should be escaped are.
            strGroupDN = Replace(strGroupDN, "/", "\/")
        End If
    End If
    ' Bind to group with the LDAP provider, if required.
    If (blnNT = True) Then
        Set objGroup = GetObject("LDAP://" & strGroupDN)
    Else
        Set objGroup = objDomainGroup
    End If
    ' Enumerate direct members of objDomainGroup (bound with LDAP).
    For Each objMember In objGroup.Members
    	If (LCase(objMember.Class) = "group") Then 'show members as indented
			EchoAndLog objMember.AdsPath
		Else
    		EchoAndLog vbTab &  objMember.AdsPath		
		End If 
		
        ' Check if objMember is a group.
        If (LCase(objMember.Class) = "group") Then
        	If isNewGroup(aGroups, objMember.Adspath) Then 
            	' Call sub recursively. objMember bound with LDAP. Original code
            	Call EnumDomainGroup(objMember, False)
            End If 
        End If
    Next
    On Error GoTo 0 
End Sub

Function isNewGroup(aList, NewItem) 'check for new items
	'Kaplan addition to avoid recursive loops
	On Error GoTo 0
	Dim I, ItemFound
	For I = LBound(aList) to UBound(aList)
	   If aList(I) = NewItem Then
	      ItemFound = True
	      Exit For
	   End If
	Next
	
	If Not ItemFound Then
	   isNewGroup = True 
	   ReDim Preserve aList(Ubound(aList) + 1)
	   alist(I)=newitem    
	   'WScript.Echo "Added " & Newitem & " to array"
	Else
		isNewGroup = False
		EchoAndLog "!!! Skipping," & newitem & " membership has been enumerated before and may be a recursion!" 
	End If
End Function 

Sub EchoAndLog (message)
	'Echo output and write to log
	Wscript.Echo message
	AppendOut.WriteLine message
End Sub