?
Solved

Windows logins script vbs

Posted on 2009-05-20
13
Medium Priority
?
394 Views
Last Modified: 2013-12-23
I have a login script that was written by a former employee of my company.  I am not really a programmer, however I do have a BS in CS so I did have to take a bunch of programing classes in college and I remember the fundamental concepts.  

Currently our script will run ok if we have a user in a group.  example User John is in Group Sales and the Sales group has been defined to get the S drive.  The issue I have is that we cannot test groups.  So User John who is in Group Admin, and Group Admin is in Group Sales, and Sales had been defined to get the S drive.  Then John will not get the S drive.  It will only work when John is in Group Directly.  

I have attached the log in script, I am hoping that it is not very difficult.  I am thinking that there needs to be a call that checks if the membership of the group is a group or a user.  If it is a group then it would call itself to run again.  I believe it is a recursive call.  Again I took the class I just never did it in real life.

Thanks for any help
' hOption Explicit 
' Pgm		: LogInScript.vbs
' Author	: L. E. Drake (A. M. Castle)
' Date		: 05/18/2005
' Purpose	: Perform Login Drive Mapping
'
' -------------------------------------------------------------------------- '
' -----------------------------  Constants  -------------------------------- '
' -------------------------------------------------------------------------- '
 
' -------------------------------------------------------------------------- '
' ---------------------------  Global Variables  --------------------------- '
' -------------------------------------------------------------------------- '
 
Dim gintScriptReturnCode
Dim gdicDriveMappings
Dim gstrDomain
 
' -------------------------------------------------------------------------- '
' -------------------------------------------------------------------------- '
' -------------------------------------------------------------------------- '
 
Set gdicDriveMappings = CreateObject("Scripting.Dictionary")
 
' -------------------------------------------------------------------------- '
' -------------------------------------------------------------------------- '
' -------------------------------------------------------------------------- '
With gdicDriveMappings
	.Add "Developers", "g:,\\fpk-develop-dc;j:,\\intranet_test\TESTGAINS"
 
	.Add "Gains", "k:,\\fpk_gains\gainsV6"
 
	.Add "Synquest Users", "q:,\\fpk_synquest\Attach;R:,\\fpk_synquest\Calibrat"
 
	.Add "Winfiler", "e:,\\fpk_apps\apps"
 
	.Add "H_Drive_Corporate", "H:,\\fpk-corp-dc\UserData"
 
	.Add "FPK_ITHdrive", "H:,\\fpk-it-dc\UserData$"
 
	.Add "Kronos Admin", "q:,\\fpk_Kronos\kronos;T:,\\fpk-hr-dc\apps"
 
	.Add "GainsTest", "J:,\\intranet_test\testgains;g:,\\fpk_gains\gains;r:,\\intranet_test\gains6"
	
	.Add "BOA Image OnSite", "J:,\\fpk-finance-dc\Image Onsite"
 
	.Add "Domain Users", "L:,\\fpk-corp-dc\AMC-Share;I:,\\fpk-corp-dc\CHISYS"
	
	.Add "IT Department", "V:,\\fpk-it-dc\TeamData;O:,\\fpk-it-dc\Support;S:,\\fpk-it-dc\Shared-Projects"
 
	.Add "IT MGMT", "M:,\\fpk-it-dc\Management"
	
	.Add "HR Department", "P:,\\FPK-HR-DC\Data"
 
	.Add "Accounting Group", "N:,\\fpk-finance-dc\data\acctg"
 
	.Add "Finance CAR Management Security Group", "M:,\\fpk-finance-dc\data\acctg\acct"
 
	.Add "Acct_Tax Security Group", "T:,\\fpk-finance-dc\acct.tax"
 
	.Add "FAS Data Security Group", "S:,\\fpk-finance-dc\Bestserv"
 
	.Add "DunBrad", "W:,\\fpk-finance-dc\Credit;R:,\\fpk-finance-dc\RatingsPlus"
	
	.Add "Finance Payroll Data", "G:,\\fpk-finance-dc\Payroll Data"
 
	.Add "CLE_EVERYONE", "G:,\\CLE-DC\SHARED;H:,\\CLE-DC\USERDATA"
	
	.Add "KNT_EVERYONE", "G:,\\KNT-DC\SHARED;H:,\\KNT-DC\USERDATA$"
 
	.Add "TRC_Everyone", "G:,\\TRC-DC\SHARED;H:,\\TRC-DC\Userdata$"
	
	.Add "GAR_EVERYONE", "G:,\\SVCA1008\SHARED;H:,\\SVCA1008\"
	
	.Add "LA_Everyone", "G:,\\LA-DC\SHARED;H:,\\LA-DC\UserData$"
 
	.Add "LA_LA-STSdrive", "S:,\\LA-ST\SigmaNest"
 
	.Add "Torrance-Accounting", "K:,\\SVCA2008\finfiles;N:,\\svca2008\finance"
 
