' Logon2.vbs ' VBScript logon script program. ' ' ---------------------------------------------------------------------- ' Copyright (c) 2002-2010 Richard L. Mueller ' Hilltop Lab web site - http://www.rlmueller.net ' Version 1.0 - November 10, 2002 ' Version 1.1 - January 21, 2003 ' Version 1.2 - February 14, 2003 ' Version 1.3 - February 19, 2003 - Standardize Hungarian notation. ' Version 1.4 - April 18, 2003 - Remove trailing backslash from ' strNetBIOSDomain. ' Version 1.5 - June 10, 2003 - Map user home directory. ' Version 1.6 - January 25, 2004 - Modify error trapping. ' Version 1.7 - March 18, 2004 - Modify NameTranslate constants. ' Version 1.8 - July 30, 2007 - Escape any "/" characters in User DN. ' Version 1.9 - 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 ' 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 user home directory. strHomeShare = objUser.homeDirectory If (strHomeShare <> "") Then strHomeDrive = objUser.homeDrive If (strHomeDrive = "") Then strHomeDrive = "H:" End If On Error Resume Next objNetwork.MapNetworkDrive strHomeDrive, strHomeShare If (Err.Number <> 0) Then On Error GoTo 0 objNetwork.RemoveNetworkDrive strHomeDrive, True, True objNetwork.MapNetworkDrive strHomeDrive, strHomeShare 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 Admin") = True) Then On Error Resume Next objNetwork.MapNetworkDrive "M:", "\\filesrv01\admin" If (Err.Number <> 0) Then On Error GoTo 0 objNetwork.RemoveNetworkDrive "M:", True, True objNetwork.MapNetworkDrive "M:", "\\filesrv01\admin" 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) ' Bind to the computer object in Active Directory with the LDAP ' provider. Set objComputer = GetObject("LDAP://" & strComputerDN) ' Add a printer connection if the computer is a member of the group. If (IsMember(objComputer, "Room 231") = True) Then objNetwork.AddPrinterConnection "LPT1:", "\\PrintServer\Printer3" End If Function IsMember(objADObject, strGroup) ' Function to test for group membership. ' objADObject is a user or computer object. ' strGroup is the NT Name 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. 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(objPriADObject, objSubADObject) ' Recursive subroutine to populate dictionary object with group ' memberships. When this subroutine is first called by Function ' IsMember, both objPriADObject and objSubADObject are the user or ' computer object. On recursive calls objPriADObject still refers to the ' user or computer object being tested, but objSubADObject will be a ' group object. The dictionary object objGroupList keeps track of group ' memberships for each user or computer separately. For each group in ' the MemberOf collection, first check to see if the group is already in ' the dictionary object. If it is not, add the group to the dictionary ' object and recursively call this subroutine again to enumerate any ' groups the group might be a member of (nested groups). It is necessary ' to first check if the group is already in the dictionary object to ' prevent an infinite loop if the group nesting is "circular". Dim colstrGroups, objGroup, j objGroupList.CompareMode = vbTextCompare colstrGroups = objSubADObject.memberOf If (IsEmpty(colstrGroups) = True) Then Exit Sub End If If (TypeName(colstrGroups) = "String") Then Set objGroup = GetObject("LDAP://" & colstrGroups) If (objGroupList.Exists(objPriADObject.sAMAccountName & "\" _ & objGroup.sAMAccountName) = False) Then objGroupList.Add objPriADObject.sAMAccountName & "\" _ & objGroup.sAMAccountName, True Call LoadGroups(objPriADObject, objGroup) End If Exit Sub End If For j = 0 To UBound(colstrGroups) Set objGroup = GetObject("LDAP://" & colstrGroups(j)) If (objGroupList.Exists(objPriADObject.sAMAccountName & "\" _ & objGroup.sAMAccountName) = False) Then objGroupList.Add objPriADObject.sAMAccountName & "\" _ & objGroup.sAMAccountName, True Call LoadGroups(objPriADObject, objGroup) End If Next End Sub