narrow default width wide
colour style colour style colour style colour style

Modifying the workstations that a user can logon to

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 = ";(&(objectCategory=" & sObjType & ")(SamAccountName=" & sObjShortName & "));" & sProperties & ";subtree"
 'strCmdTxt = ";(&(objectCategory=" & sObjType & ")(SamAccountName=" & sObjShortName & "));" & sProperties & ";subtree"
 strCmdTxt = ";(&(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 = ";(&(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