Login script using VBScript

From Tech-Wiki
Revision as of 23:55, 10 July 2016 by Fabricio.Lima (Talk | contribs)

Jump to: navigation, search

This is a sample login script using VBScript that has all the required features such as write/check Registry keys, check group memberships and assign network printers and drives.

Just copy and save in a .vbs file in your NETLOGON folder. C:\WINDOWS\sysvol\sysvol\*yourdomain*\scripts 

' VBScript source code

Option Explicit
'
' ***********************************************
' ***********************************************
' **                                           **
' **  Company Name Logon Script                **
' **                                           **
' **                                           **
' ***********************************************
' ***********************************************
'
'

' *** Declare Constants ***
Const ForReading = 1, ForWriting = 2, ForAppending = 8

' *** Declare Global Objects ***
Dim oWshShell, oFS, oWshNetwork, oIE, oLog
Dim oADSysInfo, oADSUser, oWshUserEnv

' *** Declare Global Variables ***
Dim UserProfile, AllUsersProfile, Temp, OS, GivenName, LastName, UserName, ComputerName, RegKey, Profile
Dim sHTML, sLogColor, ScriptDir, LocalOffice, HomeOffice, HomeServer, bExitError, OfficeFloor
on error resume next

InitVariables()
InitUI()
WriteLogEntry "Home Office: " & HomeOffice : WScript.Sleep 500
MapNetworkDrives()
ConnectNetworkPrinters()
SetDefaultPrinter()

If bExitError Then
	WriteLogEntry "!WARNING: The logon script has completed With errors. Please see the log entries below for details."
	Else
		WriteLogEntry "?Logon complete."
		WScript.Sleep 5000
	If IsObject(oIE) Then oIE.Quit
End If

WScript.Quit

'---> Map Network Drives for User
'==============================================================