'	.Add "TRC_Kdrive", "K:,\\SVCA2008\finfiles"
 
	.Add "Legal", "J:,\\fpk-legal-vm\Legal$"
 
	.Add "LegalHDrive", "H:,\\fpk-legal-vm\UserData$"
 
	.Add "NEG_Everyone", "G:,\\NEG-DC\SHARED;H:,\\NEG-DC\UserData$"
 
	.Add "ORA_Everyone", "S:,\\ORA-DC\SHARED;H:,\\ORA-DC\UserData$"	
 
	.Add "WIT_Everyone", "G:,\\WIT-DC\SHARED;H:,\\WIT-DC\UserData$"
 
	.Add "WIT_SIGMA", "K:,\\WIT-DC\Groups"
 
	.Add "WIT_KC_SIGMA", "Q:,\\KC-DC\Wichita"
 
	.Add "WIT_TS_Everyone", "S:,\\WIT-DC\WIT_TS_SHARED;H:,\\WIT-DC\WIT_TS_UserData$"	
 
	.Add "WIT_WestEveryone", "S:,\\WIT-W-DC\Shared;H:,\\WIT-W-DC\UserData$"
 
	.Add "WIT_EastEveryone", "S:,\\WIT-DC\WIT_EAST_SHARED;H:,\\WIT-DC\WIT_EAST_UserData$"
 
	.Add "WIT_Gdrive", "G:,\\WIT-DC\SHARED"
 
	.Add "DAL_Everyone", "G:,\\DAL1-DC\SHARED;H:,\\DAL1-DC\UserData$"
 
	.Add "ARL_Everyone", "S:,\\ARL-DC\SHARED;H:,\\ARL-DC\UserData$"
 
	.Add "MIL_Everyone", "G:,\\MIL-VM\SHARED;H:,\\MIL-VM\UserData$"
 
	.Add "CHR_Everyone", "G:,\\CHR-DC\CHR_SHARED;H:,\\CHR-DC\CHR_UserData$"
 
	.Add "PHL_Everyone", "G:,\\NEG-DC\PHL_SHARED;H:,\\NEG-DC\PHL_UserData$"
 
	.Add "MSP_Everyone", "G:,\\MSP-DC\MSP_SHARED;H:,\\MSP-DC\MSP_UserData$"
 
	.Add "SCK_Everyone", "G:,\\SCK-DC\SCK_SHARED;H:,\\SCK-DC\SCK_UserData$"
	
	.Add "TRI_Everyone", "G:,\\TRI-DC\TRI_SHARED;H:,\\TRI-DC\TRI_UserData$"
 
	.Add "TRI_SIGMA_W", "T:,\\TRI-DC\Groups"
 
	.Add "EDM_Everyone", "G:,\\EDM-DC\SHARED;H:,\\EDM-DC\UserData$"
 
	.Add "KC_Everyone", "G:,\\KC-DC\SHARED;H:,\\KC-DC\UserData$"
 
	.Add "KC_Sigma", "T:,\\KC-DC\Sigma"
 
	.Add "KC_KC-STSdrive", "S:,\\KC-ST\SigmaNest"
 
	.Add "MON_Everyone", "G:,\\MON-DC\SHARED;H:,\\MON-DC\UserData$"
 
	.Add "HOU_Everyone", "G:,\\HOU-DC\SHARED;H:,\\HOU-DC\UserData$"
 
	.Add "Letchworth_Everyone", "S:,\\svuk0008\SHARED;H:,\\svuk0008\UserData$"
 
	.Add "TS Clients - UK", "P:,\\UKSERVER03\pentsrvr"
 
	.Add "WIN_Everyone", "G:,\\WIN-DC\SHARED;H:,\\WIN-DC\UserData$"
 
	.Add "TOR_Everyone", "G:,\\TOR-DC\SHARED;H:,\\TOR-DC\UserData$"
 
	.Add "TS Clients UK", "P:,\\ukserver03\pentsrvr"
 
	.Add "TS Clients FR", "P:,\\ukserver03\pentsrvr"
 
	.Add "France Users", "S:,\\fra-dc\Informatiquer"
 
	.Add "SHNG_Everyone", "G:,\\SHNG-DC\SHARED;H:,\\SHNG-DC\UserData$"
 
	.Add "KSW_Everyone", "S:,\\KSW-DC\SHARED;H:,\\KSW-DC\UserData$"
 
	.Add "OLV_Everyone", "H:,\\Ospserver\UserData$"
 
	.Add "BSR Project", "P:,\\FPK-BSR-VM\Data"
 
End With
 
gstrDomain = "AMCASTLE.COM"
 
' -------------------------------------------------------------------------- '
' -------------------------------------------------------------------------- '
' -------------------------------------------------------------------------- '
 
Sub Include(pstrFileName)
' -------------------------------------------------------------------------- '
' Author	: L. E. Drake (A. M. Castle)
' Date		: 00/00/0000
' Purpose	: Generic (common) Function to include other "code files"
' -------------------------------------------------------------------------- '
' Modification
' Mod By			Date		Ticket		Comment
' ---------------	----------	--------	--------------------------------
' Programmer		MM/DD/YYYY	12345678	Comment
'
' -------------------------------------------------------------------------- '
	Dim FSO
	Dim objFile
 
	Dim strTemp
 
	Set FSO = Wscript.CreateObject("Scripting.FileSystemObject")
	Set objFile = FSO.OpenTextFile(pstrFileName)
 
	strTemp = objFile.ReadAll()
	objFile.Close
 
	ExecuteGlobal strTemp
 
	Set FSO = Nothing
	Set objFile = Nothing
 
End Sub
 
