Mapping drives and printers for Citrix XenApp / XenDesktop published applications with batch and VBS scripts based on AD group membership

One of the more frequent questions I’ve been asked for Citrix XenApp / XenDesktop published applications is whether there is a way to map network drives and printers based on AD group membership for applications that are published via a batch file. There are several ways to do this but if you want to specifically control the mappings from within a VBS script then below is an example of how to do this.

The first step in the process is to create two files:

1. A batch file that the published application within Citrix XenApp / XenDesktop will execute to launch the application
2. A VBS script that will map the respective network drives and printers based on group membership

For this example, the batch file will be named MapLaunch.bat and the vbs script that will control the network drives and printers mapping will be MapDrivesPrinters.vbs as shown below:

The contents of the batch file MapLaunch.bat will be simple as it simply calls the VBS script to map the network drives and printers, followed by starting the Citrix application defined in the Command line argument (option): field in the Application Settings:

cscript C:\Scripts\MapDrivesPrinters.vbs

start "Citrix" %*

timeout /T 1 /nobreak

The next step is to create a vbs script that would map the network drives and printers based on AD membership. There are plenty of scripts available and one of the scripts I’ve used in the past is by Richard L. Mueller and can be found here: https://www.rlmueller.net/Logon6.htm

The script is fairly straight forward to use but I’ll paste a sample one below with the customizations highlighted in red.

' Logon6.vbs
' VBScript logon script program.
'
' ----------------------------------------------------------------------
' Copyright (c) 2004-2010 Richard L. Mueller
' Hilltop Lab web site - http://www.rlmueller.net
' Version 1.0 - March 28, 2004
' Version 1.1 - July 30, 2007 - Escape any "/" characters in DN's.
' Version 1.2 - November 6, 2010 - No need to set objects to Nothing.
'
' You have a royalty-free right to use, modify, reproduce, and
' distribute this script file in any way you find useful, provided that
' you agree that the copyright owner above has no warranty, obligations,
' or liability for such use.

Option Explicit

Dim objRootDSE, objTrans, strNetBIOSDomain, objNetwork, strNTName
Dim strUserDN, strComputerDN, objGroupList, objUser, strDNSDomain
Dim strComputer, objComputer
Dim strHomeDrive, strHomeShare
Dim adoCommand, adoConnection, strBase, strAttributes

' Constants for the NameTranslate object.
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1

Set objNetwork = CreateObject("Wscript.Network")

' Loop required for Win9x clients during logon.
strNTName = ""
On Error Resume Next
Do While strNTName = ""
     strNTName = objNetwork.UserName
     Err.Clear
     If (Wscript.Version > 5) Then
         Wscript.Sleep 100
     End If
Loop
On Error GoTo 0

' Determine DNS domain name from RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")

' Use the NameTranslate object to find the NetBIOS domain name from the
' DNS domain name.
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_1779, strDNSDomain
strNetBIOSDomain = objTrans.Get(ADS_NAME_TYPE_NT4)
' Remove trailing backslash.
strNetBIOSDomain = Left(strNetBIOSDomain, Len(strNetBIOSDomain) - 1)

' Use the NameTranslate object to convert the NT user name to the
' Distinguished Name required for the LDAP provider.
objTrans.Set ADS_NAME_TYPE_NT4, strNetBIOSDomain & "\" & strNTName
strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
' Escape any forward slash characters, "/", with the backslash
' escape character. All other characters that should be escaped are.
strUserDN = Replace(strUserDN, "/", "\/")

' Bind to the user object in Active Directory with the LDAP provider.
Set objUser = GetObject("LDAP://" & strUserDN)

' Map a network drive if the user is a member of the group.
If (IsMember(objUser, "Contoso_Services") = True) Then
     On Error Resume Next
     objNetwork.MapNetworkDrive "G:", "\\fileserver\conto"
     If (Err.Number <> 0) Then
         On Error GoTo 0
         objNetwork.RemoveNetworkDrive "G:", True, True
         objNetwork.MapNetworkDrive "G:", "\\fileserver\conto"
     End If
     On Error GoTo 0
