'OUADSPath2Clip
'Alan Kaplan, VISN 6

Option Explicit
Dim d ' Create dictionary
Set d = CreateObject("Scripting.Dictionary")
Dim i, message, sADSPath
Const ADS_SCOPE_ONELEVEL = 1
Dim root, retval
Dim oConn, oCommand
dim wshShell
Set wshShell = WScript.CreateObject("WScript.Shell")

'Get the default ADsPath for the domain to search. 
Set root = GetObject("LDAP://rootDSE")
sADSPath = root.Get("defaultNamingContext")


'Connect to Active directory and search setup 
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") = 1000
'This is critical -  Pick something else and you get too much 
oCommand.Properties("Searchscope") = ADS_SCOPE_ONELEVEL

message = "This put the ADSPath of an OU into your clipboard." & _
vbcrlf & vbcrlf & "Start with what OU?"

sADSPath = InputBox(message,"Start LDAP Path",sADSPath)
If sADSPath = "" Then WScript.Quit
dim quote
quote=chr(34)

dim fso,logfile, appendout, strChoice

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

SearchDom sADSPath

Dim bHeader			'Do we need a first line?
bHeader = True

Dim strOUName, tarray
tarray = Split(sADSPath,",")
If instr(tarray(0),"=") > 0 Then 
	strOUName = replace(tarray(0),"=","_")
End If

sADSPath = "LDAP://" & sADSPath
retval = MsgBox("The path is: " & sADSPath & VbCrLf & VbCrLf & _
"Send path to the clipboard?",vbYesNo,strChoice)

If retval = vbYes Then	'Use IE for clipboard
	Dim objIE
	Set objIE = CreateObject("InternetExplorer.Application")
	objIE.Navigate("about:blank")
	Do Until objIE.ReadyState=4: WScript.Sleep 1: Loop
	objIE.Document.ParentWindow.ClipboardData.SetData "Text", sADSPath
	objIE.Quit
End If 

WScript.Quit

'========= Functions And Subs ==========
Sub SearchDom(sADSPath)
	'basic menu to navigate through AD
	Dim oRS
	Dim iChoice, oADTmp
	i = 1
	'Create a query
	oCommand.CommandText = _
	    "SELECT Name, distinguishedname FROM 'GC://"& sADSPath &"' WHERE objectClass='organizationalUnit'"  
	Set oRS = oCommand.Execute
	
	If oRS.EOF = True Then	'no more OUs under.  Exit
		Exit Sub
	End If 
	
	oRS.MoveFirst
	Do Until oRS.EOF
		'Add the name and the dn -- here ADSPath to dictionary.
	    d.Add i &") " &  oRS.Fields("Name").Value, oRS.Fields("distinguishedname").Value
	    oRS.MoveNext
	    i = i + 1 
	Loop
	
	iChoice = d.Keys              ' Get the keys.
	'OUName = d.Items
	
	message =""		'Build the menu
	
	For i = 0 To d.Count -1 ' Iterate the names 
	    message = message &   iChoice(i) & vbcrlf
	Next
	
	message = message & _
		"      --- Current Path ---- " & vbcrlf & _
	 " 0) " & sADSPath & vbcrlf & vbcrlf & _
	 "-1)  Move up to parent path"  
	
	retval = InputBox(message,"Enter Choice and Click [OK]",0)
	If retval = "" Then WScript.Quit
	If retval = "0" Then Exit Sub
	If retval = "-1" Then
		Set oADTmp = GetObject("LDAP://" & sADSPath)
		sADSPath = mid(oADTmp.Parent,8)
		SearchDom sADSPath
	End If 
	
	strChoice = ichoice(retval-1)
	strChoice = Replace(strChoice,cstr(retval)& ") ","")
	
	'okay.  This is a kludge. You could do this with a multidimensional Array
	'or even a recordset. But it was fast and easy!
	On Error Resume Next ' ignore numbers not in the list
	Dim a,b
	a = d.Items
	b = d.Keys	'Cleaning up from menu stuff to get logfile
	logfile = b(retval-1)
	b = Split(logfile,")")
	logfile = Trim(b(1))
	sADSPath = a(retval-1)
	d.RemoveAll		'Clear the dictionary
	SearchDom sADSPath
	On Error goto 0
End Sub

Sub GetCounts(strType)
	Dim oConn, oCommand, objRecordSet, strComputer
	Dim strCount, strQuery, strTxt
	
	'Wscript.Echo "Counting " & strType & " in " & sADSPath
	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") = 1000
	
	Select Case strType
		Case "Servers"
			strQuery = 	"(&(objectCategory=Computer)(OperatingSystem=*Server*))"
			strTxt = "Windows 2000 and 2003 Server Accounts: "
		Case "Workstations"
			strQuery = "(&(objectCategory=Computer)(OperatingSystem=*Professional*))"
			strTxt = "Windows 2000 and XP Workstation Accounts: "
		Case "ActiveWS"
			'Whew!
			strQuery = "(&(&(&(&(objectCategory=Computer)(OperatingSystem=*Professional*)(pwdLastSet>=" & _
			dtmDateValue(i90DaysAgo) & ")(!(userAccountControl:1.2.840.113556.1.4.803:=2))))))"
			strTxt = "Windows 2000 and XP Workstations (not disabled, password changed in last 90 days): "		
		Case "NT4"
			strQuery = "(&(objectCategory=Computer)(OperatingSystem=Windows NT))"
			strTxt = "Windows NT 4 Servers and Workstation Accounts: "
		Case "Users"
			strQuery = "(&(objectCategory=Person)(objectClass=User))"
			strTxt = "All User Accounts: "
		Case "NotService"
			'whew again!
			strQuery = "(&(&(&(objectCategory=person)(objectClass=user)" &_
			"(!(userAccountControl:1.2.840.113556.1.4.803:=2))" & _
			"(!(userAccountControl:1.2.840.113556.1.4.803:=65536)))))"
			strTxt = "User Accounts (not disabled, not set to password never expires): "
	End Select
	
	oCommand.CommandText = _
	    "<LDAP://" & sADSPath &">;" & strQuery & ";Name;Subtree"  
	Set objRecordSet = oCommand.Execute
	
	EchoAndLog strTxt & objRecordSet.RecordCount
End Sub 


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