HTA login script with vbs and disclaimer

dublin101 · Oct 19, 2007

hi guys....

i'm a bit stuck trying to work out how to do this.

what i need is a login script that has a popup with logo and asking the user to either "accept" or "deny"......if it is accept, the script would then jump to another .vbs script which would then map drives....

i've been told .hta is the way but i'm a bit stuck on the whole thing.

thanks

GrimR · Oct 19, 2007

I have a script that does somthing similiar based on Marks script, I will post a template on Monday, after South Africa beat England in the rugby world cup.

dublin101 · Oct 19, 2007

ok i'll wait for then..........i also hope S.A beat England.

markdmac · Oct 21, 2007

Why don't you just use the normal windows legal disclaimer?

This can be configured via Group Policy or through scripting.

The problem with doing just your yes/no is that it will only prevent the login script from running where the Windows legal discalimer will actually prevent access to the system.

Another alternative that I prefer when I want to display a legal notice but not actually create a need for an extra click is that like to modify the Windows Login screen.

Here is a sample of what I am talking about.

Code:

'==========================================================================
'
' NAME: SetLogonPrompt.vbs
'
' AUTHOR: Mark D. MacLachlan , The Spider's Parlor
' URL: [URL unfurl="true"]http://www.TheSpidersParlor.com[/URL]
' COPYRIGHT (c) 2005 All Rights Reserved
' DATE  : 4/25/2006
'
' COMMENT: 
'
'==========================================================================

On Error Resume Next
 
Dim Path
Set WSHShell = Wscript.CreateObject("WScript.Shell")
Path= "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\"
WSHShell.RegWrite path & "LogonPrompt","Stop! This system processes electronic mail classified as Private under the Electronics Communications and Privacy act of 1986.  Law enforcement officers please take note that special warrants may be required to access this system.","REG_SZ"
If err then
	msgbox "Error Encountered"
Else
	msgbox "Logon Prompt Setup Sucessful"
End if

Note that adding text as I have done above to the login box has a limit to the number of characters. My sample above is right near that limit.

For information on the normal Legal Disclaimer and scripting it, refer to this URL:

http://www.microsoft.com/technet/scriptcenter/resources/qanda/jan05/hey0117.mspx.

Now as for the suggestions you have received about using an HTA, that is a terrible idea. (and I love HTAs, it is just not suited for this need) Any Vista machines you have would choke on it. Vista requires that HTAs created on another machine be "unblocked" before they will work. There are other limitations as well not related to Vista because an HTA executes locally. A script launched via GPO can do so with elevated rights but you won't be able to do that with an HTA.

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

GrimR · Oct 21, 2007

Here is the template [you will just need to move the login buttons to the top, look for this section I agree Your Disclaimer Information goes ]

Code:

'==========================================================================
' NAME: LogonScript.vbs
'
' Origanil AUTHOR:  Mark D. MacLachlan, The Spider's Parlor
'Maps Drives and Printers based on UserName or Group
'Edited and improved by Grant Dewrance
'Improvements
'RunLogonScriptOnceADay Thanks to Mark D. MacLachlan for his help here)
'Enable or change state of Numlock, Caps Lock or Scroll Lock at Login Thanks to Mark D. MacLachlan for his help here)
'Check if this is a Server. If this is a server quit
'Do not run on the following machines or servers
'Creates an Internet Explorer Window and allows you to add comments while the script runs
'Turns XP Firewall ON or OFF
'Synchronizes the time with Server 
'Various Registry entries
'Add Notepad To SendTo Menu
'Rename mapped drives to a meaningful name (Thanks to ehvbs from [URL unfurl="true"]www.visualbasicscript.com[/URL] forums)
'Set the wallpaper (Thanks to Mark D. MacLachlan for his help here)
'Log date/time, user name, computer name, and IP address
'Clear Temporary Internet Files on Exit Add On
'Adds Nethood Shortcuts (Thanks to ehvbs from [URL unfurl="true"]www.visualbasicscript.com[/URL] forums)
'
' COMMENT: Enumerates current users' group memberships in given domain.
'          Maps and disconnects drives and printers
'
'==========================================================================
'START OF THE SCRIPT 
ON ERROR RESUME NEXT

'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
LastRunDate = WshShell.RegRead(Verify & "LogonOnce")
If LastRunDate =  cstr(Date) Then
      WScript.Quit
Else 
     WshShell.RegWrite Verify & "LogonOnce",Date,"REG_SZ"
End If
'==========================================================================
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

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%")
'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 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,"Vista") Then Wscript.Quit
Next
'===========================================================================================================
'Do not run this script on the following machines or servers
		strComputer = WshNetwork.ComputerName
		arrComputers = Array("server","server1","server2","server02","server04")
	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 = "\\server1\share$\logo_anim.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=#003399 SCROLL=NO>"	
	objDocument.Writeln "</BODY>"  
objExplorer.Document.Body.InnerHTML = "<div align= center><FONT COLOR=  #FFFFFF ><h3>Welcome to Your 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 Your 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 500
'************************************************************************************************************************************************	
'==========================================================================
'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 "\\server1\share$\*.*", sysroot & "\Fonts\", overwrite = False

