Here's a multi-purpose script that helps to manage the workstation logon restrictions on user accounts. It can be used in two different ways:
1. To modify existing user accounts with workstation resrtictions to add additional systems they can logon to.
2. To restrict a new account to specific workstations.
The script allows you to setup "base" systems that will get added as well as giving you a prompt to specify additional systems they can logon to. This is handy because we define our Citrix servers as the base systems and allow the person running the script to put in the specific workstation(s) that a particular user logs on to directly.
And we use the functionality #1 above to update all of our accounts whenever we add a new Citrix server to the farm.
The only things you should need to modify are the lines in RED.
Option Explicit
'***Add the ability to apply this to a specific OU
Dim sObjType, sObjShortName
Dim strComputersToAdd, strBaseComputersToAdd, arrComputersToAdd
Dim strUserToModify, strUserDN
Dim sDomainADsPath
Dim blnProcessSingleUser
blnProcessSingleUser = False 'Set to True to do one user- False to process multiple users
'Multiple users will only update accounts with existing restrictions
strUserToModify = "*"
'You can use wildcards for this if processing multiple users (* will do all)
'Running multiple users will only update users that already have restrictions
strBaseComputersToAdd = "Citrix1,Citrix2,Citrix3,"
'strComputersToAdd = "Workstation1"
sDomainADsPath = "LDAP://" & ADRoot
sObjType = "user"
'Prompt for computer list to add if not already set
If strComputersToAdd = "" Then
GetComputersToAdd
End If
'Prompt for user to modify if not already set-should mainly be used for processing single user
If strUserToModify = "" Then
GetUserToModify
End If
If strBaseComputersToAdd <> "" Then strComputersToAdd = strBaseComputersToAdd & strComputersToAdd
arrComputersToAdd = Split(strComputersToAdd, ",")
If blnProcessSingleUser = True Then
'WScript.Echo "2"
strUserDN = GetObjDN(strUserToModify, sObjType)
If strUserDN = "" Then
WScript.Echo "Couldn't find user in AD"
WScript.Quit
End If
AddComputersToAllowedList(strUserDN) 'Run manually for one user
Else
GetUsers 'Function to modify existing users with workstation restrictions
End If
WScript.Quit
'****************************************************************************
'****************************************************************************
Sub GetComputersToAdd
'Inputbox if no ID already Set
Dim strInputboxTitle, strInputboxMessage
strInputboxTitle = "Enter Computer list"
strInputboxMessage = "Enter the Computers to Add separated by a comma:"
strComputersToAdd = InputBox(strInputboxMessage, strInputboxTitle)
If strComputersToAdd = "" Then
Wscript.Echo "No Computers entered - Process Cancelled"
WScript.Quit
End If
End Sub
Sub GetUserToModify
'Inputbox if no ID already Set
Dim strInputboxTitle, strInputboxMessage
strInputboxTitle = "Enter user"
strInputboxMessage = "Enter the user to modify"
strUserToModify = InputBox(strInputboxMessage, strInputboxTitle)
If strUserToModify = "" Then
Wscript.Echo "No Computers entered - Process Cancelled"
WScript.Quit
End If
End Sub
Function GetUsers
Dim sProperties, strCmdTxt
Dim sUser, sPassword
Dim oCon, oCmd, oRecordSet
Dim intRecordCount
Set oCon = CreateObject("ADODB.Connection")
oCon.Provider = "ADsDSOObject"
oCon.Open "ADProvider", sUser, sPassword
Set oCmd = CreateObject("ADODB.Command")
Set oCmd.ActiveConnection = oCon
'sProperties = "name,ADsPath,description,mail,memberof"
sProperties = "distinguishedname,userWorkstations"
'strCmdTxt = "<" & sDomainADsPath & ">;(&(objectCategory=" & sObjType & ")(SamAccountName=" & sObjShortName & "));" & sProperties & ";subtree"
'strCmdTxt = "<" & sDomainADsPath & ">;(&(objectCategory=" & sObjType & ")(SamAccountName=" & sObjShortName & "));" & sProperties & ";subtree"
strCmdTxt = "<" & sDomainADsPath & ">;(&(objectCategory=" & sObjType & _
")(SamAccountName=" & strUserToModify & "));" & sProperties & ";subtree"
WScript.Echo strCmdTxt
oCmd.CommandText = strCmdTxt
oCmd.Properties("Page Size") = 100
On Error Resume Next
Set oRecordSet = oCmd.Execute
On Error goto 0
intRecordCount = oRecordSet.RecordCount
oRecordSet.MoveFirst
While Not oRecordSet.EOF
Dim strObjDN, arrObjDN, strDNPart, intDNPart, intOUDNEntry
'Get the object's distinguishedname
strObjDN = oRecordSet.Fields("distinguishedname")
'WScript.Echo strObjDN
On Error Resume Next
Dim strWorkstations
strWorkstations = ""
strWorkstations = oRecordSet.Fields("userWorkstations")
On Error Goto 0
If strWorkstations <> "" Then
'Run Function to add the computers in the list to the user object
'Only run it if they already have workstation restrictions
AddComputersToAllowedList(strObjDN)
End If
oRecordSet.MoveNext
Wend
End Function
Function AddComputersToAllowedList(strUserDN)
Dim objUser, strWorkSta, strOrigWorkSta, i
On Error goto 0
WScript.Echo "Modifying User: " & strUserDN
' Bind to user and retrieve userWorkstations.
Set objUser = GetObject("LDAP://" & strUserDN)
strWorkSta = objUser.userWorkstations
strOrigWorkSta = strWorkSta
' If (strWorkSta = "") Then
' strWorkSta = strAddComputers
' Else
'loop through array of systems to add, check one at a time to see if it is already added
For i = LBound(arrComputersToAdd) To UBound(arrComputersToAdd)
'WScript.Echo "checking: " & arrComputersToAdd(i)
If InStr(lcase(strWorkSta), lcase(arrComputersToAdd(i))) Then
Else
'Add the current system to the string
If strWorkSta = "" Then
strWorkSta = arrComputersToAdd(i)
Else
strWorkSta = strWorkSta & "," & arrComputersToAdd(i)
End If
End If
Next
' End If
WScript.Echo vbTab & "Original List: " & strOrigWorkSta
WScript.Echo vbTab & "New List: " & strWorkSta
' Update user and commit changes.
objUser.Put "userWorkstations", strWorkSta
objUser.SetInfo
End Function
Function ADRoot()
Dim oRootDSE
On Error Resume Next
Set oRootDSE = GetObject("LDAP://RootDSE")
If Err.Number <> 0 Then
ADRoot = "DC=ZZ,DC=YY,DC=XX,DC=com"
Else
ADRoot = oRootDSE.Get("defaultNamingContext")
End If
End Function
Function GetObjDN(sObjShortName, sObjType)
'This function queries AD for a user by SAMAccountName and returns the distinguishedName for it
'(DN is used for LDAP binds...)
Dim sDomainADsPath, sProperties, strCmdTxt
Dim sUser, sPassword
Dim oCon, oCmd, oRecordSet
Dim intRecordCount
sDomainADsPath = "LDAP://" & ADRoot
Set oCon = CreateObject("ADODB.Connection")
oCon.Provider = "ADsDSOObject"
oCon.Open "ADProvider", sUser, sPassword
Set oCmd = CreateObject("ADODB.Command")
Set oCmd.ActiveConnection = oCon
'sProperties = "name,ADsPath,description,mail,memberof"
sProperties = "distinguishedname"
strCmdTxt = "<" & sDomainADsPath & ">;(&(objectCategory=" & sObjType & ")(SamAccountName=" & sObjShortName & "));" & sProperties & ";subtree"
'WScript.Echo strCmdTxt
oCmd.CommandText = strCmdTxt
oCmd.Properties("Page Size") = 100
On Error Resume Next
Set oRecordSet = oCmd.Execute
On Error goto 0
intRecordCount = oRecordSet.RecordCount
If intRecordCount = 1 Then
oRecordSet.MoveFirst
While Not oRecordSet.EOF
Dim strObjDN, arrObjDN, strDNPart, intDNPart, intOUDNEntry
'Get the object's distinguishedname
strObjDN = oRecordSet.Fields("distinguishedname")
oRecordSet.MoveNext
Wend
GetObjDN = strObjDN
Else
WScript.Echo "ERROR: Expected exactly 1 record from AD. Records received = " & oRecordSet.RecordCount
'GetObjDN = False
End If
End Function ' End of GetObjDN Function