End If

' Map a network drive if the user is a member of the group.
If (IsMember(objUser, "HPC_Users") = True) Then
     On Error Resume Next
     objNetwork.MapNetworkDrive "R:", "\\HPCServer\HPC_WorkArea$"
     If (Err.Number <> 0) Then
         On Error GoTo 0
         objNetwork.RemoveNetworkDrive "R:", True, True
         objNetwork.MapNetworkDrive "R:", "\\HPCServer\HPC_WorkArea$"
     End If
     On Error GoTo 0
End If

' Map a network drive if the user is a member of the group.
If (IsMember(objUser, "Domain Users") = True) Then
     On Error Resume Next
     objNetwork.MapNetworkDrive "S:", "\\fileserver\s_root$"
     If (Err.Number <> 0) Then
         On Error GoTo 0
         objNetwork.RemoveNetworkDrive "S:", True, True
         objNetwork.MapNetworkDrive "S:", "\\fileserver\s_root$"
     End If
     On Error GoTo 0
End If

' Map a network drive if the user is a member of the group.
If (IsMember(objUser, "SecureClaims") = True) Then
     On Error Resume Next
     objNetwork.MapNetworkDrive "T:", "\\fileserver\SecureClaimsArea$"
     If (Err.Number <> 0) Then
         On Error GoTo 0
         objNetwork.RemoveNetworkDrive "T:", True, True
         objNetwork.MapNetworkDrive "T:", "\\fileserver\SecureClaimsArea$"
     End If
     On Error GoTo 0
End If

' Map a network drive if the user is a member of the group.
If (IsMember(objUser, "ReInsur_Services") = True) Then
     On Error Resume Next
     objNetwork.MapNetworkDrive "X:", "\\fileserver\ReLife"
     If (Err.Number <> 0) Then
         On Error GoTo 0
         objNetwork.RemoveNetworkDrive "X:", True, True
         objNetwork.MapNetworkDrive "X:", "\\fileserver\ReLife"
     End If
     On Error GoTo 0
End If

' Use the NameTranslate object to convert the NT name of the computer to
' the Distinguished name required for the LDAP provider. Computer names
' must end with "$".
strComputer = objNetwork.computerName
objTrans.Set ADS_NAME_TYPE_NT4, strNetBIOSDomain _
     & "\" & strComputer & "$"
strComputerDN = objTrans.Get(ADS_NAME_TYPE_1779)
' Escape any forward slash characters, "/", with the backslash
' escape character. All other characters that should be escaped are.
strComputerDN = Replace(strComputerDN, "/", "\/")

' Add a printer connection if the user is a member of the group.
If (IsMember(objUser, "Domain Users") = True) Then
     Set objNetwork = CreateObject("WScript.Network")
     objNetwork.AddWindowsPrinterConnection "\\PrintServer\Xerox7855B PCL6"
     objNetwork.AddWindowsPrinterConnection "\\PrintServer\Xerox7855A PCL6"
     objNetwork.AddWindowsPrinterConnection "\\PrintServer\Lexmark Universal v2 PS3"
     objNetwork.SetDefaultPrinter "\\PrintServer\Xerox7855A PCL6"
End If

' Clean up.
If (IsObject(adoConnection) = True) Then
     adoConnection.Close
End If

