Scripts executed when users logon to the domain, whether they are specified by Group Policy or the properties of the user object itself, are one of those areas I see vastly more confusion and argument about at customers that you would imagine merited for a piece of logic that in most cases does nothing more than map drive letters to shares.
0' Logon script to process the current users group membership from tokenGroups
1' note this is security groups only not distribution groups but does include nested
2' security groups
3Option Explicit
4
5Dim oADSystemInfo, oUser, oRootDSE, UserDnsDomain, CompDnsDomain, DrivePersist
6
7Set oRootDSE = GetObject("LDAP://RootDSE")
8Set oADSystemInfo = CreateObject("ADSystemInfo")
9Set oUser = GetObject("LDAP://" & oADSystemInfo.UserName)
10
11CompDnsDomain = oADSystemInfo.DomainDNSName
12UserDnsDomain = Replace(Replace(oRootDSE.Get("defaultNamingContext"),"DC=",""),",",".")
13DrivePersist = False
14
15MapDrives FindGroups()
16
17Sub MapDrives(dicPaths)
18Dim WshNetwork, sDriveLetter, oDriveLetters, i
19
20Set WshNetwork = WScript.CreateObject("WScript.Network")
21Set oDriveLetters = WshNetwork.EnumNetworkDrives
22
23For i = 0 To oDriveLetters.Count - 1 Step 2
24If dicPaths.Exists(oDriveLetters.Item(i)) Then
25If UCase(dicPaths.Item(oDriveLetters.Item(i))) = UCase(oDriveLetters.Item(i+1)) Then
26dicPaths.Remove oDriveLetters.Item(i)
27Else
28LogWriteLine "Remove " & oDriveLetters.Item(i)
29WshNetwork.RemoveNetworkDrive oDriveLetters.Item(i), True, True
30End If
31End If
32Next
33
34For Each sDriveLetter In dicPaths
35LogWriteLine "Map " & sDriveLetter & " = " & dicPaths.Item(sDriveLetter)
36WshNetwork.MapNetworkDrive sDriveLetter, dicPaths.Item(sDriveLetter), DrivePersist
37Next
38
39End Sub
40
41Function FindGroups()
42Dim dicGroups, aGroups, i
43
44Set dicGroups = CreateObject("Scripting.Dictionary")
45
46oUser.GetInfoEx Array("tokenGroups") , 0
47aGroups = oUser.Get("tokenGroups")
48
49If TypeName( aGroups ) = "Byte()" Then
50'single SID
51FindGroup aGroups, dicGroups
52Elseif UBound( aGroups ) > -1 Then
53'two or more SID's
54For i = 0 To UBound(aGroups)
55FindGroup aGroups(i), dicGroups
56Next
57Else
58'no SID's
59End If
60
61Set FindGroups = dicGroups
62End Function
63
64Sub FindGroup(sSID, dicGroups)
65Dim regEx, oGroup, sSamAccountName, aSections, sDriveLetter
66
67Set regEx = New RegExp
68regEx.Pattern = "MAP-[A-Z]-(DFS|SRV)-\w"
69regEx.IgnoreCase = False
70
71On Error Resume Next
72
73Set oGroup = GetObject( "LDAP://<SID=" & Octet2Hex(sSID) & ">" )
74
75If Err.Number <> 0 Then
76'Error
77LogWriteLine "Error Binding - " & sSID
78Else
79'all OK
80'LogWriteLine "Group " & oGroup.samAccountName
81sSamAccountName = oGroup.samAccountName
82If regEx.Test(sSamAccountName) Then
83aSections = Split(sSamAccountName, "-")
84sDriveLetter = aSections(1) & ":"
85If dicGroups.Exists(sDriveLetter) Then
86dicGroups.Item(sDriveLetter) = CalcTarget(aSections(2), aSections(3))
87Else
88dicGroups.Add sDriveLetter, CalcTarget(aSections(2), aSections(3))
89End If
90End If
91End If
92Err.Clear
93On Error GoTo 0
94End Sub
95
96Function CalcTarget(sType, sPath)
97sPath = Replace(sPath, "_", "\")
98
99Select Case sType
100Case "DFS"
101CalcTarget = "\\" & UserDnsDomain & "\" & sPath
102Case "SRV"
103CalcTarget = "\\" & sPath
104Case Else
105'Error should never happen due to use of regular expression check!
106End Select
107End Function
108
109Function Octet2Hex(aOctet)
110Dim i
111
112Octet2Hex = ""
113
114For i = 1 To LenB( aOctet )
115'Octet2Hex = Octet2Hex & "\" & Right( "0" & Hex( AscB( MidB( aOctet , i , 1 ) ) ) , 2 )
116Octet2Hex = Octet2Hex & Right("0" & Hex(AscB(MidB(aOctet, i, 1))), 2)
117Next
118End Function
119
120Sub LogWrite(Entry)
121Const FILE_APPENDING = 8
122
123Dim WshShell, fso, f
124
125Set fso = CreateObject("Scripting.FileSystemObject")
126Set WshShell = WScript.CreateObject("WScript.Shell")
127Set f = fso.OpenTextFile(WshShell.SpecialFolders("MyDocuments") & "\DriveMap.Log", FILE_APPENDING, True)
128
129f.Write Entry
130f.Close
131End Sub
132
133Sub LogWriteLine(Entry)
134LogWrite Entry & VbCrLf
135End Sub