'==========================================================================
' NAME: LogonScript.vbs
'
' AUTHOR: Mark D. MacLachlan, The Spider's Parlor
'Maps Drives and Printers based on UserName or Group
'some changes - additions by Grant Dewrance
' URL : [URL unfurl="true"]http://www.thespidersparlor.com[/URL]
' DATE : 4/10/2003
'
' COMMENT: Enumerates current users' group memberships in given domain.
' Maps and disconnects drives and printers
'==========================================================================
'START OF THE SCRIPT
Dim WshShell, WshNetwork, objDomain, DomainString, UserString, UserObj, Path, strKey
Dim strFullname, WshSysEnv, LServer, Username, SWidth, SHeight, strBitmap, SysDrive
Dim objFSO, tempiepath, bYesClick, bNoClick, bUserClose, bOKClick
Dim objLogFile, objNetwork, objShell, strText, intAns
Dim intConstants, intTimeout, strTitle, intCount, blnLog
Dim strUserName, strComputerName, strIP, strShare, strLogFile
Set WshNetwork = CreateObject("WScript.Network")
Set WshShell = WScript.CreateObject("WScript.Shell")
Set WshSysEnv = WshShell.Environment("Process")
Set objFSO = CreateObject("Scripting.FileSystemObject")
SysDrive = WshShell.ExpandEnvironmentStrings("%SYSTEMDRIVE%")
SysRoot = WshShell.ExpandEnvironmentStrings ("%SystemRoot%")
UserProfile = WshShell.ExpandEnvironmentStrings ("%UserProfile%")
'RunLogonScriptOnceADay
'==========================================================================
Dim varToday, Verify, LastRunDate
Set WshShell = CreateObject("Wscript.Shell")
varToday = Weekday(Date)
Verify = "HKLM\SOFTWARE\MyInstallsAndFixes\"
'Check if scan has run today and if so exit
On Error Resume Next
LastRunDate = WshShell.RegRead(Verify & "LogonOnce")
If LastRunDate = cstr(Date) Then
WScript.Quit
Else
WshShell.RegWrite Verify & "LogonOnce",Date,"REG_SZ"
End If
'=====================================================================================================
'Automatically find the domain name
Set objDomain = getObject("LDAP://rootDse")
DomainString = objDomain.Get("dnsHostName")
'Grab the user name
UserString = WshNetwork.UserName
Set objADSysInfo = CreateObject("ADSystemInfo")
Set objCurrentUser = GetObject("LDAP://" & objADSysInfo.UserName)
'Bind to the user object to get user name and check for group memberships later
Set UserObj = GetObject("WinNT://" & DomainString & "/" & UserString)
'Grab the user name
UserString = WshNetwork.UserName
strUser = objADSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
strName = objUser.FullName
strFName = objUser.FirstName
'Grab the computer name for use in add-on code later
strComputer = WshNetwork.ComputerName
'************************************************************************************************************************************************
'Check if this is a Server. If this is a server quit
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem",,48)
For Each objItem in colItems
If InStr(1,objItem.Caption,"Server") Then Wscript.Quit
If InStr(1,objItem.Caption, "Server 2003") Then Wscript.Quit
'If InStr(1,objItem.Caption,"Vista") Then Wscript.Quit
Next
'===========================================================================================================
'Do not run this script on the following machines or servers
strComputer = WshNetwork.ComputerName
arrComputers = Array("name","server","dbngtjhb","server","server","server")
For Each arrayElement in arrComputers
If arrayElement = strComputer Then
wscript.Quit
End If
Next
'===========================================================================================================
'THIS CEATES THE INTERNET EXPLORER WINDOW AND ALLOWS YOU TO ADD COMMENTS WHILE THE SCRIPT RUNS
'strComputer = "."
Set objWMIService = GetObject("Winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * From Win32_DesktopMonitor")
For Each objItem in colItems
intHorizontal = objItem.ScreenWidth
intVertical = objItem.ScreenHeight
Next
'************************************************************************************************************************************************
Const READYSTATE_COMPLETE = 4
strBitmap = "\\server\share$$\GENERAL\GT_ScreenSaver_2.1\GTLogonew.gif"
LServer = WshSysEnv("LogonServer")
Username = WshNetwork.Username
strFullname = UCase(objCurrentUser.DisplayName)
Set objExplorer = CreateObject _
("InternetExplorer.Application")
objExplorer.Navigate "about:blank"
objExplorer.ToolBar = 0
objExplorer.StatusBar = 0
objExplorer.Fullscreen = 1
'objExplorer.Scrollbar = 0
objExplorer.Left = 0
objExplorer.Top = 0
'objExplorer.Width = 650
'objExplorer.Height = 470
objExplorer.Visible = 1
objExplorer.Document.Body.Style.Cursor = "wait"
Set objDocument = objExplorer.Document
objDocument.Open
objDocument.Writeln "<HEAD></HEAD><TITLE>Logon Script Progress</TITLE>"
objDocument.Writeln "<Body BGColor=#502D7F SCROLL=NO>"
objDocument.Writeln "</BODY>"
objExplorer.Document.Body.InnerHTML = "<div align= center><FONT COLOR= #FFFFFF ><h3>Welcome to Company Name</h3></font></div></div> " &_
"<br>" &_
"<br>" &_
"<div align= center><font face=arial color=#FFFFFF>Your logon script is being processed.</div>"&_
"<div align= center><font face=arial color=#FFFFFF>This might take several minutes to complete.</Div>"&_
"<html><head><script language = JavaScript>function Init(){document.Buttons.cmdYes.focus()}</script>" &_
"<style type = ""text/css"">" &_
"body {font-family: Tahoma,Verdana,Arial; font-weight: normal; font-size: 8pt}" &_
"h1 {font-family:Tahoma,Verdana,Arial; font-weight: bold; font-size: 12pt; text-align: center}" &_
"h2 {font-family:Tahoma,Verdana,Arial; font-weight: bold; font-size: 10pt; text-align: center}" &_
"td {font-family:Tahoma,Verdana,Arial; font-weight: bold; font-size: 8pt; text-align: justify}" &_
"</style><title>ACCESS RESTRICTED TO AUTHORIZED USERS ONLY</title></head>" &_
"<br>" &_
"<br>" &_
"<CENTER><IMG SRC='file:///" & strBitmap & "'></TD></TR>"&_
"<body scroll=""no"" onLoad=""Init()""><h1>YOU ARE ENTERING A company name COMPUTER SYSTEM. </h1>" &_
"<h1>AUTHORIZED USERS ONLY!!!!</h1>" &_
"<p style=""line-height: 10%; text-align: center"">You were validated by server " & Mid(LServer,3) & " under USERNAME " & LCase(Username) & "</p>" &_
"<table border=""0"" width=""100%"" cellpadding=""10"" cellspacing=""3"" bgcolor=""red"">"
objDocument.Close
wscript.sleep 2500
'************************************************************************************************************************************************
'TURNS WINDOWS XP FIREWALL ON OR OFF
Set objFirewall = CreateObject("HNetCfg.FwMgr")
Set objPolicy = objFirewall.LocalPolicy.CurrentProfile
objPolicy.FirewallEnabled = FALSE
'===========================================================================================================
'Copy Fonts to Computers
objFSO.CopyFile "\\server\share$\Fonts\*.*", sysroot & "\Fonts\", overwrite = False
'Synchronizes the time with Server our NTP Server
WshShell.Run "NET TIME \\server /set /y", True
WshShell.Run "%windir%\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
WshShell.Run ("\\server\share$\ezscan.exe /auto")
'************************************************************************************************************************************************
'How to wright registry entries 'Write the regstry entries to HKCU and HKLM
'RegRead, RegWrite, and RegDelete
'WshShell.RegWrite("HKLM\SOFTWARE\Company\Key\Value", "Data", "REG_SZ")
'OR
'WshShell.RegDelete ("HKLM\SOFTWARE\Company\Key\Value")
'Data types are
'REG_SZ for strings
'REG_DWORD for numbers
'REG_BINARY for byte data
'REG_EXPAND_SZ for expandable strings
'REG_MULTI_SZ for string arrays
addText "Creating Registry Entries . . . ."
'-------------------------------------------------------------------------------------------------------------------------
'MICROSOFT WINDOWS MALICIOUS SOFTWARE REMOVAL TOOL (Runs on 2000 and XP and deployed via WSUS)
'This will run quite and full scan deleteing any viruses found
WshShell.RegDelete "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\Mrt"
WshShell.RegDelete "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\Adobe Reader Speed Launcher"
WshShell.RegDelete "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\SunJavaUpdateSched"
'This will prevent it from reporting to M$
WshShell.RegWrite "HKLM\SOFTWARE\Policies\Microsoft\MRT\DontReportInfectionInformation", "1", "REG_DWORD"
'-------------------------------------------------------------------------------------------------------------------------
' ADD "CONNECT TO" TO THE START MENU
WshShell.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Start_ShowNetConn", 2, "REG_DWORD"
'===========================================================================================================
'THIS WILL DISABLE THE XP TOUR
WshShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Applets\Tour\RunCount", 0, "REG_DWORD"
WshShell.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Applets\Tour\RunCount", 0, "REG_DWORD"
'===========================================================================================================
'THIS WILL ADD THE FOLLOWING REGISTRY VALUES TO CLIENT MACHINES
'ENABLE/DISABLE BALLOON TIPS
WshShell.Regwrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\EnableBalloonTips", 0, "REG_DWORD"
'===========================================================================================================
'THIS WILL FORCE THE LOGIN SCRIPT TO COMPLETE BEFORE WINDOWS LOADS
WshShell.Regwrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\RunLogonScriptSync", 1, "REG_DWORD"
'===========================================================================================================
'ENABLE or DISABLE PROXY
WshShell.Regwrite "HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyEnable", 1, "REG_DWORD"
'===========================================================================================================
'ENABLE PASSWORD PROTECT SCREEN SAVER AFTER 15MIN IF GPO FAILS AS XP USES STRING VALUE
WshShell.Regwrite "HKCU\Control Panel\Desktop\ScreenSaverIsSecure", 1, "REG_SZ"
'===========================================================================================================
'THIS WILL ENABLE YOU TO RECOVER ALL MS OUTLOOK FILES THAT GET DELETED RUNNING WITH EXCHANGE SERVER
WshShell.Regwrite "HKLM\Software\Microsoft\Exchange\Client\Options\DumpsterAlwaysOn", 1,"REG_DWORD"
'===========================================================================================================
'DELETE SGTAY.EXE FROM RUNNING ON DELL MACHINES
wshShell.RegDelete "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\UpdateManager"
'Delete Overlay
wshshell.RegDelete "HKCU\Control Panel\Desktop\PaintDesktopVersion"
'HIDE TIGHTVNC ICON
WshShell.RegWrite "HKLM\SOFTWARE\ORL\WinVNC3\DisableTrayIcon" ,1 , "REG_DWORD"
'Disable Language Bar
WshShell.RegWrite "HKCU\Software\Microsoft\CTF\Disable Thread Input Manager", 0, "REG_DWORD"
WshShell.RegWrite "HKCU\Software\Microsoft\CTF\LangBar\ExtraIconsOnMinimized", 1, "REG_DWORD"
WshShell.RegWrite "HKCU\Software\Microsoft\CTF\LangBar\ShowStatus", 3, "REG_DWORD"
WshShell.RegWrite "HKCU\Software\Microsoft\CTF\MSUTB\ShowDeskBand", 1, "REG_DWORD"
WshShell.Run "%windir%\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
'************************************************************************************************************************************************
'ENABLE NUMLOCK ON LOGIN
'WshShell.SendKeys "{NUMLOCK}"
'===========================================================================================================
'Change the value to one of the following numbers
'0 - All Keys off
'1 - Caps Lock On
'2 - Num Lock On
'4 - Scroll Lock On
'For multiple keys, add their values:
'3 - Caps Lock and Num Lock On
'5 - Caps Lock and Scroll Lock on'
'6 - Num Lock and Scroll Lock On
'7 - Caps Lock, Num Lock, and Scroll Lock On
'Log off and back on again for the changes to take place.
'KeysPath = "HKCU\ControlPanel\Keyboard\"
WSHShell.RegWrite path & "InitialKeyboardIndicators ","2","REG_SZ"
'************************************************************************************************************************************************
'ADDING THE NOTEPAD APPLICATION TO THE SENDTO MENU
Set WshShell = WScript.CreateObject("WScript.Shell")
strSendToFolder = WshShell.SpecialFolders("SendTo")
strPathToNotepad = WshShell.ExpandEnvironmentStrings _
("%SystemRoot%/system32/Notepad.exe")
Set objShortcut = WshShell.CreateShortcut(strSendToFolder & _
"\Notepad.lnk")
objShortcut.TargetPath = strPathToNotepad
objShortcut.Save
'************************************************************************************************************************************************
'THE FOLLOWING CODE WILL RUN IN INTERNET EXPLORER TO SHOW THAT DRIVE ARE BEING MAPPED
addText "Mapping Network Drives . . . ."
'===========================================================================================================
'Disconnect any drive mappings as needed.
WSHNetwork.RemoveNetworkDrive "V:", True, True
'Create Multipile "My Network Places" shortcuts
On Error Resume Next
Dim objShortcut
Dim strNetHood, strMyDocuments
Set WshShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objNetwork = CreateObject("WScript.Network")'
strNetHood = WshShell.SpecialFolders("Nethood")
strMyDocuments = WshShell.SpecialFolders("MyDocuments")
Dim sNethoodArray( 6, 1 )
sNethoodArray( 1, 0 ) = "share$"
sNethoodArray( 1, 1 ) = "\\server\share$"
sNethoodArray( 2, 0 ) = "Software Drive"
sNethoodArray( 2, 1 ) = "\\server\share$"
sNethoodArray( 3, 0 ) = "Audit Archive"
sNethoodArray( 3, 1 ) = "\\server\share"
sNethoodArray( 4, 0 ) = "Clerks Folders"
sNethoodArray( 4, 1 ) = "\\server\share$"
sNethoodArray( 5, 0 ) = "Profsoft"
sNethoodArray( 5, 1 ) = "\\server\share$"
sNethoodArray( 6, 0 ) = "Audit Data"
sNethoodArray( 6, 1 ) = "\\server\share"
Dim strDescription, strUNCPath, nIdx
For nIdx = 0 To UBound( sNethoodArray, 1 )
strDescription = sNethoodArray( nIdx, 0 )
strUNCPath = sNethoodArray( nIdx, 1 )
Set objShortcut = WshShell.CreateShortcut(strNetHood & "\" & strDescription & ".lnk")
objShortcut.TargetPath=strUNCPath
objShortcut.Description=strDescription
objShortcut.Save()
Next
'===========================================================================================================
''Disconnect ALL mapped drives
'Set clDrives = WshNetwork.EnumNetworkDrives
'For i = 0 to clDrives.Count -1 Step 2
' WSHNetwork.RemoveNetworkDrive clDrives.Item(i), True, True
'Next
'===========================================================================================================
'Disconnect mapeed drives to \\server1\share to \\serverNew\share Using the same drive letter
'Find All the Drives Mapped to a Share and Remap Them
'Set objNetwork = CreateObject("Wscript.Network")
'Set colDrives = objNetwork.EnumNetworkDrives
'For i = 0 to colDrives.Count-1 Step 2
' If colDrives.Item(i + 1) = "\\server1\share" Then
' strDriveLetter = colDrives.Item(i)
' objNetwork.RemoveNetworkDrive strDriveLetter
' objNetwork.MapNetworkDrive strDriveLetter, "\\server2\share"
' End If
'Next
'===========================================================================================================
'Create "My Network Places" shortcuts
On Error Resume Next
Dim WshShell, objShortcut, objFSO
Dim strNetHood, strMyDocuments
Set WshShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objNetwork = CreateObject("WScript.Network")
strNetHood = WshShell.SpecialFolders("Nethood")
strMyDocuments = WshShell.SpecialFolders("MyDocuments")
strDescription = "Pastel07"
strUNCPath = "\\machineName\Pastel07"
Set objShortcut = WshShell.CreateShortcut(strNetHood & "\" & strDescription & ".lnk")
objShortcut.TargetPath=strUNCPath
objShortcut.Description=strDescription
objShortcut.Save()
'===========================================================================================================
'MAP DRIVES NEEDED BY ALL
'NOTE THE FIRST COMMAND USES THE USER NAME AS A VARIABLE TO MAP TO A USER SHARE.
WSHNetwork.MapNetworkDrive "Z:", "\\server\share$$\Users\Grant" & UserString,True
WshNetwork.MapNetworkDrive "L:", "\\server\share$$",True
WshNetwork.MapNetworkDrive "T:", "\\server\share$",True
WshNetwork.MapNetworkDrive "O:", "\\server\share$",True
'Install Printers
'Removes network printers, leaves local printers and special printers
'************************************************************************************************************************************************
WshNetwork.AddWindowsPrinterConnection "\\server\printer"
WshNetwork.AddWindowsPrinterConnection "\\server\printer"
WshNetwork.AddWindowsPrinterConnection "\\server\printer"
WshNetwork.RemovePrinterConnection "\\server\printer", true, true
WshNetwork.RemovePrinterConnection "\\server\printer", true, true
WshNetwork.RemovePrinterConnection "\\server\xerox2", true, true
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")
strDsk = WshShell.SpecialFolders("Desktop")
strShortCut = strDsk & "\My User Folder.lnk"
objFSO.DeleteFile(strShortCut)
'Now check for group memberships and map appropriate drives
For Each GroupObj In UserObj.Groups
Select Case GroupObj.Name
'Check for group memberships and take needed action
'In this example below, ADMIN and Partners and Clerks are groups.
Case "Graoup"
WshNetwork.MapNetworkDrive "P:", "\\server\share$",True
WshNetwork.MapNetworkDrive "V:", "\\server\share$",True
WshNetwork.RemoveNetworkDrive "R:", True, True
wscript.sleep 500
WshNetwork.MapNetworkDrive "U:", "\\server\share",True
WshNetwork.MapNetworkDrive "K:", "\\server\share$",True
WshNetwork.MapNetworkDrive "M:", "\\server\share$",True
WshNetwork.MapNetworkDrive "S:", "\\server\share$",True
'Create the folder FIRST NAME
strFolderName = "\\server\share$" & "\" & strfName
Check that the strDirectory folder exists
If objFSO.FolderExists(strFolderName) Then
Set objFolder = objFSO.GetFolder(strFolderName)
Else
Set objFolder = objFSO.CreateFolder(strFolderName)
'WScript.Echo "Just created " & strDirectory
End If
'Map The Drive
WshNetwork.MapNetworkDrive "Z:", strFolderName ,True
'Rename the drive
zDrive = "Z:\"
Set WshShell = CreateObject("Shell.Application")
WshShell.NameSpace(zDrive).Self.Name = "My Folder"
mDrive = "M:\"
Set WshShell = CreateObject("Shell.Application")
WshShell.NameSpace(mDrive).Self.Name = "Folder"
WshNetwork.RemovePrinterConnection "\\server\Plan", true, true
WshNetwork.RemovePrinterConnection "\\server\Print", true, true
'The following will add vpn file to desktop
objFSO.CopyFile "\\server\share\VPN Client Setup CD\VPN.pbk", UserProfile & "\Desktop\", overwrite = True
Set WshShell = WScript.CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
strDsk = WshShell.SpecialFolders("Desktop")
' What is the label for the shortcut?
strshortcut = strDsk & "\My User Folder.lnk"
If Not objFSO.FileExists(strshortcut) Then
SET oUrlLink = WshShell.CreateShortcut(strshortcut)
' What is the path to the shared folder?
oUrlLink.TargetPath = strFolderName
oUrlLink.Save
End If
Case "Group"
WshNetwork.MapNetworkDrive "L:", "\\server\share$",True
WshNetwork.MapNetworkDrive "W:", "\\server\share$",True
Case "Group"
WshNetwork.MapNetworkDrive "P:", "\\server\share$",True
WshNetwork.MapNetworkDrive "V:", "\\server\share$",True
WshNetwork.MapNetworkDrive "U:", "\\server\share$",True
WshNetwork.MapNetworkDrive "K:", "\\server\share$",True
'Below is an example of how to set the default printer
WshNetwork.SetDefaultPrinter "\\server\printer"
objFSO.CopyFile "\\server\clerks\Windows 2000 SP2\VPN Client Setup CD\Company Name VPN.pbk", UserProfile & "\Desktop\", overwrite = True
'Create the folder FULL NAME
' strFolderName = "\\server\share$" & "\" & strName
' ' Check that the strDirectory folder exists
' If objFSO.FolderExists(strFolderName) Then
' Set objFolder = objFSO.GetFolder(strFolderName)
' Else
' Set objFolder = objFSO.CreateFolder(strFolderName)
'WScript.Echo "Just created " & strDirectory
' End If
'Map The Drive
WshNetwork.MapNetworkDrive "Z:", strFolderName ,True
'Rename the drive
zDrive = "Z:\"
Set WshShell = CreateObject("Shell.Application")
WshShell.NameSpace(zDrive).Self.Name = "My Folder"
Set WshShell = WScript.CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
strDsk = WshShell.SpecialFolders("Desktop")
' What is the label for the shortcut?
strshortcut = strDsk & "\My User Folder.lnk"
If Not objFSO.FileExists(strshortcut) Then
SET oUrlLink = WshShell.CreateShortcut(strshortcut)
' What is the path to the shared folder?
oUrlLink.TargetPath = strFolderName
oUrlLink.Save
End If
Case "Group"
WshNetwork.MapNetworkDrive "P:", "\\server\share$",True
WshNetwork.MapNetworkDrive "V:", "\\server\share$",True
WshNetwork.MapNetworkDrive "U:", "\\server\Audit",True
WshNetwork.MapNetworkDrive "K:", "\\server\share$",True
'Below is an example of how to set the default printer
WshNetwork.SetDefaultPrinter "\\server\printer"
objFSO.CopyFile "\\server\Name VPN.pbk", UserProfile & "\Desktop\", overwrite = True
'Create the folder FULL NAME
strFolderName = "\\server\share$" & "\" & strName
' Check that the strDirectory folder exists
If objFSO.FolderExists(strFolderName) Then
Set objFolder = objFSO.GetFolder(strFolderName)
Else
Set objFolder = objFSO.CreateFolder(strFolderName)
'WScript.Echo "Just created " & strDirectory
End If
'Map The Drive
WshNetwork.MapNetworkDrive "Z:", strFolderName ,True
'Rename the drive
zDrive = "Z:\"
Set WshShell = CreateObject("Shell.Application")
WshShell.NameSpace(zDrive).Self.Name = "My Folder"
Set WshShell = WScript.CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
strDsk = WshShell.SpecialFolders("Desktop")
' What is the label for the shortcut?
strshortcut = strDsk & "\My User Folder.lnk"
If Not objFSO.FileExists(strshortcut) Then
SET oUrlLink = WshShell.CreateShortcut(strshortcut)
' What is the path to the shared folder?
oUrlLink.TargetPath = strFolderName
oUrlLink.Save
End If
Case "Group"
WshNetwork.MapNetworkDrive "P:", "\\server\share$",True
WshNetwork.MapNetworkDrive "V:", "\\server\share$",True
WshNetwork.MapNetworkDrive "U:", "\\server\Audit",True
WshNetwork.MapNetworkDrive "M:", "\\user\Maximizer Data",True
WshNetwork.MapNetworkDrive "S:", "\\server\share$",True
'Create the folder FIRST NAME
strFolderName = "\\server\User Data$\Users" & "\" & strfname
' Check that the strDirectory folder exists
If objFSO.FolderExists(strFolderName) Then
Set objFolder = objFSO.GetFolder(strFolderName)
'wscript.echo "folder exists"
Else
Set objFolder = objFSO.CreateFolder(strFolderName)
'WScript.Echo "Just created " & strFolderName
End If
'Map The Drive
WshNetwork.MapNetworkDrive "Z:", strFolderName ,True
'Rename the drive
zDrive = "Z:\"
Set WshShell = CreateObject("Shell.Application")
WshShell.NameSpace(zDrive).Self.Name = "My Folder"
mDrive = "M:\"
Set WshShell = CreateObject("Shell.Application")
WshShell.NameSpace(mDrive).Self.Name = "Maximizer Data"
Set WshShell = WScript.CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
strDsk = WshShell.SpecialFolders("Desktop")
' What is the label for the shortcut?
strshortcut = strDsk & "\My User Folder.lnk"
If Not objFSO.FileExists(strshortcut) Then
SET oUrlLink = WshShell.CreateShortcut(strshortcut)
' What is the path to the shared folder?
oUrlLink.TargetPath = strFolderName
oUrlLink.Save
End If
Case "Accounting"
'Create the folder FIRST NAME
strFolderName = "\\server\User Data$\Users" & "\" & strfname
' Check that the strDirectory folder exists
If objFSO.FolderExists(strFolderName) Then
Set objFolder = objFSO.GetFolder(strFolderName)
'wscript.echo "folder exists"
Else
Set objFolder = objFSO.CreateFolder(strFolderName)
'WScript.Echo "Just created " & strFolderName
End If
'Map The Drive
WshNetwork.MapNetworkDrive "Z:", strFolderName ,True
'Rename the drive
zDrive = "Z:\"
Set WshShell = CreateObject("Shell.Application")
WshShell.NameSpace(zDrive).Self.Name = "My Folder"
WshNetwork.MapNetworkDrive "P:", "\\server\share$",True
WshNetwork.MapNetworkDrive "S:", "\\server\share$",True
WSHNetwork.MapNetworkDrive "U:", "\\server\Audit",True
Set WshShell = WScript.CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
strDsk = WshShell.SpecialFolders("Desktop")
' What is the label for the shortcut?
strshortcut = strDsk & "\My User Folder.lnk"
If Not objFSO.FileExists(strshortcut) Then
SET oUrlLink = WshShell.CreateShortcut(strshortcut)
' What is the path to the shared folder?
oUrlLink.TargetPath = strFolderName
oUrlLink.Save
End If
Case "Admin"
'Create the folder FIRST NAME
strFolderName = "\\server\User Data$\Users" & "\" & strfname
' Check that the strDirectory folder exists
If objFSO.FolderExists(strFolderName) Then
Set objFolder = objFSO.GetFolder(strFolderName)
'wscript.echo "folder exists"
Else
Set objFolder = objFSO.CreateFolder(strFolderName)
'WScript.Echo "Just created " & strFolderName
End If
'Map The Drive
WshNetwork.MapNetworkDrive "Z:", strFolderName ,True
'Rename the drive
zDrive = "Z:\"
Set WshShell = CreateObject("Shell.Application")
WshShell.NameSpace(zDrive).Self.Name = "My Folder"
WshNetwork.MapNetworkDrive "R:", "\\server\Ledger$",True
WshNetwork.MapNetworkDrive "S:", "\\server\share$",True
rDrive = "R:\"
Set WshShell = CreateObject("Shell.Application")
WshShell.NameSpace(rDrive).Self.Name = "KF-Ledger"
Set WshShell = WScript.CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
strDsk = WshShell.SpecialFolders("Desktop")
' What is the label for the shortcut?
strshortcut = strDsk & "\My User Folder.lnk"
If Not objFSO.FileExists(strshortcut) Then
SET oUrlLink = WshShell.CreateShortcut(strshortcut)
' What is the path to the shared folder?
oUrlLink.TargetPath = strFolderName
oUrlLink.Save
End If
'The following will add a shortcut to the desktop for all Users of the Estates Group
Case "Estates"
objFSO.CopyFile "\\server\ESTATES.EXE.lnk", UserProfile & "\Desktop\", overwrite = False
Case "National"
WshNetwork.MapNetworkDrive "N:", "\\server\Nat$",True
Case "WordPerfect"
WshNetwork.MapNetworkDrive "X:", "\\server\Applics$",True
xDrive = "X:\"
Set WshShell = CreateObject("Shell.Application")
WshShell.NameSpace(xDrive).Self.Name = "WordPerfect"
Case "Pastel"
WshNetwork.MapNetworkDrive "Q:", "\\server\Pastel05",True
WshNetwork.MapNetworkDrive "Y:", "\\server\Pastel07",True
WshNetwork.MapNetworkDrive "X:", "\\server\Pastel09",True
qDrive = "Q:\"
Set WshShell = CreateObject("Shell.Application")
WshShell.NameSpace(qDrive).Self.Name = "Pastel 2005"
yDrive = "Y:\"
Set WshShell = CreateObject("Shell.Application")
WshShell.NameSpace(yDrive).Self.Name = "Pastel 2007"
xDrive = "X:\"
Set WshShell = CreateObject("Shell.Application")
WshShell.NameSpace(yDrive).Self.Name = "Pastel 2009"
End Select
Next
'===========================================================================================================
'THE FOLLOWING CODE WILL RUN IN INTERNET EXPLORER TO SHOW THAT DRIVE ARE BEING MAPPED
addText "Mapping Printers . . . ."
'===========================================================================================================
'Run Code based on a User, That is map a drive a shortcut etc
'Since the login script already grabs the user name as UserString you can easily take action for a particular user like this:
'There are 2 versions below use any one you may need.
' In this example. The first one puts a shortcut to my G drive user folder
Select Case UserString
'The following will add a shortcut to the desktop for this Users only
Create Multipile " Desktop or Mydocuments shortcuts"
Dim objShortcut
Dim strShortCut, strMyDocuments
Set WshShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objNetwork = CreateObject("WScript.Network")
strShortCut = WshShell.SpecialFolders("Nethood")
strMyDocuments = WshShell.SpecialFolders("MyDocuments")
strDesktop = WshShell.SpecialFolders("Desktop")
strUser = objNetwork.UserName
Dim ShortCutArray( 1, 1 )
ShortCutArray( 0, 0 ) = "server C"
ShortCutArray( 0, 1 ) = "\\server\c$"
ShortCutArray( 1, 0 ) = "server1 D"
ShortCutArray( 1, 1 ) = "\\server1\d$"
Dim strDescription, strUNCPath, nIdx
For nIdx = 0 To UBound( ShortCutArray, 1 )
strDescription = ShortCutArray( nIdx, 0 )
strUNCPath = ShortCutArray( nIdx, 1 )
Set objShortcut = WshShell.CreateShortcut(strDesktop & "\" & strDescription & ".lnk")
objShortcut.TargetPath=strUNCPath
objShortcut.Description=strDescription
objShortcut.Save()
Next
Case "User"
WshNetwork.MapNetworkDrive "K:", "\\server\f$\user name",True
kDrive = "K:\"
Set WshShell = CreateObject("Shell.Application")
WshShell.NameSpace(kDrive).Self.Name = "My User Folder"
WshNetwork.MapNetworkDrive "J:", "\\server\Share",True
jDrive = "J:\"
Set WshShell = CreateObject("Shell.Application")
WshShell.NameSpace(jDrive).Self.Name = "Strategic"
WshNetwork.MapNetworkDrive "K:", "\\ip address\Archive",True
kDrive = "K:\"
Set WshShell = CreateObject("Shell.Application")
WshShell.NameSpace(kDrive).Self.Name = "Archive"
Case "user"
WSHNetwork.RemovePrinterConnection "\\server\HP 4100",True,True
WshNetwork.AddWindowsPrinterConnection "\\server\HP 4100"
End Select
'===========================================================================================================
'MAP WORDPERFECT 5.1 TO ZILLAH AND MIRALEE (I created a Group higher in the script for WordPerfect)
If UserString = "user" Then
Wshshell.run "%windir%\system32\hpbpro.exe -RegServer", True
WshNetwork.MapNetworkDrive "E:", "\\server\share$\Users\MAG",True
eDrive = "E:\"
Set WshShell = CreateObject("Shell.Application")
WshShell.NameSpace(eDrive).Self.Name = "Maggie"
End If
'===========================================================================================================
'Now rename the mapped drives to a meaningful name
Dim DriveArray( 9, 1 )
DriveArray( 0, 0 ) = "L:\"
DriveArray( 0, 1 ) = "User Data"
DriveArray( 1, 0 ) = "N:\"
DriveArray( 1, 1 ) = "National"
DriveArray( 2, 0 ) = "O:\"
DriveArray( 2, 1 ) = "Software"
DriveArray( 3, 0 ) = "P:\"
DriveArray( 3, 1 ) = "Audit Data"
DriveArray( 4, 0 ) = "S:\"
DriveArray( 4, 1 ) = "Solution6"
DriveArray( 5, 0 ) = "T:\"
DriveArray( 5, 1 ) = "Profsoft"
DriveArray( 6, 0 ) = "V:\"
DriveArray( 6, 1 ) = "share$"
DriveArray( 7, 0 ) = "W:\"
DriveArray( 7, 1 ) = "Financial Planning"
DriveArray( 8, 0 ) = "K:\"
DriveArray( 8, 1 ) = "User Folder"
DriveArray( 9, 0 ) = "U:\"
DriveArray( 9, 1 ) = "Audit Archive"
Set WshShell = CreateObject("Shell.Application")
For remap = 0 to UBound(DriveArray)
WshShell.NameSpace(DriveArray(remap,0)).Self.Name = DriveArray(remap,1)
Next
'************************************************************************************************************************************************
'Remove ALL old printers
'Enumerate all printers first, after that you can select the printers you want by performing some string checks
'Set WSHPrinters = WSHNetwork.EnumPrinterConnections
'For LOOP_COUNTER = 0 To WSHPrinters.Count - 1 Step 2
'To remove only networked printers use this If Statement
' If Left(WSHPrinters.Item(LOOP_COUNTER +1),2) = "\\" Then
' WSHNetwork.RemovePrinterConnection WSHPrinters.Item(LOOP_COUNTER +1),True,True
' End If
'To remove all printers incuding LOCAL printers use this statement and comment out the If Statement above
'WSHNetwork.RemovePrinterConnection WSHPrinters.Item(LOOP_COUNTER +1),True,True
'Next
'===========================================================================================================
'Remove a specific printer
'WSHNetwork.RemovePrinterConnection "\\ServerOld\HP5si",True,True
'************************************************************************************************************************************************
'Add On Code goes below this line
'************************************************************************************************************************************************
'Clear Temporary Internet Files on Exit Add On
' This code will empty the Temp Internet Files on Exit
'=====================================
Set WshShell = WScript.CreateObject("WScript.Shell")
tempiepath = "HKCU\Software\Microsoft\Windows\"
WshShell.RegWrite tempiepath & "ShellNoRoam\MUICache\@inetcplc.dll,-4750","Empty Temporary Internet Files folder when browser is closed","REG_SZ"
WshShell.RegWrite tempiepath & "CurrentVersion\Internet Settings\Cache\Persistent","0","REG_DWORD"
Set tempiepath = nothing
'===========================================================================================================
' Command Prompt Here
'===========================================================================================================
Dim cppath, cppath2
Set WshShell = WScript.CreateObject("WScript.Shell")
cppath = "HKCR\Directory\shell\DosHere\"
WshShell.RegWrite cppath,"Command &Prompt Here:","REG_SZ"
WshShell.RegWrite cppath & "command\", SysRoot & "\System32\cmd.exe /k cd "& Chr(34) & "%1" &Chr(34),"REG_SZ"
cppath2 = "HKCR\Drive\shell\DosHere"
WshShell.RegWrite cppath2,"Command &Prompt:","REG_SZ"
WshShell.RegWrite cppath2,"Command &Prompt Here","REG_SZ"
WshShell.RegWrite cppath2 & "command\",SysRoot & "\System32\cmd.exe /k cd "& Chr(34) & "%1" &Chr(34),"REG_SZ"
'**********************************************************************************************************************************************
'Rename My Computer Icon with Machine Name
Set WshShell = WScript.CreateObject("WScript.Shell")
MCPath = "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}"
WshShell.RegWrite MCPath & "\", strComputer, "REG_SZ"
WshNetwork.RemovePrinterConnection "\\server\printer", true, true
'************************************************************************************************************************************************
addText "Adding Menu Items . . . ."
'===========================================================================================================
' Copy To Folder
Dim ctpath
ctpath = "HKEY_CLASSES_ROOT\AllFilesystemObjects\shellex\ContextMenuHandlers\"
WshShell.RegWrite ctpath,"CopyTo"
WshShell.RegWrite ctpath & "\CopyTo\","{C2FBB630-2971-11D1-A18C-00C04FD75D13}"
'===========================================================================================================
' Move To Folder
Dim mtpath
mtpath = "HKEY_CLASSES_ROOT\AllFilesystemObjects\shellex\ContextMenuHandlers\"
WshShell.RegWrite mtpath,"MoveTo"
WshShell.RegWrite mtpath & "\MoveTo\","{C2FBB631-2971-11d1-A18C-00C04FD75D13}"
'************************************************************************************************************************************************
'Set the wallpaper
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_VideoController",,48)
Set WshShell = WScript.CreateObject("WScript.Shell")
Set WshSysEnv = WshShell.Environment("Process")
Set objFSO = CreateObject("Scripting.FileSystemObject")
sWinDir = objFSO.GetSpecialFolder(0) 'C:\Windows
WinPath = sWinDir & "\Wallpaper2008.bmp"
winpath1 = sWindir & "\WallpaperN.bmp"
If objFSO.FileExists(winpath) Then
objFSO.deletefile winpath
end if
If objFSO.FileExists(winpath1) Then
objFSO.deletefile winpath1
end if
If Not objFSO.FileExists(winpath) then
'If the file does not exist then copy it
For Each objItem in colItems
sourcePath = "\\server\share$\ScreenSaver_2.1\"
rightSize = "GT2008" & objItem.CurrentHorizontalResolution & "x" & objItem.CurrentVerticalResolution & ".bmp"
objFSO.CopyFile sourcePath & rightSize, sWinDir & "\Wallpaper2008.bmp", overwrite = True
Exit for
Next
End If
'************************************************************************************************************************************************
'Set Wallpaper Bitmap to Default
sWallPaper = sWinDir & "\Wallpaper2008.bmp"
' update in registry
WshShell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", sWallPaper
WshShell.Regwrite "HKCU\Software\Microsoft\Internet Explorer\Desktop\General\Wallpaper", sWallPaper
WshShell.Regwrite "HKCU\Software\Microsoft\Internet Explorer\Desktop\General\BackupWallpaper", sWallPaper
' let the system know about the change
WshShell.Run "%windir%\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
'************************************************************************************************************************************************
addText "Setting the Wallpaper . . . ."
Sub addText(data)
html = html & "<h4><font face=arial color=#306EFF>" & data & "</h4>"
objExplorer.Document.Body.InnerHTML = html
End Sub
' Determine the appropriate greeting for the time of day.
'=======================================================
Dim HourNow, Greeting
HourNow = Hour(Now)
If HourNow >5 And HourNow <12 Then
Greeting = "Good Morning "
Elseif HourNow =>12 And HourNow <16 Then
Greeting = "Good Afternoon "
Else
Greeting = "Good Evening "
End If
Function GetCurrentDate
'FormatDateTime formats Date in long date
GetCurrentDate = FormatDateTime(Date, 1)
End Function
'THE FOLLOWING CODE WILL RUN IN INTERNET EXPLORER TO SHOW THAT THE SCRIPT IS COMPLETE
'===========================================================================================================
'To remove the Disclamiar Delete from Line
'"<table border=""0"" width=""100%"" cellpadding=""10"" cellspacing=""3"" bgcolor=""red"">" &_
'to
'End Sub just before line objExplorer.Document.Body.Style.Cursor = "default"
objExplorer.Document.Body.InnerHTML = "<br>" &_
"<TD valign=top><center><font face=arial color=white><b><h1>Welcome " & strFullname & "</b><br>" &_
"<div align= center><FONT COLOR=#FFFFFF ><b><h3> to </b><br>" &_
"<div align= center><FONT COLOR=#FFFFFF ><H1>Company Name </b><br>" &_
"<br>"&_
"<TD valign=top><center><font face=arial color=white><b><h2>" & Greeting & "</b><br>" &_
"<TD valign=top><center><font face=arial color=white><b><h2>" & GetCurrentDate & space(2) & "[" & Time & "]" & "</b><br>" &_
"<div align= center><FONT COLOR=#FFFFFF ><h2>Logon complete. </Div></h2>"
'===========================================================================================================
Wscript.Sleep 5000
objExplorer.Quit
'===========================================================================================================
'Clean Up Memory We Used
set UserObj = Nothing
set GroupObj = Nothing
set DomainString = Nothing
Set WSHPrinters = Nothing
Set objFSO = Nothing
Set WshShell = Nothing
Set WshSysEnv = Nothing
Set WshNetwork = Nothing
'Quit the Script
wscript.quit