Sub MapNetworkDrives()
	'----> Auckland Drive Mappings
	If HomeOffice = "Auckland" OR HomeOffice = "Tauranga" Then
		' Common Drive Mappings for all AKL Users
		MapDrive "P:", "\\FileServer\PUBLIC", False
		MapDrive "Q:", "\\FileServer\ddnzclient", False
		
		If InGroup("@AP.NZ.Sales staff.AKL") Then
			' Drive Mapping for AKL Sales Group
			MapDrive "F:", "\\FileServer\AKLSALES", False
		End If
		
		If InGroup("@AP.NZ.Consultant Staff.AKL") Then
			' Drive Mapping for AKL Consultant Group
			MapDrive "F:", "\\FileServer\AKLCONSULT", False
		End If
		
		If InGroup("@AP.NZ.Support Staff.AKL") Then
			' Drive Mapping for AKL Support Staff Group
			MapDrive "F:", "\\FileServer\AKLSUPPORT", False
		End If
		
		If InGroup("@AP.NZ.Administration Staff.AKL") Then
			' Drive Mapping for AKL Admin Group
			MapDrive "F:", "\\FileServer\AKLADMIN", False
			MapDrive "K:", "\\FileServer\WLGADMIN", False
		End If
		
		If InGroup("@AP.NZ.NCS Staff.AKL") Then
			' Drive Mappings for NCSAKL Group
			MapDrive "Z:", "\\FileServer\NCSAPPS", False
			MapDrive "U:", "\\FileServer\NCSUSERS", False
		Else
			MapDrive "G:", "\\FileServer\AKLCLIENT", False
			MapDrive "U:", "\\FileServer\" & USERNAME & "$", False
		End If

        '----> Wellington Drive Mappings
	ElseIf HomeOffice = "Wellington" Then
		' Common Drive Mappings for all WLG Users
		MapDrive "P:", "\\NZ-WLG-FP01\PUBLIC", False
		MapDrive "T:", "\\NZ-WLG-FP01\WLGARCHIVE", False
		MapDrive "U:", "\\NZ-WLG-FP01\" & USERNAME & "$", False
		MapDrive "Q:", "\\FileServer\ddnzclient", False
		
		If InGroup("@AP.NZ.People&Culture") Then
			'Common drive Mappings for WLG People and Culture
			MapDrive "L:", "\\FileServer\People&Culture", False
		End if

		If InGroup("@AP.NZ.Support Staff.WLG") Then
			'Common drive Mappings for WLG Managed Services Staff
			MapDrive "F:", "\\FileServer\WLGSUPPORT$", False
			MapDrive "J:", "\\NZ-WLG-FP01\WLGSUPPLIER", False
			MapDrive "K:", "\\FileServer\STARTRAC", False
		End If
		
		If InGroup("@AP.NZ.Contracts") Then
			'Common drive Mappings for Contract Management Staff
			MapDrive "V:", "\\FileServer\Contracts$", False
		End If

		If InGroup("@AP.NZ.Consultant Staff.WLG") Then
			'Common drive Mappings for WLG Professional Services Staff
			MapDrive "F:", "\\FileServer\WLGCONSULT", False
		End If

		If InGroup("@AP.NZ.Sales staff.WLG") Then
			'Common drive Mappings for WLG Professional Services Staff
			MapDrive "F:", "\\FileServer\WLGSALES", False
		End If

		If InGroup("@AP.NZ.Administration Staff.WLG") Then
			'Common drive Mappings for WLG Administration Staff
			MapDrive "F:", "\\FileServer\WLGADMIN", False	
		End If

		If InGroup("@AP.GSC Staff") OR InGroup("@AP.NZ.Support Staff.WLG") OR InGroup("@AP.NZ.Consultant Staff.WLG") OR InGroup("DCNZ-Sales Staff@WLG") OR InGroup("@AP.NZ.Administraton Staff.WLG") Then
			MapDrive "G:", "\\FileServer\WLGCLIENT", False
			MapDrive "I:", "\\FileServer\DCNZ-DATA", False
		End If		
	
	        '----> NCSFinance Staff and NCS@WLG Staff at end intentionally
		If InGroup("@AP.NZ.NCS Staff.WLG") Then
			' Drive Mapping for NCS Database Access
			MapDrive "H:", "\\FileServer\NCSSBT", False
		End If
		
		If InGroup("@AP.NZ.NCS Finance.WLG") Then
			MapDrive "F:", "\\FileServer\WLGNCS", False
			MapDrive "G:", "\\FileServer\WLGADMIN", False
			MapDrive "H:", "\\FileServer\NCSSBT", False
			MapDrive "J:", "\\FileServer\Datacraft-CHC", False
			MapDrive "O:", "\\FileServer\WLGCLIENT", False
		End If

		'---> GSC-NZ Staff at end of this section intentionally; 
		If InGroup ("@AP.GSC Staff") Then
			'Drive Mappings for GSC-NZ Group
			MapDrive "F:", "\\FileServer\STARTRAC", False
			MapDrive "J:", "\\NZ-WLG-FP01\WLGSUPPLIER", False
		End If

		Else
		WriteLogEntry "!Warning: You fit none of the criteria for mapping drives - please notify the helpdeskfor assistance."
	End If
	

End Sub


'---> Connect Network Printers
'==============================================================

Sub ConnectNetworkPrinters()
	On Error Resume Next
	WriteLogEntry "Checking network printers"
	Dim PrintersToConnect, CurrentPrinters, colPrinters, i, aPrinters
	PrintersToConnect = 			"\\NZ-WLG-FP01\HP LaserJet 5000 Series PCL" & "," &_
						"\\NZ-WLG-FP01\NZW-LUM-L3General" & "," &_
						"\\FileServer\NZ-AKL-GFSouth" & "," &_
						"\\ax-hlz-core\NZH-DDH-L2General" & "," &_
						"\\ax-chc-core\NZC-DDH-GFGeneral" 
	Set colPrinters = oWshNetwork.EnumPrinterConnections
	For i = 0 to colPrinters.Count - 1 Step 2
		' WScript.Echo "Port " & colPrinters.Item(i) & " = " & colPrinters.Item(i+1)
		CurrentPrinters = CurrentPrinters & "," & colPrinters.Item(i+1)
	Next
		aPrinters = Split(PrintersToConnect, ",")
	For i = 0 To UBound(aPrinters)
		If InStr(CurrentPrinters, aPrinters(i)) = 0 Then
			WriteLogEntry "Adding printer: " & aPrinters(i)
			oWshNetwork.AddWindowsPrinterConnection aPrinters(i)
		End If
	Next