Function IsMember(ByVal objADObject, ByVal strGroupNTName)
     ' Function to test for group membership.
     ' objADObject is a user or computer object.
     ' strGroupNTName is the NT name (sAMAccountName) of the group to test.
     ' objGroupList is a dictionary object, with global scope.
     ' Returns True if the user or computer is a member of the group.
     ' Subroutine LoadGroups is called once for each different objADObject.

    ' The first time IsMember is called, setup the dictionary object
     ' and objects required for ADO.
     If (IsEmpty(objGroupList) = True) Then
         Set objGroupList = CreateObject("Scripting.Dictionary")
         objGroupList.CompareMode = vbTextCompare

        Set adoCommand = CreateObject("ADODB.Command")
         Set adoConnection = CreateObject("ADODB.Connection")
         adoConnection.Provider = "ADsDSOObject"
         adoConnection.Open "Active Directory Provider"
         adoCommand.ActiveConnection = adoConnection

        Set objRootDSE = GetObject("LDAP://RootDSE")
         strDNSDomain = objRootDSE.Get("defaultNamingContext")

        adoCommand.Properties("Page Size") = 100
         adoCommand.Properties("Timeout") = 30
         adoCommand.Properties("Cache Results") = False

        ' Search entire domain.
         strBase = "<LDAP://" & strDNSDomain & ">"
         ' Retrieve NT name of each group.
         strAttributes = "sAMAccountName"

        ' Load group memberships for this user or computer into dictionary
         ' object.
         Call LoadGroups(objADObject)
     End If
     If (objGroupList.Exists(objADObject.sAMAccountName & "\") = False) Then
         ' Dictionary object established, but group memberships for this
         ' user or computer must be added.
         Call LoadGroups(objADObject)
     End If
     ' Return True if this user or computer is a member of the group.
     IsMember = objGroupList.Exists(objADObject.sAMAccountName & "\" _
         & strGroupNTName)
End Function

Sub LoadGroups(ByVal objADObject)
     ' Subroutine to populate dictionary object with group memberships.
     ' objGroupList is a dictionary object, with global scope. It keeps track
     ' of group memberships for each user or computer separately. ADO is used
     ' to retrieve the name of the group corresponding to each objectSid in
     ' the tokenGroup array. Based on an idea by Joe Kaplan.

    Dim arrbytGroups, k, strFilter, adoRecordset, strGroupName, strQuery

    ' Add user name to dictionary object, so LoadGroups need only be
     ' called once for each user or computer.
     objGroupList.Add objADObject.sAMAccountName & "\", True

    ' Retrieve tokenGroups array, a calculated attribute.
     objADObject.GetInfoEx Array("tokenGroups"), 0
     arrbytGroups = objADObject.Get("tokenGroups")

    ' Create a filter to search for groups with objectSid equal to each
     ' value in tokenGroups array.
     strFilter = "(|"
     If (TypeName(arrbytGroups) = "Byte()") Then
         ' tokenGroups has one entry.
         strFilter = strFilter & "(objectSid=" _
             & OctetToHexStr(arrbytGroups) & ")"
     ElseIf (UBound(arrbytGroups) > -1) Then
         ' TokenGroups is an array of two or more objectSid's.
         For k = 0 To UBound(arrbytGroups)
             strFilter = strFilter & "(objectSid=" _
                 & OctetToHexStr(arrbytGroups(k)) & ")"
         Next
     Else
         ' tokenGroups has no objectSid's.
         Exit Sub
     End If
     strFilter = strFilter & ")"

    ' Use ADO to search for groups whose objectSid matches any of the
     ' tokenGroups values for this user or computer.
     strQuery = strBase & ";" & strFilter & ";" _
         & strAttributes & ";subtree"
     adoCommand.CommandText = strQuery
     Set adoRecordset = adoCommand.Execute

    ' Enumerate groups and add NT name to dictionary object.
     Do Until adoRecordset.EOF
         strGroupName = adoRecordset.Fields("sAMAccountName").Value
         objGroupList.Add objADObject.sAMAccountName & "\" _
             & strGroupName, True
         adoRecordset.MoveNext
     Loop
     adoRecordset.Close

End Sub

Function OctetToHexStr(ByVal arrbytOctet)
     ' Function to convert OctetString (byte array) to Hex string,
     ' with bytes delimited by \ for an ADO filter.

    Dim k
     OctetToHexStr = ""
     For k = 1 To Lenb(arrbytOctet)
         OctetToHexStr = OctetToHexStr & "\" _
             & Right("0" & Hex(Ascb(Midb(arrbytOctet, k, 1))), 2)
     Next
End Function