Solved

Windows logins script vbs

Posted on 2009-05-20
13
378 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
  • 7
  • 6
13 Comments
 
LVL 70

Expert Comment

by:Chris Dent
Comment Utility

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
Comment Utility
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 70

Expert Comment

by:Chris Dent
Comment Utility

I'll show you, bear with me.

Chris
0
 
LVL 70

Expert Comment

by:Chris Dent
Comment Utility

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
Comment Utility
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
Comment Utility
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
Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

 
LVL 70

Expert Comment

by:Chris Dent
Comment Utility

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

Chris
0
 
LVL 70

Accepted Solution

by:
Chris Dent earned 500 total points
Comment Utility

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
Comment Utility
Thanks for your help on this
0
 

Author Comment

by:tdisalvo
Comment Utility
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 70

Expert Comment

by:Chris Dent
Comment Utility

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
Comment Utility
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 70

Expert Comment

by:Chris Dent
Comment Utility

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

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
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 …
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…

771 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

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now