Here is a login script i've been working on for a client. Some parts of this I have stolen from other scripts, modified as necessary and put together to work as it is now. This script will seek out a file named Random.txt on the Netlogon share of whatever domain controller this runs on. This text file consists of one-line tips that are randomized. A simple but neat splash screen will show the users that a login script is running, complete with simple progress bar and tip of the day from random.txt. The client has a specific naming scheme for all computers, and this is used to determine where you are logging on from.. group membership of the user is also enumerated (with the GetEx method so this does not fail if the user is a member of only one group) and drives are mapped based on this.
I hope that some or all of this can be helpful to someone.. or maybe someone can point out something screwy I did....
Option Explicit
On Error Resume Next
dim o_FSO
Dim htaout
Dim oShell
Dim oEnv
Dim PreTemp
Dim PostTemp
Dim pEnv
Dim Part1
Dim Part2
Dim RandArr
Dim strNTName
Dim wshNetwork
Dim strComputer
Dim objWMIService
Dim objSysInfo
Dim CompName
Dim LenCompName
Dim TmpWLen
Dim TmpPLen
Dim TmpWName
Dim TmpPName
Dim strGroup
Dim strGroupPath
Dim objGroup
Dim strGroupName
Dim WSORSV
Dim PCORSV
Dim strUserPath
Dim objUser
Dim UserID
Dim objTrans
Dim Random
Dim LogonServer
Dim objMemberOf
Const FOR_WRITING = 2
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
const FOR_READING = 1
set o_FSO = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("Wscript.Shell")
Set oEnv = oShell.Environment("User")
set pEnv = oShell.Environment("Process")
Part2 = pEnv("UserProfile")
Part1 = oEnv("Temp")
PostTemp = (Replace(Part1, "%USERPROFILE%",part2, 1, -1, vbTextCompare) & "\ProgressBar.HTA")
Logonserver = Penv("Logonserver")
Random = Logonserver & "\NETLOGON\Random.txt"
Set wshNetwork = CreateObject("WScript.Network")
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set objSysInfo = CreateObject("ADSystemInfo")
CompName = wshNetwork.ComputerName
LenCompName = Len(CompName)2
TmpWLen = LenCompName - 4
TmpPLen = LenCompName - 5
TmpWName = Right(CompName, TmpWLen)
TmpPName = Right(CompName, TmpPLen)
WSORSV = Left(TmpWName, 2)
PCORSV = Left(TmpPName, 2)
strUserPath = "LDAP://" & objSysInfo.UserName
Set objUser = GetObject(strUserPath)
UserID = objUser.SamAccountName & "$"
If ((WSORSV = "WS") OR (WSORSV = "LT") OR (WSORSV = "PC") OR (PCORSV = "WS") OR (PCORSV = "PC") OR (PCORSV = "LT")) Then
Call SplashScreen
' Standard Mappings
wshNetwork.MapNetworkDrive "G:", "\\DOMAIN\shared"
wshNetwork.MapNetworkDrive "H:", "\\DOMAIN\home\" & UserID
wshNetwork.MapNetworkDrive "I:", "\\SERVER007\apps"
'End Standard Mappings
'Mappings based on Group Membership
objMemberof = objUser.GetEx("memberof")
For Each strGroup in objMemberOf
strGroupPath = "LDAP://" & strGroup
Set objGroup = GetObject(strGroupPath)
strGroupName = objGroup.distinguishedName
Call NameTrans(strGroupName)
If ((strNTName = "DOMAIN\GROUP-Shared-Status Report RO") OR (strNTName = "DOMAIN\GROUP Status Report")) then
wshNetwork.MapNetworkDrive "L:", "\\Server001\shared"
End If
If strNTName = "DOMAIN\LGN-Grp DEV Users" then
wshNetwork.MapNetworkDrive "R:", "\\Server007\Sharetst"
wshNetwork.MapNetworkDrive "S:", "\\Server007\Sharest1"
wshNetwork.MapNetworkDrive "U:", "\\Server007\Sharedev"
wshNetwork.MapNetworkDrive "V:", "\\Server007\Sharedev"
wshNetwork.MapNetworkDrive "W:", "\\Server007\Share7"
End If
If strNTName = "DOMAIN\APPGroup-RFP" then
wshNetwork.MapNetworkDrive "P:", "\\Server44\data"
End If
'End Mappings based on Group Membership
strNTName = ""
Next
End If
'Terminal Server Clients
If ((WSORSV = "TS") OR (PCORSV = "TS")) Then
Call SplashScreen
' Standard Mappings
wshNetwork.MapNetworkDrive "G:", "\\DOMAIN\shared"
wshNetwork.MapNetworkDrive "H:", "\\DOMAIN\home\UserID"
' Standard Mappings
'Mappings based on Group Membership
objMemberof = objUser.GetEx("memberof")
For Each strGroup in objMemberOf
strGroupPath = "LDAP://" & strGroup
Set objGroup = GetObject(strGroupPath)
strGroupName = objGroup.distinguishedName
Call NameTrans(strGroupName)
If strNTName = "DOMAIN\LGN-Application PRD Users" then
wshNetwork.MapNetworkDrive "L:", "\\Server\apps"
wshNetwork.MapNetworkDrive "I:", "\\" & CompName & "\apps"
End If
strNTName = ""
Next
End If
Sub NameTrans(Group)
On Error Resume Next
'The purpose of this subroutine is to convert the distinguished name of
'a group to the NT (domain\name) so that multi-domain group membership
'verification may be possible
Set objTrans = CreateObject("NameTranslate")
' Initialize NameTranslate by locating the Global Catalog.
objTrans.Init ADS_NAME_INITTYPE_GC, ""
' Use the Set method to specify the RPC 1779 format of the object name.
objTrans.Set ADS_NAME_TYPE_1779, Group
' Use the Get method to retrieve the NT Name.
strNTName = objTrans.Get(ADS_NAME_TYPE_NT4)
End Sub
Sub SplashScreen
'-------Read in Tip of the Day Text and Randomize
RandArr = LoadData(RANDOM)
If Err.number <> 0 Then
Wscript.sleep(50000)
End If
RandArr = RandomizeArray(RandArr)
'Check for existance of HTA file, if exists, delete it.
If o_FSO.FileExists(PostTemp) Then
o_FSO.DeleteFile(PostTemp), True
End If
'write HTA file for splash screen
set htaout = o_FSO.OpenTextFile(PostTemp, FOR_WRITING, True)
htaout.writeline " <html> "
htaout.writeline " <head> "
htaout.writeline " <title> "
htaout.writeline " Please Wait... "
htaout.writeline " </title> "
htaout.writeline " "
htaout.writeline " <HTA:APPLICATION "
htaout.writeline " ID=" & Chr(34) & "StatusBar" & Chr(34) & " "
htaout.writeline " APPLICATIONNAME=" & Chr(34) & "StatusBar" & Chr(34) & " "
htaout.writeline " SCROLL=" & Chr(34) & "no" & Chr(34) & ""
htaout.writeline " SINGLEINSTANCE=" & Chr(34) & "yes" & Chr(34) & ""
htaout.writeline " CAPTION=" & Chr(34) & "no" & Chr(34) & ""
htaout.writeline " BORDER=" & Chr(34) & "thin" & Chr(34) & ""
htaout.writeline " BORDERSTYLE=" & Chr(34) & "Normal" & Chr(34) & ""
htaout.writeline " SHOWINTASKBAR=" & Chr(34) & "no" & Chr(34) & " "
htaout.writeline " CONTEXTMENU" & Chr(34) & "no" & Chr(34) & "> "
htaout.writeline " </head> "
htaout.writeline " <SCRIPT LANGUAGE=" & Chr(34) & "VBScript" & Chr(34) & "> "
htaout.writeline " Dim iTimerID "
htaout.writeline " "
htaout.writeline " "
htaout.writeline " Sub Window_Onload"
htaout.writeline " iTimerID = window.setInterval(" & Chr(34) & "Display_Progress" & Chr(34) & ", 50) "
htaout.writeline " strComputer = " & Chr(34) & "." & Chr(34) & " "
htaout.writeline " Set objWMIService = GetObject( " & Chr(34) & "winmgmts:\\" & Chr(34) & " & strComputer & " & Chr(34) & "\root\cimv2" & Chr(34) & ") "
htaout.writeline " Set colItems = objWMIService.ExecQuery( " & Chr(34) & "Select * From Win32_DesktopMonitor" & Chr(34) & ") "
htaout.writeline " For Each objItem in colItems "
htaout.writeline " intHorizontal = objItem.ScreenWidth "
htaout.writeline " intVertical = objItem.ScreenHeight "
htaout.writeline " Next "
htaout.writeline " intLeft = (intHorizontal - 430) / 2 "
htaout.writeline " intTop = (intVertical - 60) / 2 "
htaout.writeline " window.resizeTo 475,325 "
htaout.writeline " 'window.moveTo intLeft, intTop "
htaout.writeline " call Display_Progress "
htaout.writeline " End Sub "
htaout.writeline " "
htaout.writeline " Sub Display_Progress "
htaout.writeline " If ProgressBar1.Value = ProgressBar1.Max Then "
htaout.writeline " window.clearInterval(iTimerID) "
htaout.writeline " self.close "
htaout.writeline " Else "
htaout.writeline " ProgressBar1.Value = ProgressBar1.Value + 1 "
htaout.writeline " End if "
htaout.writeline " End Sub "
htaout.writeline " </SCRIPT> "
htaout.writeline " <style>"
htaout.writeline " body,td,a {font-family:Arial;font-size:12px;text-decoration:none;color:black;}"
htaout.writeline " body {background: #F3F1E6;}"
htaout.writeline " /*body {filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=2, StartColorStr='#FFFFFF', EndColorStr='#0000FF')}*/"
htaout.writeline " .pix {width: 5px; height .5px;}"
htaout.writeline " .warning {color:#FF0000; font-size: 1em; font-weight:bold;}"
htaout.writeline " </style>"
htaout.writeline " "
htaout.writeline " <body "
htaout.writeline " "
htaout.writeline " >"
htaout.writeline " <!-- STYLE= " & Chr(34) & "font:14 pt arial; color:white;" & Chr(34) & ""
htaout.writeline " filter:progid:DXImageTransform.Microsoft.Gradient "
htaout.writeline " (GradientType=1, StartColorStr='#FFFFFF', EndColorStr='#8B0000') -->"
htaout.writeline " "
htaout.writeline " <table width=" & Chr(34) & "450" & Chr(34) & ">"
htaout.writeline " <tr><td align=" & Chr(34) & "center" & Chr(34) & ">"
htaout.writeline " "
htaout.writeline " <img src=" & chr(34) & Logonserver & "\NETLOGON\companylogo.gif" & chr(34) & ">"
htaout.writeline " <br>"
htaout.writeline " <br>"
htaout.writeline " Welcome to the Client's Big Bad Network. <br />"
htaout.writeline " <hr />"
htaout.writeline " <span class=" & Chr(34) & "warning" & Chr(34) & ">Please Note All Network Activities are Monitored. <br />"
htaout.writeline " Unauthorized Access is Strictly Prohibited. </span>"
htaout.writeline " <hr />"
htaout.writeline RandArr(4) & "<BR>"
htaout.writeline "<BR>"
htaout.writeline " <hr />"
htaout.writeline " Logging In.. Please Wait... " & "<BR>"
htaout.writeline "<BR>"
htaout.writeline " <p /><p />"
htaout.writeline " "
htaout.writeline " </td></tr>"
htaout.writeline " </table>"
htaout.writeline " <center>"
htaout.writeline " <object classid= " & Chr(34) & "clsid:35053A22-8589-11D1-B16A-00C0F0283628" & Chr(34) & " id= " & Chr(34) & "ProgressBar1" & Chr(34) & " height= " & Chr(34) & "10" & Chr(34) & " width= " & Chr(34) & "450" & Chr(34) & ">"
htaout.writeline " <param name= " & Chr(34) & "Min " & Chr(34) & "value= " & Chr(34) & "0" & Chr(34) & ">"
htaout.writeline " <param name= " & Chr(34) & "Max " & Chr(34) & "value= " & Chr(34) & "4" & Chr(34) & ">"
htaout.writeline " <param name= " & Chr(34) & "Orientation" & Chr(34) & " value= " & Chr(34) & "0" & Chr(34) & ">"
htaout.writeline " <param name= " & Chr(34) & "Scrolling" & Chr(34) & " value= " & Chr(34) & "1" & Chr(34) & ">"
htaout.writeline " </object> "
htaout.writeline " </center>"
htaout.writeline " </body> "
htaout.writeline " </html> "
oShell.Run (chr(34) & PostTemp & chr(34)), 1, False
Wscript.Sleep(1000)
htaout.Close
o_FSO.DeleteFile(PostTemp), True
End Sub
'function for Randomizing text in Random.txt so a random line is displayed each time
Function RandomizeArray(arrIn)
Dim arrOut
Dim i
Dim nElement
ReDim arrOut(Ubound(arrIn))
For i = 0 To UBound(arrIn)
'Randomly choose an element from the in Array
Randomize()
nElement = Int(Rnd(1)* UBound(arrIn))
'Put that element into the new Array
arrOut(i) = arrIn(nElement)
'remove that element from the original Array
arrIn = RemoveElement(arrIn, nElement)
Next
RandomizeArray = arrOut
End Function
' Function for loading data from a text file into an array.
function LoadData(s_File)
on error resume next
dim o_TextStream
dim o_Dictionary
'Create objects for the array
set o_Dictionary = CreateObject("Scripting.Dictionary")
set o_TextStream = CreateObject("Scripting.FileSystemObject") _
.OpenTextFile(s_File, FOR_READING)
if(Err.Number) then
wscript.Quit(2)
end if
on error goto 0
'load data into the array
dim s_currentLine
do while NOT o_TextStream.AtEndOfStream
s_currentLine = o_TextStream.ReadLine
if not(o_Dictionary.Exists(s_currentLine)) then
if(s_currentLine <> "") then
o_Dictionary.Add s_currentLine, ""
end if
end if
loop
LoadData = o_Dictionary.Keys
'cleanup
o_TextStream.close
set o_TextStream = nothing
set o_Dictionary = nothing
end function
Function RemoveElement(arrIn, nElement)
Dim arrOut
Dim i
Dim x
ReDim arrOut(Ubound(arrIn) - 1)
x = 0
For i = 0 To UBound(arrIn)
If Not i = nElement Then
arrOut(x) = arrIn(i)
x = x + 1
End If
Next
RemoveElement = arrOut
End Function