gintScriptReturnCode = 0
gintScriptReturnCode = Main(gstrDomain)
WScript.Quit(gintScriptReturnCode)
 
 
Function Main(pstrDomain)
' -------------------------------------------------------------------------- '
' Author	: L. E. Drake (A. M. Castle)
' Date		: 05/18/2005
' Purpose	: Main Process Control
' -------------------------------------------------------------------------- '
' Modification
' Mod By			Date		Ticket		Comment
' ---------------	----------	--------	--------------------------------
' Programmer		MM/DD/YYYY	12345678	Comment
'
' -------------------------------------------------------------------------- '
 
	Dim FSO											' File System Object
	Dim objNetwork									' Network Object
	Dim objNetworkMember							' Network "User" Member
	Dim objGroup
 
	Dim arrArray1									' Working Array #1
	Dim arrArray2									' Working Array #2
	Dim intI1										' Working Index #1
	Dim intLB1										' Lower Bound Index #1
	Dim intReturnCode								' OS Level ReturnCode
	Dim intUB1										' Upper Bound Index #1
	Dim strDomain									' AMC Domain Name
	Dim strDrive									' Drive letter and ":"
	Dim strGroupName								' AMC Group Name
	Dim strShare									' Network Share
	Dim strUserName									' AMC User ID
 
	Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
	Set objNetwork = WScript.CreateObject("WScript.Network")
 
	'''MsgBox "Hello World!", 65, "MsgBox Example"
	'''WScript.Sleep 20000
 
	intReturnCode = 0								' Populate default value
 
	strDomain = pstrDomain
 
	strUserName = objNetwork.UserName
 
	Set objNetworkMember = GetObject("WinNT://" & strDomain & "/" & strUserName)
 
	For Each objGroup In objNetworkMember.Groups 
 
		strGroupName = Trim(objGroup.Name)
 
		' WScript.Echo "DBG: [" & strGroupName & "]"
 
		If gdicDriveMappings.Exists(strGroupName) Then
 
			' WScript.Echo "Found " & strGroupName & " [" & gdicDriveMappings.Item(strGroupName) & "]"
			arrArray1 = split(gdicDriveMappings.Item(strGroupName), ";")
			intLB1 = LBound(arrArray1)
			intUB1 = UBound(arrArray1)
 
			For intI1 = intLB1 To intUB1
				arrArray2 = split(arrArray1(intI1), ",")
				strDrive = arrArray2(0)
				strShare = arrArray2(1)
				If len(strDrive) = 2 Then
					
					'+++
					' Note: We could use regular expressions to do this test
					'		but for simplicity sake, we will test in a traditional 
					'		manner.
					'+++
					If (Left(strDrive,1) >= "A" And Left(strDrive,1) <= "Z") _
						Or (Left(strDrive,1) >= "a" And Left(strDrive,1) <= "z") Then
						
						'+++
						' We are expecting "x:" x being a letter either 
						' uppercase or lowercase
						'+++
						strDrive = Left(strDrive,1) & ":"		' Force correctness
 
						'+++
						' Test the last character of the Network Share Name
						'+++
						If ValidFileNameCharacter(Right(strShare, 1)) Then
 
							On Error Resume Next			' Set Error Trap
							If strDrive = "H:" Then
								'''objNetwork.MapNetworkDrive  strDrive, strShare & "\" & strUserName
								MapThisDrive objNetwork, strDrive, strShare & "\" & strUserName
							Else
								'''objNetwork.MapNetworkDrive  strDrive, strShare
								MapThisDrive objNetwork, strDrive, strShare
							End If
							
							If err.number <> 0 Then
 
								' WScript.Echo Err.Description & vbNewLine & _
								'	"Drive " &  strDrive & " is in error!"
 
								intReturnCode = 30
								
							End If
 
							On Error GoTo 0					' Clear Error Trap
 
						Else
 
							'+++
							' The Network Share name as passed is not valid
							' Most likely it is a "\"
							'+++
							
							intReturnCode = 20
 
						End If
 
					Else
						
						'+++
						' Invalid Drive letter specified
						'+++
 
						intReturnCode = 15
						
					End If
 
				Else
 
					'+++
					' Invalid Drive letter specification
					'+++
 
					intReturnCode = 10
 
				End If
			
				'+++
				' May want to delete or "comment out" the following 
				'+++
				' WScript.Echo "strDrive = [" & strDrive & "] " & "strShare = [" & strShare & "]"
 
			Next
 
		End If
 
	Next
 
 
	'+++
	' Clean Up
	'+++
	Set FSO = Nothing
	Set objGroup = Nothing
	Set objNetwork = Nothing
	Set objNetworkMember = Nothing
 
 
	' --- Terminate ---
	Main = CInt(intReturnCode)
 
End Function
 
 
Function ValidFileNameCharacter(pstrText)
' -------------------------------------------------------------------------- '
' Author	: L. E. Drake (A. M. Castle)
' Date		: 05/19/2005
' Purpose	: Test to see if a string has invalid charactes in it
' Comment	: The listed characters are not valid for file names
' -------------------------------------------------------------------------- '
' Modification
' Mod By			Date		Ticket		Comment
' ---------------	----------	--------	--------------------------------
' Programmer		MM/DD/YYYY	12345678	Comment
'
' -------------------------------------------------------------------------- '
 
	Dim blnReturnCode
	Dim intI
	Dim strInvalidCharacters
 
	blnReturnCode = True
 
	strInvalidCharacters = chr(34) & "*?\|/:<>"
 
	For intI = 1 To Len(pstrText)
 
		If Instr(strInvalidCharacters, Mid(pstrText,intI,1)) <> 0 Then
 
			blnReturnCode = False
 
			Exit For
			
		End If
 
	Next
 
	ValidFileNameCharacter = blnReturnCode
 