'Synchronizes the time with Server our NTP Server
WshShell.Run "NET TIME \\server1 /set /y", True
WshShell.Run "%windir%\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
'************************************************************************************************************************************************

'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 . . . ."
'-------------------------------------------------------------------------------------------------------------------------
'	SET THE THOUSAND SEPERATOR TO A SPACE
'WshShell.Regwrite "HKCU\Control Panel\International\sMonThousandSep", " ","REG_SZ"

'WshShell.Regwrite "HKCU\Control Panel\International\sThousand", " ","REG_SZ"
'-------------------------------------------------------------------------------------------------------------------------
'	SET THE SHORT DATE FORMAT TO DD/MM/YYYY
'-------------------------------------------------------------------------------------------------------------------------
'WshShell.Regwrite  "HKCU\Control Panel\International\sShortDate", "dd/MM/yyyy", "REG_SZ"
'-------------------------------------------------------------------------------------------------------------------------
'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", "MRT.exe /q /F:Y", "REG_SZ"
WshShell.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\Mrt", "MRT.exe /q", "REG_SZ"
'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"
'HIDE TIGHTVNC ICON
WshShell.RegWrite "HKLM\SOFTWARE\ORL\WinVNC3\DisableTrayIcon" ,1 , "REG_DWORD"
'SET CASWARE TO AUTOCOMPRESS ON EXIT
'WshShell.Regwrite "HKCU\Software\Caseware International\Working Papers\2005.00\Settings\AutoCompress",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
'************************************************************************************************************************************************
'RUN A PROGRAM ON A USERS MACHINE.
WshShell.Run "\\server1\server$\copy.exe \\server1\server$\", 0, True
WshShell.Run "\\server1\server$\runme.bat",0, True
'===========================================================================================================
'Another way to run a program
'===========================================================================================================
'Set WshShell = CreateObject("WScript.Shell")
'Dstring = "net use " & "\\" & Server & "\c$" & " /DELETE"
'WshShell.Run(Dstring)
'************************************************************************************************************************************************
'===========================================================================================================
'ENABLE NUMLOCK ON LOGIN
'===========================================================================================================
'WshShell.SendKeys "{NUMLOCK}"
'===========================================================================================================
'OR A BETTER WAY CHANGEING THE STATE OF NUMLOCK CAPS LOCK OR SCROLL LOCK
'===========================================================================================================
'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 "L:", True, True
			WSHNetwork.RemoveNetworkDrive "T:", True, True
			WSHNetwork.RemoveNetworkDrive "O:", True, True
            WSHNetwork.RemoveNetworkDrive "P:", True, True


'===========================================================================================================
''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 = "\\pc\share$"
'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:", "\\server1\Share$" & UserString,True

			WshNetwork.MapNetworkDrive "L:", "\\server1\Share$",True
			WshNetwork.MapNetworkDrive "T:", "\\server1\Share$",True
			WshNetwork.MapNetworkDrive "O:", "\\server1\share$",True
			
'Install Printers
'Removes network printers, leaves local printers and special printers
'************************************************************************************************************************************************

			WshNetwork.AddWindowsPrinterConnection "\\server1\Printer33"
			WshNetwork.AddWindowsPrinterConnection "\\server1\Printer30"	
				WshNetwork.RemovePrinterConnection "\\server\Printer", true, true
				WshNetwork.RemovePrinterConnection "\\server\Printer2", true, true			

			
'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 "Group"
            WshNetwork.MapNetworkDrive "P:", "\\server1\Share$",True
			WshNetwork.MapNetworkDrive "V:", "\\server\Share$",True
		
			'WshNetwork.MapNetworkDrive "N:", "\\jhbgt03.gt.local\National$",True
			WshNetwork.MapNetworkDrive "S:", "\\server1\share$",True
			WshNetwork.AddWindowsPrinterConnection "\\server1\Printer"
			WshNetwork.AddWindowsPrinterConnection "\\server1\Printer"
			'The following will add a shortcut to the desktop for all Users of the Partners Group
			objFSO.CopyFile "\\server1\share\Your Company Name VPN.pbk", UserProfile & "\Desktop\", overwrite = False
	
