'Alan dot Kaplan at va dot gov, 12-30-2009
'Based on a script written by Suzanne Prindiville on 6/5/2009, 
'it will add computers to a group in Active Directory

Dim wshshell
Dim strComputer, strGroupPath, strGroup
Set wshShell = WScript.CreateObject("WScript.Shell")

If (Not IsCScript()) Then 		'If not CScript, re-run with cscript...
	dim quote
	quote=chr(34)
	WshShell.Run "CScript.exe " & quote & WScript.ScriptFullName & quote , 1, true
	WScript.Quit            	'...and stop running as WScript
End If

message = "This script will add computer(s) to a security group." & vbNewLine & vbNewLine &_
"What is the name of the group?"
strGroup = InputBox(message,"Name of Group to Add Members")
If strGroup = "" Then WScript.Quit

dim root, sADSPath
'Get the default ADsPath for the domain to search. 
Set root = GetObject("LDAP://rootDSE")
strDomainDN = root.Get("defaultNamingContext")
	
' Use ADO to search Active Directory. 
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"
Set oCommand = CreateObject("ADODB.Command")
oCommand.ActiveConnection = objConnection
oCommand.Properties("Page Size") = 100 
oCommand.Properties("Timeout") = 30 
oCommand.Properties("Cache Results") = False 

strBase = "<LDAP://" & strDomainDN & ">" 
strGroupPath = GetGroupDN(strGroup)

message = "1) Single PC" & vbNewLine &_
"2) Read a list of PCs" & vbNewLine &_
"0) Quit"

retval = InputBox(message,"Add Computer(s) to group","0")
If retval =  0 Then WScript.Quit

If retval = 1 Then 
	strComputer = InputBox("Enter Name of computer to add to " & strGroup, _
		"Name",wshShell.ExpandEnvironmentStrings("%Computername%"))
	If strComputer = "" Then WScript.Quit
	add2Group strComputer
Else
	strTitle = "Select text computer list"
	strFilter = "Text Files (*.txt)|*.txt"
	strFile = filefromDlg(strtitle, strfilter)
	dim fso
	set fso = CreateObject("Scripting.FileSystemObject")
	
	If Not fso.FileExists(strFile) Then
		MsgBox Strfile & " file not found, quitting",vbCritical + vbOKOnly,"Error"
		WScript.Quit
	End If 
	
	Set objFile = fso.OpenTextFile(strFile, 1)
	
	Do Until objFile.AtEndOfStream
		strComputer = objFile.ReadLine
		add2Group strComputer
	Loop
	
	objfile.close
End If 

' Clean up. 
objConnection.Close  
wscript.quit

' Functions and Subs
Sub add2Group(strComputer)
	strComputer = UCase(strComputer) 'just for looks
	' FIND THE DN OF THE COMPUTER 
	strComputerDN = GetComputerDN(strComputer)
	' Bind to computer objects.
	Set objComputer = GetObject("LDAP://" & strComputerDN)
	' Bind to groups. You must specify the full Distinguished Names.
	Set objComputerGroup = GetObject(strGroupPath)
	' add computer to group
	If (objComputerGroup.IsMember(objComputer.AdsPath) = False) Then
		objComputerGroup.Add(objComputer.AdsPath)
		If Err = 0 Then 
			WScript.Echo strComputer  & " added to " & strGroup
		Else
			WScript.Echo "FAILED to add " & strComputer  & " to " & strGroup
		End If 
	End If
	strComputerDN = ""
End Sub  

Function GetGroupDN (strGroup)	
	' Filter on Group Accounts. 
	strFilter = "(&(objectCategory=group)(cn=" & strGroup & "))" 
	strAttributes = "adspath,name" 
	strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree" 
	oCommand.CommandText = strQuery 
	Set oRS = oCommand.Execute 
	
	' Enumerate the recordset. 
	If  oRS.EOF And oRS.BOF Then 
  		MsgBox strgroup & " group not found"
  		WScript.Quit  		
  	Else
		GetGroupDN = oRS.Fields("adsPath")
  	End If
End Function

Function GetComputerDN (strComputer)	
	' Filter on Computer Accounts. 
	strFilter = "(&(objectCategory=computer)(Name=" & strComputer & "))" 
	strAttributes = "distinguishedName,name" 
	strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree" 
	oCommand.CommandText = strQuery 
	Set oRS = oCommand.Execute 
	
	' Enumerate the recordset. 
	If  oRS.EOF And oRS.BOF Then 
  		MsgBox strComputer & " computer not found"
  		WScript.Quit  		
  	Else
  		GetComputerDN = oRS.Fields("distinguishedName")
  	End If

End Function

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


Function FilefromDlg(strTitle,strFilter)
	On Error Resume Next
	set objDlg = wscript.CreateObject("MSComDlg.CommonDialog") 
	If Err.Number <> 0 Then
		Err.Clear
		FilefromDlg = InputBox("Enter full path to file","File Path")
		Exit Function 
	End If 
	
  With objDlg
    .DialogTitle = strTitle 
  	.Filter = strFilter
	.FilterIndex = 2
	.MaxFileSize = 260
	.CancelError = False
	.ShowOpen
	FilefromDlg = objDlg.Filename
  End With
End Function