End Function
 
 
Function MapThisDrive(pobjNetwork, pstrDriveLetter, pstrShare)
' -------------------------------------------------------------------------- '
' Author	: L. E. Drake (A. M. Castle)
' Date		: 12/19/2007 
' Purpose	: Map Network Drive
' Comment	: Created ifr emergency DEBUG in Clev
' -------------------------------------------------------------------------- '
' Modification
' Mod By			Date		Ticket		Comment
' ---------------	----------	--------	--------------------------------
' Programmer		MM/DD/YYYY	12345678	Comment
'
' -------------------------------------------------------------------------- '
	Const NO_CONNECTION = -2147022646
 
	Dim FSO				: Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
	Dim blnReturnCode	: blnReturnCode = False
	Dim intX			: intX = CInt(0)
 
	On Error Resume Next
	For intX = 0 To 4 Step 1
 
		.RemoveNetworkDrive pstrDriveLetter
		If Err.Number = NO_CONNECTION Then
			Err.Clear
		End If
 
		pobjNetwork.MapNetworkDrive pstrDriveLetter, pstrShare
 
		'''If Err.Number <> 0 Then
		'''	WScript.Echo "DBG: Error #" & Err.Number & " - " & Err.Description &_
		'''	pstrDriveLetter & " " & pstrShare & vbNewLine
		'''End If
 
		If FSO.FolderExists(pstrDriveLetter & "\") Then
			blnReturnCode = True
			Exit For
		Else
			WScript.Sleep 3000
		End If
	Next
	On Error GoTo 0
 
	Set FSO = Nothing
 
	MapThisDrive = blnReturnCode
End Function

Open in new window

0
Comment
Question by:tdisalvo
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 7
  • 6
13 Comments
 
LVL 71

Expert Comment

by:Chris Dent
ID: 24439787

Which service pack do you run on your Windows Servers?

I have a function that will return nested group membership for users without the need for a recursive query. But it needs you to be running SP2 (I forget if the update is included in SP1).

It returns the groups as a dictionary object, meaning you can do:

Set objUsersGroups = GetAllGroups

If objUsersGroups.Exists("Some Group") Then
  ' Map a drive
End If

Do you know how to fit it into your own script here?

Chris
Function GetAllGroups
  Dim objADSysInfo : Set objADSysInfo = CreateObject("ADSystemInfo")
  Dim strUserDN : strUserDN = objADSysInfo.UserName
  Set objADSysInfo = Nothing
 
  Dim strFilter : strFilter = "(member:1.2.840.113556.1.4.1941:=" & strUserDN & ")"
 
  Dim objConnection : Set objConnection = CreateObject("ADODB.Connection")
  objConnection.Provider = "ADsDSOObject"
  objConnection.Open "Active Directory Provider"
 
  Dim objRootDSE : Set objRootDSE = GetObject("LDAP://RootDSE")
  Dim objRecordSet : Set objRecordSet = objConnection.Execute( _
    "<LDAP://" & objRootDSE.Get("defaultNamingContext") & ">;" & _
    strFilter & ";distinguishedName,name;subtree")
  Set objRootDSE = Nothing
 
  Dim objGroups : Set objGroups = CreateObject("Scripting.Dictionary")
  objGroups.CompareMode = VbTextCompare
 
  While Not objRecordSet.EOF
    Dim strGroup : strGroup = objRecordSet.Fields("name").Value
    If Not objGroups.Exists(strGroup) Then
      objGroups.Add UCase(strGroup), ""
    End If
    objRecordSet.MoveNext
  WEnd
 
  Set GetAllGroups = objGroups
 
  Set objGroups = Nothing
End Function

Open in new window

0
 

Author Comment

by:tdisalvo
ID: 24537700
We are running SP2.  Unfortunalty I am not very good with scripts.  Could I get an assist and explation of where this would fit into my current script?

Thanks

Tony DiSalvo  
0
 
LVL 71

Expert Comment

by:Chris Dent
ID: 24537728

I'll show you, bear with me.

Chris
0
Optimum High-Definition Video Viewing and Control

The ATEN VM0404HA 4x4 4K HDMI Matrix Switch supports 4K resolutions of UHD (3840 x 2160) and DCI (4096 x 2160) with refresh rates of 30 Hz (4:4:4) and 60 Hz (4:2:0). It is ideal for applications where the routing of 4K digital signals is required.

 
LVL 71

Expert Comment

by:Chris Dent
ID: 24538301

Like this. I rewrote the script a bit... please yell if anything isn't clear. Debugging is on at the moment, so don't be puzzled if it's popping up boxes, just so it can be fully tested.

Chris
Option Explicit 
 
' Pgm     : LogInScript.vbs
' Author  : L. E. Drake (A. M. Castle)
' Date    : 05/18/2005
' Purpose : Perform Login Drive Mapping
 
 
' Change Log:
'
' Mod By                Date        Ticket          Comment
' ---------------       ----------  --------        --------------------------------
' Chris Dent (EE)       06/03/2009  N/A             Added Support for Nested Group membership
'                                                   Added Comments and restructured / reformatted script
'                                                   http://www.experts-exchange.com/Q_24424730.html
 
'
' Manually Defined Values for this Script
'
 
' With this option turned on information for debugging this script will be echoed.
' Set to False to disable these notifications.
 
Const ENABLE_DEBUG = True
 
' A list of all Groups for Drive / Shares
 
Dim objDriveMappings : Set objDriveMappings = CreateObject("Scripting.Dictionary")
With objDriveMappings
  .CompareMode = vbTextCompare
  .Add "Developers", "g:,\\fpk-develop-dc;j:,\\intranet_test\TESTGAINS"
  .Add "Gains", "k:,\\fpk_gains\gainsV6"
  .Add "Synquest Users", "q:,\\fpk_synquest\Attach;R:,\\fpk_synquest\Calibrat"
  .Add "Winfiler", "e:,\\fpk_apps\apps"
  .Add "H_Drive_Corporate", "H:,\\fpk-corp-dc\UserData"
  .Add "FPK_ITHdrive", "H:,\\fpk-it-dc\UserData$"
  .Add "Kronos Admin", "q:,\\fpk_Kronos\kronos;T:,\\fpk-hr-dc\apps"
  .Add "GainsTest", "J:,\\intranet_test\testgains;g:,\\fpk_gains\gains;r:,\\intranet_test\gains6"
  .Add "BOA Image OnSite", "J:,\\fpk-finance-dc\Image Onsite"
  .Add "Domain Users", "L:,\\fpk-corp-dc\AMC-Share;I:,\\fpk-corp-dc\CHISYS"
  .Add "IT Department", "V:,\\fpk-it-dc\TeamData;O:,\\fpk-it-dc\Support;S:,\\fpk-it-dc\Shared-Projects"
  .Add "IT MGMT", "M:,\\fpk-it-dc\Management"
  .Add "HR Department", "P:,\\FPK-HR-DC\Data"
  .Add "Accounting Group", "N:,\\fpk-finance-dc\data\acctg"
  .Add "Finance CAR Management Security Group", "M:,\\fpk-finance-dc\data\acctg\acct"
  .Add "Acct_Tax Security Group", "T:,\\fpk-finance-dc\acct.tax"
  .Add "FAS Data Security Group", "S:,\\fpk-finance-dc\Bestserv"
  .Add "DunBrad", "W:,\\fpk-finance-dc\Credit;R:,\\fpk-finance-dc\RatingsPlus"
  .Add "Finance Payroll Data", "G:,\\fpk-finance-dc\Payroll Data"
  .Add "CLE_EVERYONE", "G:,\\CLE-DC\SHARED;H:,\\CLE-DC\USERDATA"
  .Add "KNT_EVERYONE", "G:,\\KNT-DC\SHARED;H:,\\KNT-DC\USERDATA$"
  .Add "TRC_Everyone", "G:,\\TRC-DC\SHARED;H:,\\TRC-DC\Userdata$"
  .Add "GAR_EVERYONE", "G:,\\SVCA1008\SHARED;H:,\\SVCA1008\"
  .Add "LA_Everyone", "G:,\\LA-DC\SHARED;H:,\\LA-DC\UserData$"
  .Add "LA_LA-STSdrive", "S:,\\LA-ST\SigmaNest"
  .Add "Torrance-Accounting", "K:,\\SVCA2008\finfiles;N:,\\svca2008\finance"
  .Add "Legal", "J:,\\fpk-legal-vm\Legal$"
  .Add "LegalHDrive", "H:,\\fpk-legal-vm\UserData$"
  .Add "NEG_Everyone", "G:,\\NEG-DC\SHARED;H:,\\NEG-DC\UserData$"
  .Add "ORA_Everyone", "S:,\\ORA-DC\SHARED;H:,\\ORA-DC\UserData$"  
  .Add "WIT_Everyone", "G:,\\WIT-DC\SHARED;H:,\\WIT-DC\UserData$"
  .Add "WIT_SIGMA", "K:,\\WIT-DC\Groups"
  .Add "WIT_KC_SIGMA", "Q:,\\KC-DC\Wichita"
  .Add "WIT_TS_Everyone", "S:,\\WIT-DC\WIT_TS_SHARED;H:,\\WIT-DC\WIT_TS_UserData$"  
  .Add "WIT_WestEveryone", "S:,\\WIT-W-DC\Shared;H:,\\WIT-W-DC\UserData$"
  .Add "WIT_EastEveryone", "S:,\\WIT-DC\WIT_EAST_SHARED;H:,\\WIT-DC\WIT_EAST_UserData$"
  .Add "WIT_Gdrive", "G:,\\WIT-DC\SHARED"
  .Add "DAL_Everyone", "G:,\\DAL1-DC\SHARED;H:,\\DAL1-DC\UserData$"
  .Add "ARL_Everyone", "S:,\\ARL-DC\SHARED;H:,\\ARL-DC\UserData$"
  .Add "MIL_Everyone", "G:,\\MIL-VM\SHARED;H:,\\MIL-VM\UserData$"
  .Add "CHR_Everyone", "G:,\\CHR-DC\CHR_SHARED;H:,\\CHR-DC\CHR_UserData$"
  .Add "PHL_Everyone", "G:,\\NEG-DC\PHL_SHARED;H:,\\NEG-DC\PHL_UserData$"
  .Add "MSP_Everyone", "G:,\\MSP-DC\MSP_SHARED;H:,\\MSP-DC\MSP_UserData$"
  .Add "SCK_Everyone", "G:,\\SCK-DC\SCK_SHARED;H:,\\SCK-DC\SCK_UserData$"
  .Add "TRI_Everyone", "G:,\\TRI-DC\TRI_SHARED;H:,\\TRI-DC\TRI_UserData$"
  .Add "TRI_SIGMA_W", "T:,\\TRI-DC\Groups"
  .Add "EDM_Everyone", "G:,\\EDM-DC\SHARED;H:,\\EDM-DC\UserData$"
  .Add "KC_Everyone", "G:,\\KC-DC\SHARED;H:,\\KC-DC\UserData$"
  .Add "KC_Sigma", "T:,\\KC-DC\Sigma"
  .Add "KC_KC-STSdrive", "S:,\\KC-ST\SigmaNest"
  .Add "MON_Everyone", "G:,\\MON-DC\SHARED;H:,\\MON-DC\UserData$"
  .Add "HOU_Everyone", "G:,\\HOU-DC\SHARED;H:,\\HOU-DC\UserData$"
  .Add "Letchworth_Everyone", "S:,\\svuk0008\SHARED;H:,\\svuk0008\UserData$"
  .Add "TS Clients - UK", "P:,\\UKSERVER03\pentsrvr"
  .Add "WIN_Everyone", "G:,\\WIN-DC\SHARED;H:,\\WIN-DC\UserData$"
  .Add "TOR_Everyone", "G:,\\TOR-DC\SHARED;H:,\\TOR-DC\UserData$"
  .Add "TS Clients UK", "P:,\\ukserver03\pentsrvr"
  .Add "TS Clients FR", "P:,\\ukserver03\pentsrvr"
  .Add "France Users", "S:,\\fra-dc\Informatiquer"
  .Add "SHNG_Everyone", "G:,\\SHNG-DC\SHARED;H:,\\SHNG-DC\UserData$"
  .Add "KSW_Everyone", "S:,\\KSW-DC\SHARED;H:,\\KSW-DC\UserData$"
  .Add "OLV_Everyone", "H:,\\Ospserver\UserData$"
  .Add "BSR Project", "P:,\\FPK-BSR-VM\Data"
End With
 
'
' Functions and Subroutines (in order) 
'
 
Function GetAllGroups
  ' This function returns all groups the current user belongs to.
  ' The LDAP Filter uses LDAP_MATCHING_RULE_IN_CHAIN to follow nested groups.
  ' http://support.microsoft.com/kb/914828
  ' 
  ' Return Type: Scripting.Dictionary
 
  ' Get the current user
  Dim objADSysInfo : Set objADSysInfo = CreateObject("ADSystemInfo")
  Dim strUserDN : strUserDN = objADSysInfo.UserName
  Set objADSysInfo = Nothing
 
  ' Create an LDAP Filter 
  Dim strFilter : strFilter = "(member:1.2.840.113556.1.4.1941:=" & strUserDN & ")"
 
  Dim objConnection : Set objConnection = CreateObject("ADODB.Connection")
  objConnection.Provider = "ADsDSOObject"
  objConnection.Open "Active Directory Provider"
 
  Dim objCommand : Set objCommand = CreateObject("ADODB.Command")
  Set objCommand.ActiveConnection = objConnection
  objCommand.Properties("Page Size") = 1000
 
  ' Get the current AD Domain information from RootDSE
  Dim objRootDSE : Set objRootDSE = GetObject("LDAP://RootDSE")
  objCommand.CommandText = "<LDAP://" & objRootDSE.Get("defaultNamingContext") & ">;" & _
    strFilter & ";distinguishedName,name;subtree"
  Set objRootDSE = Nothing
 
  Dim objRecordSet : Set objRecordSet = objCommand.Execute
 
  ' Create a dictionary object to store the results
  Dim objGroups : Set objGroups = CreateObject("Scripting.Dictionary")
  objGroups.CompareMode = VbTextCompare
 
  While Not objRecordSet.EOF
    Dim strGroup : strGroup = objRecordSet.Fields("name").Value
    If Not objGroups.Exists(strGroup) Then
      objGroups.Add UCase(strGroup), ""
    End If
    objRecordSet.MoveNext
  WEnd
 
  Set GetAllGroups = objGroups
 
  Set objGroups = Nothing
End Function
 
Sub MapThisDrive(strDrive, strShare)
  ' Author  : L. E. Drake (A. M. Castle)
  ' Date    : 12/19/2007 
  ' Purpose  : Map Network Drive
  ' Comment  : Simplified (06/03/2009)
 
  Dim objNetwork : Set objNetwork = CreateObject("WScript.Network") 
  Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
 
  On Error Resume Next
 
  If objFSO.DriveExists(strDrive) Then
    objNetwork.RemoveNetworkDrive strDrive
  End If
 
  Err.Clear
  objNetwork.MapNetworkDrive strDrive, strShare
 
  ' Debugging option
  If ENABLE_DEBUG = True Then
    If Err.Number <> 0 Then
      WScript.Echo "ERROR: [MapThisDrive] " & strDrive & " " & strShare & ": " & Err.Description
    End If
  End If
 
  On Error Goto 0
End Sub
 
'
' Main Code Section
'
 
' Retrieve the users groups
Dim objGroups : Set objGroups = GetAllGroups
 
Dim strGroup, strGroups
If ENABLE_DEBUG = True Then
  For Each strGroup in objGroups
    strGroups = strGroups & strGroup & vbCrLf
  Next
  WScript.Echo "Current user is a member of the following groups: " & vbCrLf & strGroups
End If
 
' Loop through each group the user belongs to
For Each strGroup in objGroups
 
  If objDriveMappings.Exists(strGroup) Then
 
    ' Get the drive letter and share from the list
    Dim strDrive : strDrive = UCase(Split(objDriveMappings(strGroup), ",")(0))
    Dim strShare : strShare = Split(objDriveMappings(strGroup), ",")(1)
 
    ' If this is the host drive add the current username to the path
    If strDrive = "H:" Then
 
      Dim objNetwork : Set objNetwork = CreateObject("WScript.Network")
      MapThisDrive strDrive, strShare & "\" & objNetwork.Username
      Set objNetwork = Nothing
 
    Else
 
      MapThisDrive strDrive, strShare
 
    End If
 
  End If
Next

Open in new window

0
 

Author Comment

by:tdisalvo
ID: 24548131
Chris,
Thanks so much for your help.  I am seeing one problem.  When you have multiple drive letters assigned per group you get an error trying to map the drive.  The error is

ERROR:[MapThisDrive] W:\\fpk-finace-dc\Credit;R:: The network path was not found.

This would be the error when you are in the DunBrad Group.  the line of code this referse to is

  .Add "DunBrad", "W:,\\fpk-finance-dc\Credit;R:,\\fpk-finance-dc\RatingsPlus"

I am assuming that this is a context change that I may need to adjust.

Your help is really appreciated.

Thanks
Tony DiSalvo
0
 

Author Comment

by:tdisalvo
ID: 24576742
I have found out that if you change the line to

.Add "DunBrad", "W:,\\fpk-finance-dc\Credit, ;R:,\\fpk-finance-dc\RatingsPlus"

it will run but it will only map the W dirve.

I tried

.Add "DunBrad", "W:,\\fpk-finance-dc\Credit", "R:,\\fpk-finance-dc\RatingsPlus"

but when I try and run this I get an error "wrong number of arguments or invalid property assignment 'add'

0
 
LVL 71

Expert Comment

by:Chris Dent
ID: 24579229

I didn't notice you had multiple assignments for the same group. I'll take another look.

Chris
0
 
LVL 71

Accepted Solution

by:
Chris Dent earned 2000 total points
ID: 24579294

This should work.

Chris
Option Explicit 
 
' Pgm     : LogInScript.vbs
' Author  : L. E. Drake (A. M. Castle)
' Date    : 05/18/2005
' Purpose : Perform Login Drive Mapping
 
 
' Change Log:
'
' Mod By                Date        Ticket          Comment
' ---------------       ----------  --------        --------------------------------
' Chris Dent (EE)       06/03/2009  N/A             Added Support for Nested Group membership
'                                                   Added Comments and restructured / reformatted script
'                                                   http://www.experts-exchange.com/Q_24424730.html
 
'
' Manually Defined Values for this Script
'
 
' With this option turned on information for debugging this script will be echoed.
' Set to False to disable these notifications.
 
Const ENABLE_DEBUG = True
 
' A list of all Groups for Drive / Shares
 
Dim objDriveMappings : Set objDriveMappings = CreateObject("Scripting.Dictionary")
With objDriveMappings
  .CompareMode = vbTextCompare
  .Add "Developers", "g:,\\fpk-develop-dc;j:,\\intranet_test\TESTGAINS"
  .Add "Gains", "k:,\\fpk_gains\gainsV6"
  .Add "Synquest Users", "q:,\\fpk_synquest\Attach;R:,\\fpk_synquest\Calibrat"
  .Add "Winfiler", "e:,\\fpk_apps\apps"
  .Add "H_Drive_Corporate", "H:,\\fpk-corp-dc\UserData"
  .Add "FPK_ITHdrive", "H:,\\fpk-it-dc\UserData$"
  .Add "Kronos Admin", "q:,\\fpk_Kronos\kronos;T:,\\fpk-hr-dc\apps"
  .Add "GainsTest", "J:,\\intranet_test\testgains;g:,\\fpk_gains\gains;r:,\\intranet_test\gains6"
  .Add "BOA Image OnSite", "J:,\\fpk-finance-dc\Image Onsite"
  .Add "Domain Users", "L:,\\fpk-corp-dc\AMC-Share;I:,\\fpk-corp-dc\CHISYS"
  .Add "IT Department", "V:,\\fpk-it-dc\TeamData;O:,\\fpk-it-dc\Support;S:,\\fpk-it-dc\Shared-Projects"
  .Add "IT MGMT", "M:,\\fpk-it-dc\Management"
  .Add "HR Department", "P:,\\FPK-HR-DC\Data"
  .Add "Accounting Group", "N:,\\fpk-finance-dc\data\acctg"
  .Add "Finance CAR Management Security Group", "M:,\\fpk-finance-dc\data\acctg\acct"
  .Add "Acct_Tax Security Group", "T:,\\fpk-finance-dc\acct.tax"
  .Add "FAS Data Security Group", "S:,\\fpk-finance-dc\Bestserv"
  .Add "DunBrad", "W:,\\fpk-finance-dc\Credit;R:,\\fpk-finance-dc\RatingsPlus"
  .Add "Finance Payroll Data", "G:,\\fpk-finance-dc\Payroll Data"
  .Add "CLE_EVERYONE", "G:,\\CLE-DC\SHARED;H:,\\CLE-DC\USERDATA"
  .Add "KNT_EVERYONE", "G:,\\KNT-DC\SHARED;H:,\\KNT-DC\USERDATA$"
  .Add "TRC_Everyone", "G:,\\TRC-DC\SHARED;H:,\\TRC-DC\Userdata$"
  .Add "GAR_EVERYONE", "G:,\\SVCA1008\SHARED;H:,\\SVCA1008\"
  .Add "LA_Everyone", "G:,\\LA-DC\SHARED;H:,\\LA-DC\UserData$"
  .Add "LA_LA-STSdrive", "S:,\\LA-ST\SigmaNest"
  .Add "Torrance-Accounting", "K:,\\SVCA2008\finfiles;N:,\\svca2008\finance"
  .Add "Legal", "J:,\\fpk-legal-vm\Legal$"
  .Add "LegalHDrive", "H:,\\fpk-legal-vm\UserData$"
  .Add "NEG_Everyone", "G:,\\NEG-DC\SHARED;H:,\\NEG-DC\UserData$"
  .Add "ORA_Everyone", "S:,\\ORA-DC\SHARED;H:,\\ORA-DC\UserData$"  
  .Add "WIT_Everyone", "G:,\\WIT-DC\SHARED;H:,\\WIT-DC\UserData$"
  .Add "WIT_SIGMA", "K:,\\WIT-DC\Groups"
  .Add "WIT_KC_SIGMA", "Q:,\\KC-DC\Wichita"
  .Add "WIT_TS_Everyone", "S:,\\WIT-DC\WIT_TS_SHARED;H:,\\WIT-DC\WIT_TS_UserData$"  
  .Add "WIT_WestEveryone", "S:,\\WIT-W-DC\Shared;H:,\\WIT-W-DC\UserData$"
  .Add "WIT_EastEveryone", "S:,\\WIT-DC\WIT_EAST_SHARED;H:,\\WIT-DC\WIT_EAST_UserData$"
  .Add "WIT_Gdrive", "G:,\\WIT-DC\SHARED"
  .Add "DAL_Everyone", "G:,\\DAL1-DC\SHARED;H:,\\DAL1-DC\UserData$"
  .Add "ARL_Everyone", "S:,\\ARL-DC\SHARED;H:,\\ARL-DC\UserData$"
  .Add "MIL_Everyone", "G:,\\MIL-VM\SHARED;H:,\\MIL-VM\UserData$"
  .Add "CHR_Everyone", "G:,\\CHR-DC\CHR_SHARED;H:,\\CHR-DC\CHR_UserData$"
  .Add "PHL_Everyone", "G:,\\NEG-DC\PHL_SHARED;H:,\\NEG-DC\PHL_UserData$"
  .Add "MSP_Everyone", "G:,\\MSP-DC\MSP_SHARED;H:,\\MSP-DC\MSP_UserData$"
  .Add "SCK_Everyone", "G:,\\SCK-DC\SCK_SHARED;H:,\\SCK-DC\SCK_UserData$"
  .Add "TRI_Everyone", "G:,\\TRI-DC\TRI_SHARED;H:,\\TRI-DC\TRI_UserData$"
  .Add "TRI_SIGMA_W", "T:,\\TRI-DC\Groups"
  .Add "EDM_Everyone", "G:,\\EDM-DC\SHARED;H:,\\EDM-DC\UserData$"
  .Add "KC_Everyone", "G:,\\KC-DC\SHARED;H:,\\KC-DC\UserData$"
  .Add "KC_Sigma", "T:,\\KC-DC\Sigma"
  .Add "KC_KC-STSdrive", "S:,\\KC-ST\SigmaNest"
  .Add "MON_Everyone", "G:,\\MON-DC\SHARED;H:,\\MON-DC\UserData$"
  .Add "HOU_Everyone", "G:,\\HOU-DC\SHARED;H:,\\HOU-DC\UserData$"
  .Add "Letchworth_Everyone", "S:,\\svuk0008\SHARED;H:,\\svuk0008\UserData$"
  .Add "TS Clients - UK", "P:,\\UKSERVER03\pentsrvr"
  .Add "WIN_Everyone", "G:,\\WIN-DC\SHARED;H:,\\WIN-DC\UserData$"
  .Add "TOR_Everyone", "G:,\\TOR-DC\SHARED;H:,\\TOR-DC\UserData$"
  .Add "TS Clients UK", "P:,\\ukserver03\pentsrvr"
  .Add "TS Clients FR", "P:,\\ukserver03\pentsrvr"
  .Add "France Users", "S:,\\fra-dc\Informatiquer"
  .Add "SHNG_Everyone", "G:,\\SHNG-DC\SHARED;H:,\\SHNG-DC\UserData$"
  .Add "KSW_Everyone", "S:,\\KSW-DC\SHARED;H:,\\KSW-DC\UserData$"
  .Add "OLV_Everyone", "H:,\\Ospserver\UserData$"
  .Add "BSR Project", "P:,\\FPK-BSR-VM\Data"
End With
 
'
' Functions and Subroutines (in order) 
'
 
Function GetAllGroups
  ' This function returns all groups the current user belongs to.
  ' The LDAP Filter uses LDAP_MATCHING_RULE_IN_CHAIN to follow nested groups.
  ' http://support.microsoft.com/kb/914828
  ' 
  ' Return Type: Scripting.Dictionary
 
  ' Get the current user
  Dim objADSysInfo : Set objADSysInfo = CreateObject("ADSystemInfo")
  Dim strUserDN : strUserDN = objADSysInfo.UserName
  Set objADSysInfo = Nothing
 
  ' Create an LDAP Filter 
  Dim strFilter : strFilter = "(member:1.2.840.113556.1.4.1941:=" & strUserDN & ")"
 
  Dim objConnection : Set objConnection = CreateObject("ADODB.Connection")
  objConnection.Provider = "ADsDSOObject"
  objConnection.Open "Active Directory Provider"
 
  Dim objCommand : Set objCommand = CreateObject("ADODB.Command")
  Set objCommand.ActiveConnection = objConnection
  objCommand.Properties("Page Size") = 1000
 
  ' Get the current AD Domain information from RootDSE
  Dim objRootDSE : Set objRootDSE = GetObject("LDAP://RootDSE")
  objCommand.CommandText = "<LDAP://" & objRootDSE.Get("defaultNamingContext") & ">;" & _
    strFilter & ";distinguishedName,name;subtree"
  Set objRootDSE = Nothing
 
  Dim objRecordSet : Set objRecordSet = objCommand.Execute
 
  ' Create a dictionary object to store the results
  Dim objGroups : Set objGroups = CreateObject("Scripting.Dictionary")
  objGroups.CompareMode = VbTextCompare
 
  While Not objRecordSet.EOF
    Dim strGroup : strGroup = objRecordSet.Fields("name").Value
    If Not objGroups.Exists(strGroup) Then
      objGroups.Add UCase(strGroup), ""
    End If
    objRecordSet.MoveNext
  WEnd
 
  Set GetAllGroups = objGroups
 
  Set objGroups = Nothing
End Function
 
Sub MapThisDrive(strDrive, strShare)
  ' Author  : L. E. Drake (A. M. Castle)
  ' Date    : 12/19/2007 
  ' Purpose  : Map Network Drive
  ' Comment  : Simplified (06/03/2009)
 
  Dim objNetwork : Set objNetwork = CreateObject("WScript.Network") 
  Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
 
  On Error Resume Next
 
  ' If this is the home drive add the current username to the path
  If strDrive = "H:" Then
    strShare = strShare & "\" & objNetwork.Username
  End If
 
  If objFSO.DriveExists(strDrive) Then
    objNetwork.RemoveNetworkDrive strDrive
  End If
 
  Err.Clear
  objNetwork.MapNetworkDrive strDrive, strShare
 
  ' Debugging option
  If ENABLE_DEBUG = True Then
    If Err.Number <> 0 Then
      WScript.Echo "ERROR: [MapThisDrive] " & strDrive & " " & strShare & ": " & Err.Description
    End If
  End If
 
  On Error Goto 0
End Sub
 
'
' Main Code Section
'
 
' Retrieve the users groups
Dim objGroups : Set objGroups = GetAllGroups
 
Dim strGroup, strGroups
If ENABLE_DEBUG = True Then
  For Each strGroup in objGroups
    strGroups = strGroups & strGroup & vbCrLf
  Next
  WScript.Echo "Current user is a member of the following groups: " & vbCrLf & strGroups
End If
 
Dim strDrive, strShare
' Loop through each group the user belongs to
For Each strGroup in objGroups
 
  If objDriveMappings.Exists(strGroup) Then
 
    If InStr(objDriveMappings(strGroup), ";") > 0 Then
 
      Dim strMapping
      For Each strMapping in Split(objDriveMappings(strGroup), ";")
 
        ' Get the drive letter and share for this mapping
        strDrive = UCase(Split(strMapping, ",")(0))
        strShare = Split(strMapping, ",")(1)
 
        MapDrive strDrive, strShare
 
      Next
 
    Else
 
      ' Get the drive letter and share from the list
      strDrive = UCase(Split(objDriveMappings(strGroup), ",")(0))
      strShare = Split(objDriveMappings(strGroup), ",")(1)
  
      MapThisDrive strDrive, strShare
 
    End If
 
  End If
Next

Open in new window

0
 

Author Closing Comment

by:tdisalvo
ID: 31583555
Thanks for your help on this
0
 

Author Comment

by:tdisalvo
ID: 24797278
Chris

I noticed something odd.  All of the groups seem to work except for the Domain Users Group.  in line 40 Domain users is supposed to get the L and the I drive and for some reason these drives will not map.  I also went in and changed this line to use the group "test" once I did this I did get the drive mappings ok.  

Is there something that will not allow it to use Windows Built in Group?

Please advise when you get a chance,

Thanks

Tony D
0
 
LVL 71

Expert Comment

by:Chris Dent
ID: 24798409

Hey Tony,

It's because the Domain Users group is the accounts Primary Group. It's harder to return than regular groups as it doesn't get listed in the memberOf attribute. Essential that you use that one?

Chris
0
 

Author Comment

by:tdisalvo
ID: 24798812
No as long as we can Nest the Membership is there any other Primary Groups I should be aware of going forward with the script?
0
 
LVL 71

Expert Comment

by:Chris Dent
ID: 24801700

Each account can only have a single Primary Group, that's Domain Users by default. If you haven't changed it that'll be the Primary Group for all of your user accounts. I tend to ignore it, using custom groups for anything which actually needs them.

I suspect it won't find Domain Users in any nested chain either. It can be modified to check for it, but Primary Groups are rarely worth the bother :)

Chris
0

Featured Post

On Demand Webinar: Networking for the Cloud Era

Did you know SD-WANs can improve network connectivity? Check out this webinar to learn how an SD-WAN simplified, one-click tool can help you migrate and manage data in the cloud.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A common practice in small networks is making file sharing easy which works extremely well when intra-network security is not an issue. In essence, everyone, that is "Everyone", is given access to all of the shared files - often the entire C: drive …
Are you one of those front-line IT Service Desk staff fielding calls, replying to emails, all-the-while working to resolve end-user technological nightmares? I am! That's why I have put together this brief overview of tools and techniques I use in o…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Michael from AdRem Software explains how to view the most utilized and worst performing nodes in your network, by accessing the Top Charts view in NetCrunch network monitor (https://www.adremsoft.com/). Top Charts is a view in which you can set seve…
Suggested Courses

777 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question