'nDrive = "N:\"
'Set WshShell = CreateObject("Shell.Application")
'WshShell.NameSpace(nDrive).Self.Name = "Any Name"

		'The following will add a shortcut to the desktop for all Users of the Partners Group
			Set objFSO = CreateObject("Scripting.FileSystemObject")
				strDsk = WshShell.SpecialFolders("Desktop")
			' What is the label for the shortcut?
				strshortcut = strDsk & "\Any Name 2006.lnk"
			If Not objFSO.FileExists(strshortcut) Then
				SET oUrlLink = WshShell.CreateShortcut(strshortcut)
			' What is the path to the shared folder?
				oUrlLink.TargetPath = "\\server1\Share$"
				oUrlLink.Save
			End If
			
		Case "Group" 
            WshNetwork.MapNetworkDrive "P:", "\\server1\Share$",True
			WshNetwork.MapNetworkDrive "V:", "\\server\Share$",True
		
            'Below is an example of how to set the default printer
            WshNetwork.SetDefaultPrinter "\\server1\Printer33"
			objFSO.CopyFile "\\server1\share\Your Company Name VPN.pbk", UserProfile & "\Desktop\", overwrite = False
			
		Case "Group" 
            WshNetwork.MapNetworkDrive "P:", "\\server1\Share$",True
			WshNetwork.MapNetworkDrive "V:", "\\server\Share$",True
			
            'Below is an example of how to set the default printer
            WshNetwork.SetDefaultPrinter "\\server1\Printer33"
			objFSO.CopyFile "\\server1\share\Your Company Name VPN.pbk", UserProfile & "\Desktop\", overwrite = False

		Case "Group"
			WshNetwork.MapNetworkDrive "P:", "\\server1\Share$",True
			WshNetwork.MapNetworkDrive "V:", "\\server\Share$",True
			WshNetwork.MapNetworkDrive "U:", "\\server02\share$",True
 
            			
		Case "Group"
            WshNetwork.MapNetworkDrive "P:", "\\server1\Share$",True
			WshNetwork.MapNetworkDrive "S:", "\\server1\share$",True
			WSHNetwork.MapNetworkDrive "U:", "\\server02\share$",True
						
		Case "Group"
            WshNetwork.MapNetworkDrive "R:", "\\server1\share$",True
			WshNetwork.MapNetworkDrive "S:", "\\server1\share$",True
rDrive = "R:\"
			Set WshShell = CreateObject("Shell.Application")
			WshShell.NameSpace(rDrive).Self.Name = "Any Name"
            			
		Case "Group"
		WSHNetwork.MapNetworkDrive "K:", "\\server02\share$",True
		
		Case "Group"
			WshNetwork.AddWindowsPrinterConnection "\\server1\Printer"
			WshNetwork.AddWindowsPrinterConnection "\\server1\Printer"
		'Check for Local printer, if one exists do not map network printers. If the count is 0 then map network printers
			Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
			Set colPrinters = objWMIService.ExecQuery _
			    ("Select * From Win32_Printer Where Local = TRUE")

			If colPrinters.Count = 0 Then
			    Set WshNetwork = CreateObject("WScript.Network")
			    'Below is an example of how to set the default printer
				WshNetwork.SetDefaultPrinter "\\server1\Printer"
			End If
			WshNetwork.MapNetworkDrive "W:", "\\server1\share$",True
wDrive = "W:\"
			Set WshShell = CreateObject("Shell.Application")
			WshShell.NameSpace(wDrive).Self.Name = "Any Name"
	'The following will add a shortcut to the desktop for all Users of the Estates Group
		
	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

        Case "User"
			WshNetwork.MapNetworkDrive "P:", "\\server1\Share$",True
			WshNetwork.MapNetworkDrive "V:", "\\server\Share$",True
			WshNetwork.MapNetworkDrive "S:", "\\server1\share$",True


			WshNetwork.AddWindowsPrinterConnection "\\server\Printer"
			WshNetwork.AddWindowsPrinterConnection "\\server1\Printer33"
			WshNetwork.AddWindowsPrinterConnection "\\server1\Printer30"
			WshNetwork.SetDefaultPrinter "\\server1\Printer33"
			WshNetwork.AddWindowsPrinterConnection "\\server1\Printer"
			WshNetwork.AddWindowsPrinterConnection "\\server1\Printer"
			
		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 = "\\server1\Share$\"
			oUrlLink.Save
		End If
		
