' Logon3.vbs ' VBScript logon script program. ' ' ---------------------------------------------------------------------- ' Copyright (c) 2002-2010 Richard L. Mueller ' Hilltop Lab web site - http://www.rlmueller.net ' Version 1.0 - November 22, 2002 ' Version 1.1 - February 19, 2003 - Standardize Hungarian notation. ' Version 1.2 - January 25, 2004 - Modify error trapping. ' Version 1.3 - July 31, 2007 - Escape any "/" characters in DN's. ' Version 1.4 - 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 objNetwork, objSysInfo, strUserDN Dim objGroupList, objUser, objFSO Dim strComputerDN, objComputer Set objNetwork = CreateObject("Wscript.Network") Set objFSO = CreateObject("Scripting.FileSystemObject") Set objSysInfo = CreateObject("ADSystemInfo") strUserDN = objSysInfo.userName strComputerDN = objSysInfo.computerName ' Escape any forward slash characters, "/", with the backslash ' escape character. All other characters that should be escaped are. strUserDN = Replace(strUserDN, "/", "\/") strComputerDN = Replace(strComputerDN, "/", "\/") ' Bind to the user and computer objects with the LDAP provider. Set objUser = GetObject("LDAP://" & strUserDN) Set objComputer = GetObject("LDAP://" & strComputerDN) ' Map a network drive if the user is a member of the group. ' Alert the user if the drive cannot be mapped. If (IsMember(objUser, "Engineering") = True) Then If (MapDrive("M:", "\\FileServer\EngrShare") = False) Then MsgBox "Unable to Map M: to AdminShare" End If End If ' Add a network printer if the computer is a member of the group. ' Make this printer the default. If (IsMember(objComputer, "Front Office") = True) Then objNetwork.AddWindowsPrinterConnection "\\PrintServer\HPLaser2" objNetwork.SetDefaultPrinter "\\PrintServer\HPLaser2" End If Function IsMember(ByVal objADObject, ByVal strGroup) ' Function to test for group membership. ' objGroupList is a dictionary object with global scope. If (IsEmpty(objGroupList) = True) Then Set objGroupList = CreateObject("Scripting.Dictionary") End If If (objGroupList.Exists(objADObject.sAMAccountName & "\") = False) Then Call LoadGroups(objADObject, objADObject) objGroupList.Add objADObject.sAMAccountName & "\", True End If IsMember = objGroupList.Exists(objADObject.sAMAccountName & "\" _ & strGroup) End Function Sub LoadGroups(ByVal objPriObject, ByVal objADSubObject) ' Recursive subroutine to populate dictionary object objGroupList. Dim colstrGroups, objGroup, j objGroupList.CompareMode = vbTextCompare colstrGroups = objADSubObject.memberOf If (IsEmpty(colstrGroups) = True) Then Exit Sub End If If (TypeName(colstrGroups) = "String") Then ' Escape any forward slash characters, "/", with the backslash ' escape character. All other characters that should be escaped are. colstrGroups = Replace(colstrGroups, "/", "\/") Set objGroup = GetObject("LDAP://" & colstrGroups) If (objGroupList.Exists(objPriObject.sAMAccountName & "\" _ & objGroup.sAMAccountName) = False) Then objGroupList.Add objPriObject.sAMAccountName & "\" _ & objGroup.sAMAccountName, True Call LoadGroups(objPriObject, objGroup) End If Exit Sub End If For j = 0 To UBound(colstrGroups) ' Escape any forward slash characters, "/", with the backslash ' escape character. All other characters that should be escaped are. colstrGroups(j) = Replace(colstrGroups(j), "/", "\/") Set objGroup = GetObject("LDAP://" & colstrGroups(j)) If (objGroupList.Exists(objPriObject.sAMAccountName & "\" _ & objGroup.sAMAccountName) = False) Then objGroupList.Add objPriObject.sAMAccountName & "\" _ & objGroup.sAMAccountName, True Call LoadGroups(objPriObject, objGroup) End If Next End Sub Function MapDrive(ByVal strDrive, ByVal strShare) ' Function to map network share to a drive letter. ' If the drive letter specified is already in use, the function ' attempts to remove the network connection. ' objFSO is the File System Object, with global scope. ' objNetwork is the Network object, with global scope. ' Returns True if drive mapped, False otherwise. Dim objDrive On Error Resume Next If (objFSO.DriveExists(strDrive) = True) Then Set objDrive = objFSO.GetDrive(strDrive) If (Err.Number <> 0) Then On Error GoTo 0 MapDrive = False Exit Function End If If (objDrive.DriveType = 3) Then objNetwork.RemoveNetworkDrive strDrive, True, True Else MapDrive = False Exit Function End If End If objNetwork.MapNetworkDrive strDrive, strShare If (Err.Number = 0) Then MapDrive = True Else Err.Clear MapDrive = False End If On Error GoTo 0 End Function