End Sub


'---> Set the Default Printer for User
'==============================================================

Sub SetDefaultPrinter

	Dim strComputer, objWMIService, colInstalledPrinters, objPrinter, strDefaultPrinter
	strComputer = "."

	Set objWMIService = GetObject("winmgmts:" _
	& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
	Set colInstalledPrinters = objWMIService.ExecQuery _
		("Select * from Win32_Printer")
	
	For Each objPrinter in colInstalledPrinters
	If objPrinter.Default = True then
		strDefaultPrinter = objPrinter.Name
	End If

	Next
	If Left(strDefaultPrinter,4) <> "\\NZ" then
		OfficeFloor = oADSUser.OfficeLocations
		If StrComp(OfficeFloor, "L7 Auckland", 1) = 0 then
			oWshNetwork.SetDefaultPrinter "\\FileServer\NZ-AKL-GFSouth"
		ElseIf StrComp(OfficeFloor, "L3 Wellington", 1) = 0 then  
			oWshNetwork.SetDefaultPrinter "\\NZ-WLG-FP01\NZW-LUM-L3General"
		ElseIf StrComp(OfficeFloor, "L1 Wellington", 1) = 0 then  
			oWshNetwork.SetDefaultPrinter "\\NZ-WLG-FP01\NZW-LUM-L1General"
			ElseIf StrComp(OfficeFloor, "L1 Datacraft House", 1) = 0 then  
			oWshNetwork.SetDefaultPrinter "\\NZ-WLG-FP01\NZW-DDH-L1General"
		End If	
	End If
End Sub




'---> Initialisation User Interface
'==============================================================

Sub InitUI()
	On Error Resume Next
	Dim oWelcomeMessage, sWelcomeMessage
	Dim sWidth, sHeight, sTitle
	sTitle = "Network Logon. Please wait..."
	oIE.Navigate "About:Blank"
	oIE.ToolBar = False
	oIE.StatusBar = False
	oIE.Resizable = False

	Do
	Loop While oIE.Busy

	oIE.Width = 500
	oIE.Height = 300
	With oIE.Document.parentWindow.screen
		oIE.Left = (.availWidth-oIE.Width)/2
		oIE.Top = (.availHeight-oIE.Height)/2
	End With

	oIE.Visible = True
	oWshShell.AppActivate("about:blank - Microsoft Internet Explorer")
	oIE.Document.WriteLn "<html><head>"
	oIE.Document.WriteLn "<title>Network Logon</title>"
	
	oIE.Document.WriteLn "<style>"
	oIE.Document.WriteLn "TABLE     {font-family: arial; font-size: 8pt; background-color: aliceblue; color: #3360A5}"
	oIE.Document.WriteLn "BODY     {font-family: arial; font-size: 10pt; }"
	
	oIE.Document.WriteLn "</style>"
	
	oIE.Document.WriteLn "</head><body>"

	oIE.Document.WriteLn "<div id=""tagTitleBar"" style=""background-color: #4AE00C; position: absolute; width: 100%; height: 40px; left: 5px; padding: 15px "">"
	oIE.Document.WriteLn "<img src=""" & ScriptDir & "\Company\hd-logo-link.png"""
	oIE.Document.WriteLn "</div>"

	oIE.Document.WriteLn "<div id=""tagWelcome"" style=""position: absolute; top: 60px; width: 100%; height: 60px; left: 5px; background-color: #eeeeee; padding: 4px; "" >"
	oIE.Document.WriteLn "</div>"

	oIE.Document.WriteLn "<div id=""tagLog"" style=""position: absolute; top: 120px; width: 100%; left: 5px; "">"
	oIE.Document.WriteLn "</div>"
	oIE.Document.WriteLn "</body></html>"

	oIE.Document.WriteLn "<div id=""tagTitleText"" style=""position: absolute; top: 15px; right: 15px; color: white; "">"
	oIE.Document.Write Now()
	oIE.Document.WriteLn "</div>"
	
	Set oWelcomeMessage = oIE.Document.All("tagWelcome")
	Set oLog = oIE.Document.All("tagLog")
		oLog.InnerHTML = "This is a test"
		
	If Hour(Now) < 12 Then
		sWelcomeMessage =  "<B>Good morning " & GivenName & "."
		ElseIf Hour(Now) < 18 Then
		sWelcomeMessage =  "<B>Good afternoon " & GivenName & "."
		Else
		sWelcomeMessage =  "<B>Good evening " & GivenName & "."
	End If
	sWelcomeMessage = sWelcomeMessage & " Welcome to the network. Please wait while you are logged on."
	If IsObject(oWelcomeMessage) Then oWelcomeMessage.InnerHTML = sWelcomeMessage
	
End Sub




'---> Write Out Log Entries
'==============================================================

Sub WriteLogEntry(ByVal sData)
	On Error Resume Next
	If Not IsObject(oLog) Then Exit Sub
	Dim sTemp : sTemp = ""
	Dim sImg, sStyle, sLogHeader
	sLogHeader = "<table width='100%' cellpadding='2'>"
	
	sStyle = ""
	If sLogColor = "white" Then
			sLogColor = "aliceblue"
		Else
			sLogColor = "white"
	End If

	Select Case Left(sData, 1)
		Case "!"
			sStyle = "color: #cc2244"
			bExitError = True
		Case "?"
			sStyle = "font-weight: bold"
	 	Case Else
	 		sStyle = ""
	End Select
	If Not sStyle = "" Then sData = Mid(sData, 2)
	sTemp = sTemp & "<TR width=""100%"" bgcolor='" & sLogColor & "'>"
	sTemp = sTemp & "<TD width=""70px"">&nbsp " & Time & "</TD>"
	sTemp = sTemp & "<TD style=""" & sStyle & """>" & sData & "</TD>"
	sTemp = sTemp & "</TR>" & VbCrLf
	sHTML = sTemp & sHTML
	oLog.InnerHTML = sLogHeader & sHTML & "</table>"
End Sub




'---> Initialise Variables
'==============================================================

Sub InitVariables()
	On Error Resume Next
	Set oFS = CreateObject("Scripting.FileSystemObject")
	Set oWshShell = WScript.CreateObject("WScript.Shell")
	Set oWshNetwork = WScript.CreateObject("WScript.Network")
	Set oIE = CreateObject("InternetExplorer.Application")
	Set oADSysInfo = CreateObject("ADSystemInfo")
	Set oADSUser = GetObject("LDAP://" & oADSysInfo.UserName)
	GetOffice
	OS = OSVer

	ScriptDir = oFS.GetParentFolderName(WScript.ScriptFullName)
	If  IsObject(oADSUser) Then GivenName = oADSUser.GivenName
	If  IsObject(oADSUser) Then LastName = oADSUser.LastName
	
	UserName = Lcase(oWshNetwork.UserName)
	Set oWshUserEnv = oWshShell.Environment("USER")
	SystemDrive = oWshShell.ExpandEnvironmentStrings("%SystemDrive%")
	SystemRoot = oWshShell.ExpandEnvironmentStrings("%WINDIR%")
	Temp = oWshShell.ExpandEnvironmentStrings("%TEMP%")
	ComputerName = LCase(oWshNetwork.ComputerName)
	UserProfile = oWshShell.ExpandEnvironmentStrings("%UserProfile%")
	AllUsersProfile = oWshShell.ExpandEnvironmentStrings("%AllUsersProfile%")
	sLogColor = "white"
	bExitError = False
End Sub




'---> Get Home Office Location
'==============================================================

Sub GetOffice()
	On Error Resume Next
	LocalOffice = oADSysInfo.SiteName
	If Instr(oADSysInfo.UserName, "OU=Wellington") Then
		HomeServer = "NZ-WLG-FP01"
		HomeOffice = "Wellington"
	ElseIf Instr(oADSysInfo.UserName, "OU=Auckland") Then
		HomeServer = "nz-akl-fp01"
		HomeOffice = "Auckland"
	ElseIf Instr(oADSysInfo.UserName, "OU=Tauranga") Then
		HomeServer = "nz-akl-fp01"
		HomeOffice = "Tauranga"
	Else
		HomeServer = ""
		HomeOffice = ""
	End If
End Sub


'---> FUNCTIONS
'==============================================================

Function OSVer()
     On Error Resume Next
     Set OSChk = CreateObject("os.version")
     OSVer = OSChk.WinKind
End Function


Function InGroup(GroupName)
	On Error Resume Next
	Dim oGroup
	InGroup = False
	If Not IsObject(oADSUser) Then
		WriteLogEntry "!Warning: unable to determine your group membership. Network drives may not be mapped correctly."
		Exit Function
	End If

	For each oGroup in oADSUser.Groups
		If LCase(Mid(oGroup.Name,4)) = LCase(GroupName) Then InGroup = True
	Next
End Function

Function RegValueExists(Val)
	On Error Resume Next
	RegValueExists = True
	oWshShell.RegRead Val
	If Not Err.Number = 0 Then
		RegValueExists = False
		Err.Clear
	End If
End Function

Function RegKeyExists(Val)
 	On Error Resume Next
	RegKeyExists = True
 	If Not Right(Val, 1) = "\" Then	Val = Val & "\"
 	oWshShell.RegRead Val
 	If Not Instr(Err.Description, "Invalid root in registry key") <> 0 Then
 	 	Err.Clear()
 	End If
	If Not Err.Number = 0 Then
		RegKeyExists = False
		Err.Clear
	End If
End Function

Function RegWriteX(sKey, Data, sType)
	On Error Resume Next
	RegWriteX = True
	oWshShell.RegWrite sKey, Data, sType
	If Not Err.Number = 0 Then
		RegWriteX = False
		Err.Clear
	End If
End Function

Function ProcessExists(sProcess)
	On Error Resume Next
	Dim objWMIService, objProcess, colProcessList
	ProcessExists = False
	Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
	Set colProcessList = objWMIService.ExecQuery("Select * from Win32_Process")
	For Each objProcess in colProcessList
	    If objProcess.Name = sProcess Then
		ProcessExists = True
		Exit Function
	End If
	Next
End Function

Function MapDrive (sDrive, sRemotePath, bPermMode)
	Dim d
	On Error Resume Next
	WriteLogEntry "Connecting network drive " & sDrive
	'Check if the drive is already used
	If oFS.DriveExists(sDrive) Then
		Set d = oFS.GetDrive(sDrive)
		If LCase(d.ShareName) = LCase(sRemotePath) Then
			WriteLogEntry "Drive " & sDrive & " already correctly mapped."
			MapDrive = True
			Exit Function
		Else
			'Mapped incorrectly. Unmap it.
			If d.DriveType = 3 Then
				' It's a network drive
				oWshNetwork.RemoveNetworkDrive sDrive, True, True
			Else
				' This drive letter has been assigned to a non-network resource
				WriteLogEntry "!ERROR: Drive " & sDrive & " is already in use and cannot be remapped to a network location."
				MapDrive = False
				Exit Function
			End If
		End If
	End If
	oWshNetwork.MapNetworkDrive sDrive, sRemotePath, bPermMode
	If Err.Number <> 0 Then
		WriteLogEntry "!ERROR: ' " & sDrive & " failed to map to " & sRemotePath
		MapDrive=FALSE
	Else
		MapDrive=True
		'WriteLogEntry "Drive " & sDrive & " Mapped OK"
	End If
End Function
Retrieved from ‘http://tech-wiki.net/index.php?title=Login_script_using_VBScript&oldid=511’