'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 NethoodArray( 10, 1 )
		NethoodArray( 0, 0 ) = "server1 C"
		NethoodArray( 0, 1 ) = "\\server1\c$"
		NethoodArray( 1, 0 ) = "server1 D"
		NethoodArray( 1, 1 ) = "\\server1\d$"
		NethoodArray( 2, 0 ) = "server1 F"
		NethoodArray( 2, 1 ) = "\\server1\f$"
		NethoodArray( 3, 0 ) = "server1 H"
		NethoodArray( 3, 1 ) = "\\server1\h$"
		NethoodArray( 4, 0 ) = "server1 I"
		NethoodArray( 4, 1 ) = "\\server1\I$"
		NethoodArray( 5, 0 ) = "server04 C"
		NethoodArray( 5, 1 ) = "\\server04\c$"
		NethoodArray( 6, 0 ) = "server04 D"
		NethoodArray( 6, 1 ) = "\\server04\d$"
	   	NethoodArray( 7, 0 ) = "Any Name"
		NethoodArray( 7, 1 ) = "\\server1\Share$"
		NethoodArray( 8, 0 ) = "Any Name" 
	    NethoodArray( 8, 1 ) = "\\server1\share$"
		NethoodArray( 9, 0 ) = "Any Name"
		NethoodArray( 9, 1 ) = "\\server\Share$"
		NethoodArray( 10, 0 ) = "Any Name" 
		NethoodArray( 10, 1 ) = "\\server02\share$"

		
    Dim strDescription, strUNCPath, nIdx
 For nIdx = 0 To UBound( NethoodArray, 1 )
     strDescription = NethoodArray( nIdx, 0 )
     strUNCPath     = NethoodArray( nIdx, 1 )
    Set objShortcut = WshShell.CreateShortcut(strNetHood & "\" & strDescription & ".lnk") 
	objShortcut.TargetPath=strUNCPath
	objShortcut.Description=strDescription 
	objShortcut.Save()
 Next
 
		Case "User1"
			WshNetwork.MapNetworkDrive "P:", "\\server1\Share$",True
			
		Case "User2"
			WshNetwork.MapNetworkDrive "P:", "\\server1\Share$",True
 
End Select
'===========================================================================================================
'MAP WORDPERFECT 5.1 (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:", "\\server1\Share$",True
	 
eDrive = "E:\"
		Set WshShell = CreateObject("Shell.Application")
		WshShell.NameSpace(eDrive).Self.Name = "Any Name"
End If
'===========================================================================================================
'Now rename the mapped drives to a meaningful name
'===========================================================================================================
     Dim DriveArray( 5, 1 )
   DriveArray( 0, 0 ) = "L:\"
   DriveArray( 0, 1 ) = "Any Name"
   DriveArray( 1, 0 ) = "M:\"
   DriveArray( 1, 1 ) = "Any Name"
   DriveArray( 2, 0 ) = "N:\"
   DriveArray( 2, 1 ) = "Any Name"
   DriveArray( 3, 0 ) = "O:\"
   DriveArray( 3, 1 ) = "Any Name"
   DriveArray( 4, 0 ) = "P:\"
   DriveArray( 4, 1 ) = "Any Name"
   DriveArray( 5, 0 ) = "S:\"
   DriveArray( 5, 1 ) = "Any Name"


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
'=====================================
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
'===========================================================================================================
'Configure the PC to show the Windows Version and Service Pack as an overlay to the desktop above the System Tray
'===========================================================================================================
HKEY_CURRENT_USER = &H80000001
strComputer = WshNetwork.Computername
Set objReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
strKeyPath = "Control Panel\Desktop"
objReg.CreateKey HKEY_CURRENT_USER, strKeyPath
ValueName = "PaintDesktopVersion"
dwValue = 1
objReg.SetDWORDValue HKEY_CURRENT_USER, strKeyPath, ValueName, dwValue
'************************************************************************************************************************************************
' Command Prompt Here
'===========================================================================================================
Dim cppath, cppath2

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"

'************************************************************************************************************************************************
'Create Desktop Shortcut for everyone

'Set objFSO = CreateObject("Scripting.FileSystemObject")
'			strDsk = WshShell.SpecialFolders("Desktop")
		' What is the label for the shortcut?
'			strshortcut = strDsk & "\My New Folder.lnk"
'		If Not objFSO.FileExists(strshortcut) Then
'			SET oUrlLink = WshShell.CreateShortcut(strshortcut)
		' What is the path to the shared folder?
'			oUrlLink.TargetPath = "\\server02\share$" & UserString
'			oUrlLink.Save
'		End If

'************************************************************************************************************************************************
'Rename My Computer Icon with Machine Name
MCPath = "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}"
WshShell.RegWrite MCPath & "\", strComputer, "REG_SZ"
'************************************************************************************************************************************************
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")
  WinPath = SysRoot & "\NameWallpaper.bmp"
  
 'The wallPaper should be saved on a share as Name600x800.bmp, and Name1024x768 etc
 
If Not objFSO.FileExists(winpath) then
'If the file does not exist then copy it
	For Each objItem in colItems 
	    sourcePath = "\\server1\Share$\"
	    rightSize = "Name" & objItem.CurrentHorizontalResolution & "x" & objItem.CurrentVerticalResolution & ".bmp"
	    objFSO.CopyFile sourcePath & rightSize, SysRoot & "\Wallpaper.bmp", overwrite = True
	Next
End If
'************************************************************************************************************************************************
'Set Wallpaper Bitmap to Default
Set WshShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")

sWinDir = objFSO.GetSpecialFolder(0)
sWallPaper = sWinDir & "\NameWallpaper.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 . . . ."
'************************************************************************************************************************************************
'Add On Code goes above this line

'End of Script IE window
Wscript.Sleep 1000

'===========================================================================================================
'objExplorer.Document.Body.InnerHTML = "<h4><font face=arial color=#306EFF>Deleting Temp files...</h4>"

'************************************************************************************************************************************************

'Test AREA
'=======================================================================================================
'DELETE ALL TEMP FILES FROM USERS COMPUTERS

objFSO.DeleteFile SysRoot & "\Temp\*.*"
objFSO.DeleteFolder SysRoot & "\Temp\*.*"
objFSO.DeleteFile SysDrive & "\Temp\*.*"
objFSO.DeleteFolder SysDrive & "\Temp\*.*"
objFSO.DeleteFile UserProfile & "\Local Settings\temp\*.*"
objFSO.DeleteFolder UserProfile & "\Local Settings\temp\*.*"
objFSO.DeleteFile UserProfile & "\Local Settings\History\*.*"
objFSO.DeleteFolder UserProfile & "\Local Settings\History\*.*" 
objFSO.DeleteFile UserProfile & "\Local Settings\Temporary Internet Files\*.*"
objFSO.DeleteFolder UserProfile & "\Local Settings\Temporary Internet Files\*.*"
objFSO.DeleteFile UserProfile & "\Local Settings\Temporary Internet Files\Content.IE5\*.*"
objFSO.DeleteFolder UserProfile & "\Local Settings\Temporary Internet Files\Content.IE5\*.*"
objFSO.DeleteFolder UserProfile & "\Local Settings\Temporary Internet Files"
objFSO.DeleteFile UserProfile & "\Cookies\*.txt"

Const DeleteReadOnly = True

objFSO.DeleteFile  UserProfile & "\temp\*.*" ,DeleteReadOnly 	
objFSO.DeleteFile  UserProfile & "\Local Settings\temp\*.*" ,DeleteReadOnly 
objFSO.DeleteFolder UserProfile & "\Local Settings\temp\*.*" ,DeleteReadOnly 
objFSO.DeleteFile UserProfile & "\Local Settings\History\*.*" ,DeleteReadOnly
objFSO.DeleteFolder UserProfile & "\Local Settings\History\*.*" ,DeleteReadOnly 
objFSO.DeleteFile UserProfile & "\Local Settings\Temporary Internet Files\*.*" ,DeleteReadOnly
objFSO.DeleteFolder UserProfile & "\Local Settings\Temporary Internet Files\*.*" ,DeleteReadOnly
objFSO.DeleteFile UserProfile & "\Local Settings\Temporary Internet Files\Content.IE5\*.*" ,DeleteReadOnly
objFSO.DeleteFolder UserProfile & "\Local Settings\Temporary Internet Files\Content.IE5\*.*" ,DeleteReadOnly
objFSO.DeleteFolder UserProfile & "\Local Settings\Temporary Internet Files",DeleteReadOnly

'**********************************************************************************************************************************************
objFSO.DeleteFile SysRoot & "\Temp\*.*", DeleteReadOnly
objFSO.DeleteFile SysDrive & "\Temp\*.*", DeleteReadOnly
objFSO.DeleteFile UserProfile & "\Local Settings\Temporary Internet Files\*.*", DeleteReadOnly
objFSO.DeleteFile UserProfile & "\Local Settings\Temp\*.*", DeleteReadOnly

ShowSubFolders objFSO.GetFolder (UserProfile & "\Local Settings\Temporary Internet Files\")
ShowSubFolders objFSO.GetFolder (UserProfile & "\Local Settings\Temp\")
ShowSubFolders objFSO.GetFolder (SysRoot & "\Temp\")
ShowSubFolders objFSO.GetFolder (SysDrive & "\Temp\")


Sub ShowSubFolders(Folder)
	For Each Subfolder in Folder.SubFolders
	'Wscript.Echo Subfolder.Path
	objFSO.DeleteFile(Subfolder.Path & "\*.*"), DeleteReadOnly
	ShowSubFolders Subfolder
Next
End Sub

'************************************************************************************************************************************************
' LOG ALL USERS
' VBScript Logon script.
' Log all User logons To \\server1\ServerLogonLogs and call the file Logonserver.log

Dim objLogFile, strText, intAns
Dim intConstants, intTimeout, strTitle, intCount, blnLog
Dim strIP, strShare, strLogFile

strShare = "\\server1\ServerLogonLogs"
strLogFile = "Logonserver.csv"
intTimeout = 20

strIP = Join(GetIPAddresses())

' Log date/time, user name, computer name, and IP address.
If objFSO.FolderExists(strShare) Then
  On Error Resume Next
  Set objLogFile = objFSO.OpenTextFile(strShare & "\" _
    & strLogFile, 8, True, 0)
  If Err.Number = 0 Then
    ' Make three attempts to write to log file.
    intCount = 1
    blnLog = False
    Do Until intCount = 3
      objLogFile.WriteLine "Logon , "  & Now & " , " _
        & strComputer & " , " & Userstring & " , " & strIP
      If Err.Number = 0 Then
        intCount = 3
        blnLog = True
      Else
        Err.Clear
        intCount = intCount + 1
        If Wscript.Version > 5 Then
          Wscript.Sleep 200
        End If
      End If
    Loop
    On Error GoTo 0
    If blnLog = False Then
      strTitle = "Logon Error"
      strText = "Log cannot be written."
      strText = strText & vbCrlf _
        & "Another process may have log file open."
      intConstants = vbOKOnly + vbExclamation
      intAns = WshShell.Popup(strText, intTimeout, strTitle, _
        intConstants)
    End If
    objLogFile.Close
  Else
    On Error GoTo 0
    strTitle = "Logon Error"
    strText = "Log cannot be written."
    strText = strText & vbCrLf & "User may not have permissions,"
    strText = strText & vbCrLf & "or log folder may not be shared."
    intConstants = vbOKOnly + vbExclamation
    intAns = WshShell.Popup(strText, intTimeout, strTitle, intConstants)
  End If
  Set objLogFile = Nothing
End If

Function GetIPAddresses()
'=======================================================================================================
' Returns array of IP Addresses as output by ipconfig or winipcfg...
'
' Win98/WinNT have ipconfig (Win95 doesn't)
' Win98/Win95 have winipcfg (WinNt doesn't)
'
' Note: The PPP Adapter (Dial Up Adapter) is
' excluded if not connected (IP address will be 0.0.0.0)
' and included if it is connected.
'=======================================================================================================
  Dim Wshshell, objFSO, WshSysEnv, workfile, ts, data, index, n, arIPAddress, parts

  Set Wshshell = Createobject("Wscript.Shell")
  set objFSO = Createobject("Scripting.FileSystemObject")
  Set WshSysEnv = Wshshell.Environment("Process")
  If WshSysEnv("OS") = "Windows_NT" Then
    Workfile = WshSysEnv("TEMP") & "\" & objFSO.gettempname
    Wshshell.run "%comspec% /c ipconfig >" & Chr(34) & workfile & Chr(34),0,True
  Else
    'winipcfg in batch mode sends output to
    'filename winipcfg.out
    Workfile = "winipcfg.out"
    Wshshell.run "winipcfg /batch" ,0,true
  End If
  Set Wshshell = nothing
  Set ts = objFSO.opentextfile(workfile)
  data = split(ts.readall,vbcrlf)
  ts.close
  Set ts = nothing
  objFSO.deletefile workfile
  Set objFSO = nothing
  arIPAddress = array()
  index = -1
  For n = 0 to ubound(data)
    If instr(data(n),"IP Address") Then
      parts = split(data(n),":")
      'if trim(parts(1)) <> "0.0.0.0" then
      If instr(trim(parts(1)), "0.0.0.0") = 0 Then
        index = index + 1
        ReDim Preserve arIPAddress(index)
        arIPAddress(index)= trim(cstr(parts(1)))
      End If
    End If
  Next
  GetIPAddresses = arIPAddress
End Function

'================================================================================================
Sub addText(data)
	html = html & "<h4><font face=arial color=#306EFF>" & data & "</h4>"
	objExplorer.Document.Body.InnerHTML = html
End Sub 

'END TEST AREA
'************************************************************************************************************************************************
'************************************************************************************************************************************************
'************************************************************************************************************************************************
' 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>Your 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>"&_
"<table border=""0"" width=""100%"" cellpadding=""10"" cellspacing=""3"" bgcolor=""red"">" &_
"<br>"&_
"<h4><center>I agree Your Disclaimer Information goes here</center></h4>" &_
"<br>"&_
		"<form name=""Buttons""><table width=""100%"" cellpadding=""10""><tr><td width=""50%""><center>"&_
        "<button ID=""cmdYes"">Yes, I Agree</button></center></td>" &_
        "<td><center><button ID=""cmdNo"">No, I Do Not Agree</button></center></td></tr></table></form></body></html>"&_
		"<table border=""0"" width=""100%"" cellpadding=""1"" cellspacing=""2"" bgcolor=""red"">" &_
		"<br>" &_
		"<br>" &_
    objDocument.Close
    Set objDocument.All.cmdYes.OnClick = GetRef("cmdYes_click")
    Set objDocument.All.cmdNo.OnClick = GetRef("cmdNo_click")
	    bYesClick = False
	    bNoClick = False
	    bUserClose = False

    Do
        WScript.Sleep 250
        If bNoClick Then Logout
        If bUserClose Then ShowLegal
    Loop Until bYesClick
    If objExplorer.Visible Then objExplorer.Visible = False


Sub cmdYes_Click()
    bYesClick = True
End Sub

Sub cmdNo_Click()
    bNoClick = True
End Sub

Sub objExplorer_OnQuit
    bUserClose = True
End Sub

Sub Logout
    Dim colOS, oOS
    Set colOS = GetObject("winMgmts:").ExecQuery("Select * from Win32_OperatingSystem")
    For Each oOS In colOS
        oOS.Win32Shutdown 0
        If Err.Number Then WSHShell.Run LPath & "\logout.exe", 0, True
    Next
End Sub

Sub cmdOK_Click()
    bOKClick = True
End Sub
objExplorer.Document.Body.Style.Cursor = "default"
'===========================================================================================================


Wscript.Sleep 5000

objExplorer.Quit

'===========================================================================================================
'Clean Up Memory We Used
set UserObj = Nothing
set GroupObj = Nothing
set WSHNetwork = Nothing
set DomainString = Nothing
Set WSHPrinters = Nothing
Set objFSO = Nothing
Set WshShell = Nothing
Set WshSysEnv = Nothing
Set WshNetwork = Nothing
'Quit the Script
wscript.quit

'************************************************************************************************************************************************

'Add on Codes
'========================================================
'Turn Off Network Printer Notification Add On CODE

' This section of script will prevent the balloon window
' that appears when printing to a network shared printer
' after XP Service Pack 2 is installed.
'============================================================

'Path = "HKCU\Printers\Settings\EnableBalloonNotificationsRemote"'
'WshShell.RegWrite Path, 0 ,"REG_DWORD"


'============================================================
'Speak User Name Add On CODE
' This Add On demonstates the Microsoft Speach API (SAPI)
'=========================================================
'Dim oVo
'Set oVo = Wscript.CreateObject("SAPI.SpVoice")
'oVo.speak "Good Morning " & WSHNetwork.username
'==========================================================================


'Start Menu Require Click Add On CODE
'Dim smpath
'smpath = "HKCU\Control Panel\Desktop\"
'the following line will REQUIRE a click in the start menu
'=====================================
'WSHShell.RegWrite smpath & "MenuShowDelay","65535","REG_SZ"
'the following line will reverse what this Add On has set.
'to undo what this script has done, comment out the above line and uncomment the following
'WSHShell.RegWrite smpath & "MenuShowDelay","400","REG_SZ"
'Set smpath = nothing

'Clear Temporary Internet Files on Exit Add On CODE
' This code will empty the Temp Internet Files on Exit
'=====================================
'Dim tempiepath
'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


'April Fools
'OK, so you are feeling playful and are willing to field a plethora of phone calls and have decided to play a little joke on your favorite users.  The following code will eject the CD ROM drive.  Now seriously, don't go abusing this or I will tell your mother on you!
'CODE
'Add On Code To Eject CD ROM Drive
'Const CDROM = 4
'For Each d in CreateObject("Scripting.FileSystemObject").Drives
'  If d.DriveType = CDROM Then
'    Eject d.DriveLetter & ":\"
'  End If
'Next

'Sub Eject(CDROM)
'  Dim ssfDrives
'  ssfDrives = 17
'  CreateObject("Shell.Application")_
'    .Namespace(ssfDrives).ParseName(CDROM).InvokeVerb("E&ject")
'End Sub
'************************************************************************************************************************************************

markdmac · Oct 22, 2007

GrimR looks like your script was cut off due to length.

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

GrimR · Oct 22, 2007

Thanks Mark.
Here is the rest, left out the add-ons which can be found on Marks FAQ

Code:

'===========================================================================================================
'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>Your 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>"&_
"<table border=""0"" width=""100%"" cellpadding=""10"" cellspacing=""3"" bgcolor=""red"">" &_
"<br>"&_
"<h4><center>I agree Your Disclaimer Information goes here</center></h4>" &_
"<br>"&_
		"<form name=""Buttons""><table width=""100%"" cellpadding=""10""><tr><td width=""50%""><center>"&_
        "<button ID=""cmdYes"">Yes, I Agree</button></center></td>" &_
        "<td><center><button ID=""cmdNo"">No, I Do Not Agree</button></center></td></tr></table></form></body></html>"&_
		"<table border=""0"" width=""100%"" cellpadding=""1"" cellspacing=""2"" bgcolor=""red"">" &_
		"<br>" &_
		"<br>" &_
    objDocument.Close
    Set objDocument.All.cmdYes.OnClick = GetRef("cmdYes_click")
    Set objDocument.All.cmdNo.OnClick = GetRef("cmdNo_click")
	    bYesClick = False
	    bNoClick = False
	    bUserClose = False

    Do
        WScript.Sleep 250
        If bNoClick Then Logout
        If bUserClose Then ShowLegal
    Loop Until bYesClick
    If objExplorer.Visible Then objExplorer.Visible = False


Sub cmdYes_Click()
    bYesClick = True
End Sub

Sub cmdNo_Click()
    bNoClick = True
End Sub

Sub objExplorer_OnQuit
    bUserClose = True
End Sub

Sub Logout
    Dim colOS, oOS
    Set colOS = GetObject("winMgmts:").ExecQuery("Select * from Win32_OperatingSystem")
    For Each oOS In colOS
        oOS.Win32Shutdown 0
        If Err.Number Then WSHShell.Run LPath & "\logout.exe", 0, True
    Next
End Sub

Sub cmdOK_Click()
    bOKClick = True
End Sub
objExplorer.Document.Body.Style.Cursor = "default"
'===========================================================================================================


Wscript.Sleep 5000

objExplorer.Quit

'===========================================================================================================
'Clean Up Memory We Used
set UserObj = Nothing
set GroupObj = Nothing
set WSHNetwork = Nothing
set DomainString = Nothing
Set WSHPrinters = Nothing
Set objFSO = Nothing
Set WshShell = Nothing
Set WshSysEnv = Nothing
Set WshNetwork = Nothing
'Quit the Script
wscript.quit

dublin101 · Oct 22, 2007

absolutely fantastic..........its that comprehensive i'm going to have to spend some time to decode it all..

super stuff..thanks heaps

dublin101 · Oct 28, 2007

if i may ask......i'm having issues with the wallpaper.

this is what i have:

'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")
WinPath = SysRoot & "\NameWallpaper.bmp"

'The wallPaper should be saved on a share as Name600x800.bmp, and Name1024x768 etc

If Not objFSO.FileExists(winpath) then
'If the file does not exist then copy it
For Each objItem in colItems
sourcePath = "\\192.168.1.131\files\"
rightSize = "Name" & objItem.CurrentHorizontalResolution & "x" & objItem.CurrentVerticalResolution & ".bmp"
objFSO.CopyFile sourcePath & rightSize, SysRoot & "\Wallpaper.bmp", overwrite = True
Next
End If

'************************************************************************************************************************************************
'Set Wallpaper Bitmap to Default
Set WshShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")

sWinDir = objFSO.GetSpecialFolder(0)
sWallPaper = sWinDir & "\NameWallpaper.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

i am just getting a blank blue desktop and not the actual image of the .bmp file. thanks.

markdmac · Oct 28, 2007

dublin,

You have not defined "SysRoot"

Your collection should be empty because you have remarked out the computer name.

Manually verify the registry settings you are trying to set. I am betting they do not contain the expected data.

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

dublin101 · Oct 28, 2007

yeh i'm not familiar with the SysRoot thing..

when i do execute the script, it changes my desktop to a plain blue desktop.

markdmac · Oct 28, 2007

The point I am making is you are not providing the path to the file.

Code:

'Set the wallpaper
[red]'strComputer = "."[/red]
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")
  WinPath = [red]SysRoot[/red] & "\NameWallpaper.bmp"

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

GrimR · Oct 28, 2007

if you getting a blue screen it's because it can't find the file that has been copied over.
As Mark said you need sysroot

Two ways of doing it
1. Set oShell = CreateObject("Wscript.Shell")
sysroot = oShell.ExpandEnvironmentStrings("%SYSTEMROOT%")
WScript.Echo sysroot

2.Set oShell = CreateObject("Wscript.Shell")
Set oEnv = oShell.Environment("Process")
sysroot = oEnv("SYSTEMROOT")
WScript.Echo sysroot

explanation: Sysroot above variable is made equal to %systemroot% or as in 2 systemroot which is the same as C:\WINDOWS

Hope this helps

dublin101 · Oct 29, 2007

so is this ok? I added the sysroot..i gather the whole process is where the script copies the .bmp file over from the share into the sysroot on the PC.

do i need to uncomment the strComputer = "." ?

Code:

'Set the wallpaper
'strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
[COLOR=red]Set oShell = CreateObject("Wscript.Shell")
sysroot = oShell.ExpandEnvironmentStrings("%SYSTEMROOT%")
WScript.Echo sysroot[/color]
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")
  WinPath = SysRoot & "\NameWallpaper.bmp"

markdmac · Oct 29, 2007

If you want the WMI query to work then yes.

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

dublin101 · Oct 29, 2007

update:

i tried with the above additions and it did not work, i tried with and without commenting the strcomputer.

what i get when i run the screen is a popup saying "C:\Windows", which i gather is from the wscript.echo command (i'm starting to learn this and liking it).

this is my code at momemt:

Code:

'Set the wallpaper
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set oShell = CreateObject("Wscript.Shell")
sysroot = oShell.ExpandEnvironmentStrings("%SYSTEMROOT%")
WScript.Echo sysroot
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")
  WinPath = SysRoot & "\NameWallpaper.bmp"


 'The wallPaper should be saved on a share as Name600x800.bmp, and Name1024x768 etc
 
If Not objFSO.FileExists(winpath) then
'If the file does not exist then copy it
    For Each objItem in colItems
        sourcePath = "\\192.168.1.131\files"
        rightSize = "Name" & objItem.CurrentHorizontalResolution & "x" & 

objItem.CurrentVerticalResolution & ".bmp"
        objFSO.CopyFile sourcePath & rightSize, SysRoot & "\Wallpaper.bmp", overwrite = True
    Next
End If

GrimR · Oct 29, 2007

Try this.
Remember your wallpaper file on the network needs to be called Name800x600.bmp or whatever your screen resolution is.

Code:

'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)
  WinPath = sWinDir & "\NameWallpaper.bmp"
 
If Not objFSO.FileExists(winpath) then
'If the file does not exist then copy it
	For Each objItem in colItems 
	    sourcePath = "\\192.168.1.131\files\"
	    rightSize = "Name" & objItem.CurrentHorizontalResolution & "x" & objItem.CurrentVerticalResolution & ".bmp"
	    objFSO.CopyFile sourcePath & rightSize, sWinDir & "\NameWallpaper.bmp", overwrite = True
	Next
End If

'Set Wallpaper Bitmap to Default
sWallPaper = sWinDir & "\NameWallpaper.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

dublin101 · Oct 29, 2007

running the above script changes the background to blue...so at this stage that is still good sign as it is at least changing.

now i have to figure out why it can't find it.......i have three files on the file server named: name800x600.bmp, name1024x768.bmp, etc...

could it be the syntax of the server...eg should the "\" be there at the end of \\192.168.x.x\files\

or somethign like that?

thanks Grim. Legend

GrimR · Oct 29, 2007

Is the file being copied to in C:\windows?
do you have a folder called files and bmp's are in there then \\192.168.1.131\files\ is correct.
Test to make sure you can manually change the backround to those bitmaps you created.

dublin101 · Oct 29, 2007

got it working guys thanks heaps...i was trying with JPGs too but only .bmp works. thanks.

the only issue i now face is that it takes ages to load up and it loads up after log in....

so maybe i'll just think of forcing it to run another way. thanks guys.

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

HTA login script with vbs and disclaimer

Technical User

IS-IT--Management

Technical User

MIS

IS-IT--Management

MIS

IS-IT--Management

Technical User

Technical User

MIS

Technical User

MIS

IS-IT--Management

Technical User

MIS

Technical User

IS-IT--Management

Technical User

IS-IT--Management

Technical User

Similar threads

Log in

Part and Inventory Search

Sponsor