'BuiltInGroupsEnum.vbs
'Alan dot Kaplan at va dot gov 9/23/2009
'Get membership of built-in groups (and Domain Admins) with recursion.
'v1.1 9/25/2009 fixes Domain Admin queries outside your local domain
'v1.2 10/1/2009 switched all query syntax to LDAP, added additional enterprise groups, disabled state

Option Explicit
On Error Resume Next 

dim wshShell, fso
Dim strList
Set wshShell = WScript.CreateObject("WScript.Shell")
dim quote
quote=chr(34)
Dim strReportFolder,strDomain, strDisabled
Dim iLevel
iLevel = 0
Dim message

'Make sure running Cscript.
If (Not IsCScript()) Then 		'If not CScript, re-run with cscript...
	WshShell.Run "CScript.exe " & quote & WScript.ScriptFullName & quote, 1, True
    WScript.Quit            	'...and stop running as WScript
End If

'Setup Log 
Dim writetype
writetype = 2 ' forwriting
set fso = CreateObject("Scripting.FileSystemObject")

Dim logpath, logtime, logfile, appendout
logpath= wshShell.SpecialFolders("Desktop") & "\"

Dim root, sdomain
Const ADS_SCOPE_SUBTREE = 2
Const ADS_CHASE_REFERRALS_ALWAYS = &H20
'Get the ADsPath for the domain to search. 
Set root = GetObject("LDAP://rootDSE")
sDomain = root.Get("defaultNamingContext")

dim strOtherAdmins, bOtherAdmins

If wscript.arguments.count = 1 Then
	sdomain = WScript.Arguments(0)
	bOtherAdmins = vbYes
	strOtherAdmins = "Domain Admins"
Else
	message ="This script will enumerate the builtin and administrative members of a domain." & VbCrLf & VbCrLf & _
	"Computer accounts are skipped.  Search what domain for members of these groups?"
	sdomain = InputBox(message,"Domain",sdomain)
	If sdomain = "" Then WScript.Quit
	
	message = "Include Domain, Enterprise and Schema Admins? Some of these groups may be found " & _
	"and enumerated as a member of Administrators"
	bOtherAdmins= msgbox (message,vbYesNoCancel,"Additional Group")
	If bOtherAdmins = vbCancel Then WScript.Quit 	
End If 

strDomain = Replace(sdomain,",","_") & "_"
strDomain = Replace(strDomain,"DC=","")
strReportFolder = wshShell.ExpandEnvironmentStrings("%userprofile%") & "\desktop\" & strdomain & " Builtin Member Reports" 
If Not fso.FolderExists(strReportFolder) Then fso.CreateFolder(strReportFolder)

Dim oConn, oCommand, oRS
Set oConn = CreateObject("ADODB.Connection")
Set oCommand =   CreateObject("ADODB.Command")
oConn.Provider = "ADsDSOObject"
oConn.Open "Active Directory Provider"
Set oCommand.ActiveConnection = oConn

oCommand.Properties("Page Size") = 500
ocommand.Properties("Chase referrals") = ADS_CHASE_REFERRALS_ALWAYS
oCommand.Properties("timeout") = 100


'connect to Global Catalog to query outside local domain
oCommand.CommandText = "<GC://cn=Builtin," & sdomain & _
">;(objectCategory=group); cn, adspath;subtree"	 

Set oRS = oCommand.Execute

oRS.MoveFirst
Do Until oRS.EOF
     GetMembers oRS.Fields("cn").Value, oRS.Fields("adsPath").Value,False
     oRS.MoveNext
Loop

If bOtherAdmins = vbYes Then 
	On Error GoTo 0
	Dim strQuery, aAdmins, i
'**** Presumes that these groups are not renamed **** change below if required	
	aAdmins=Array("Domain Admins","Enterprise Admins","Schema Admins")
	For i = 0 To UBound(aAdmins)
		strQuery   = "<GC://" & sDomain & ">;(name=" & aAdmins(i) &");cn,adspath;subtree"
	 	oCommand.CommandText = strQuery
		Set oRS = oCommand.Execute
		If Not(oRS.EOF And oRS.BOF) Then 
			ors.moveFirst
			GetMembers oRS.Fields("cn").Value, oRS.Fields("adsPath").Value,False
		Else
			wshShell.Popup aAdmins(i) & " not found in " & sdomain,3,"Group not found"
		End If 
	Next 
End If 

On Error Resume Next 
if wscript.Arguments.Count = 0 Then wshShell.Run quote & strReportFolder & quote,1,True

' ========= Functions and Subs =======
Function GetMembers(strName, strPath,bRecurse)
	If bRecurse Then message = "	Subgroup: " : 	Else : 	message = "" :	End If 
	WScript.Echo VbCrLf & String(40,"=") & VbCrLf & message &  strName & VbCrLf &  String(50,"=") & VbCrLf 
	
	If Not bRecurse Then 
		iLevel=0
		logfile = fso.BuildPath(strReportFolder,strName & ".xls")
		If fso.FileExists(logfile) Then fso.DeleteFile logfile 
		
		Set appendout = fso.OpenTextFile(logfile, writetype, True)
		appendout.WriteLine	"Member	Display Name	NTName	Description	Disabled	email	ADSPath"
	Else
		iLevel = iLevel + 1
	End If 

	Dim oGroup, member
	strPath = replace(strPath,"GC","LDAP")
	Set oGroup = GetObject(strPath)
		    
    Dim i, strArrow
    For i = 1 To iLevel 
    	strArrow = "--> " & strArrow
	if iLevel = 5 then
		EchoandLog "******** Probable membership loop, exiting enumeration here"
		Exit Function
	End if
    Next

	For Each member In oGroup.members
		If instr(member.samaccountname,"$") = 0 Then 
			Dim oMember, arrCanonicalName, strValue, strCanonicalName
	
			set oMember = GetObject(Replace(member.adspath,"LDAP","GC"))
			strCanonicalName = replace(oGroup.name,"CN=","") 

			On Error Resume Next
		    oMember.GetInfoEx Array("canonicalName"), 0
			arrCanonicalName = oMember.GetEx("canonicalName")
			 
			For Each strValue in arrCanonicalName
			 strCanonicalName = strValue
			Next
		    
		    On Error GoTo 0

		    If bRecurse Then strCanonicalName = strArrow & strCanonicalName
		    
		    Dim strMail, strAddress
		    strMail = ""
		    
		    'Make sure really mail enabled
    
		   	If len(member.mailNickName) > 0 Then 
				strMail = member.mail
		    End If

			If Member.Class = "user" Then 
				strDisabled = Cstr(oMember.AccountDisabled )
			Else
				strDisabled = "N/A"
			End If 
			
		    echoandlog  strCanonicalName & vbTab & member.displayname & vbTab & _
		      member.samaccountname & vbTab &  member.description & vbTab & strDisabled & vbTab & strMail & vbTab & member.adspath
		    
		    If Member.Class = "group" Then GetMembers member.samaccountname, member.adspath,True
	    End If 
	Next
	
	If bRecurse Then
		iLevel = iLevel - 1
	Else
		appendout.Close
		SaveAsExcel logfile
	End If 
End Function 

	
Sub SaveAsExcel(strFileName)
	'This routine converts tab delimited files (which are really easy to write)
	'to an Excel spreadsheet
	
	Const xlnormal = -4143 
	Dim fso, oXL, objRange
	Set fso = CreateObject("Scripting.FileSystemObject")
	If Not fso.FileExists(strFileName) Then WScript.Quit
	On Error Resume next
	Set oXL = CreateObject("Excel.Application")
	
	If Err <> 0 Then 'Excel not installed
		Err.Clear
		On Error GoTo 0
		Exit Sub
	End If 
	
	'oXL.Visible = True
	oXL.DisplayAlerts=False ' don't display overwrite prompt.
	oXL.Workbooks.Open(strFileName)
	Set objRange = oXL.Worksheets(1).UsedRange
	objRange.EntireColumn.Autofit()
	oXL.ActiveWorkBook.SaveAs strFileName,xlnormal,,,,,,,True 'overwrite existing
	oXL.ActiveWorkBook.Close
	oXL.Quit
	'WScript.Echo "Done"
End Sub 


Sub echoandlog (message)
	'Echo output and write to Log
	Wscript.Echo message
	AppendOut.WriteLine message
End Sub  

Function IsCScript()
    If (InStr(UCase(WScript.FullName), "CSCRIPT") <> 0) Then
        IsCScript = True
    Else
        IsCScript = False
    End If
End Function