Mark Minasi's Reader Forum
Mark Minasi's Reader Forum
Home | Profile | Register | Active Topics | Active Polls | Members | Search | FAQ | Minasi Forum RSS Feed
Username:
Password:
Save Password
Forgot your Password?

 All Forums
 Old, obsolete or unused
 Scripting Archive
 VBS & IE Logon Script:
 New Topic  Reply to Topic
 Printer Friendly
Next Page
Author  Topic Next Topic
Page: of 2

schmecky
Seasoned But Casual Onlooker

75 Posts
Status: offline

Posted - 01/18/2005 :  1:36:53 PM  Show Profile  Visit schmecky's Homepage  Reply with Quote
Thought I'd post a logon script I've been using with several different clients.

Examples are shown using logic based on username, group membership, and workstation name. Also included is mapping public and private drives, mapping printers, mapping LPT ports, setting default printers, calling out 3rd party DOS executables, centrally manage desktop icons, and it writes output to an IE status window.

Usage:
Copy logon.vbs, logon.htm, and a company logo image to the netlogon share of your DC
Edit logon.htm with a text editor.
Change XYZCorp with your company name
edit the line that contains: src="logo.gif" width="183" height="122"
Replace the name of the logo with yours, and change the width & height to match that of your logo.

Edit logon.vbs and customize for your environment.

Here's the logon.htm file:

<html>
<head>
<title>XYZCorp Network Logon</title>
</head>
<Script Language=VBScript>
document.title="XYZCorp Network Logon"
Sub Hold()
	document.all.holdit.checked = true
End Sub
</Script>
<body onclick="hold()" SCROLL="no">
<table border="0" width="313" cellspacing="0" cellpadding="0">
  <tr>
    <td width="311"><center><img border="0" src="logo.gif" width="183" height="122"></td>
	</tr>
    <tr>
    <td><font face="Comic Sans MS"> Welcome to XYZCorp!
      <marquee ID=scrolling width="95%" height="8"></marquee>
      </font>
     <font face="Comic Sans MS">User Name: </font>
      <font face="Verdana" ID=Msg1></Font><p>
     <font face="Comic Sans MS">Computer Name: </font>
      <font face="Verdana" ID=Msg2></Font></p>
      <hr size="2" color=Red><font size = "1">
    </td>
  </tr>
  <tr>
    <td>
<font size = "2">
 Message Display:
    <textarea rows="8" name="wstatus" cols="60" style="font-family: Comic Sans MS; font-size: 8pt"></textarea></td>
  </tr>
</table>
<input type="checkbox" name="holdit">Check to leave window open.
</body>
</html>


Here's the logon.vbs file:

'************************************************************************
'***			XYZCorp VBS Login Script 		      ***
'************************************************************************
' Last modified 1/18/05

Dim objNetwork, objSysInfo, strUserDN
Dim objGroupList, objUser, objFSO
Dim strComputerDN, objComputer,objShell
Dim STRLOGONSERVER
Dim computername, strusername,strComputername,colUserEnvVars,colEnvVars,struserprofile,vfile
Dim WshNetwork, asdPath
Dim strMappedDrives, strStatus,struser
Dim IE,objWMIService,strcomputer,GroupDN,arrTemp,GroupCN
Set objNetwork = CreateObject("Wscript.Network")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objSysInfo = CreateObject("ADSystemInfo")
Set objShell = WScript.CreateObject("WScript.Shell")
Set colEnvVars = objShell.Environment("User")
struserprofile = objShell.ExpandEnvironmentStrings("%USERPROFILE%")
strlogonserver = objShell.ExpandEnvironmentStrings("%logonserver%")
strUserDN = objSysInfo.userName
strComputerDN = objSysInfo.computerName
strUserName = ucase((objNetwork.UserName))
strcomputername = ucase((objnetwork.computername))
Set objUser = GetObject("LDAP://" & strUserDN)
Set objComputer = GetObject("LDAP://" & strComputerDN)
Set objShell = Wscript.CreateObject("Wscript.Shell")
DIM strmessage
' Get the User ID
Set WSHNetwork = WScript.CreateObject("WScript.Network")
strUser = ""
While strUser = ""
	strUser = WSHNetwork.UserName
Wend

On error resume next

Call CreateIE()
showstat("Logon Script v1.0 " & Date() & " " & Time())
ie.document.all.scrolling.InnerText = "Please wait while your logon script runs."
ie.document.all.msg1.InnerText = strUser
ie.document.all.msg2.InnerText = strComputername

call main()

ie.document.all.scrolling.InnerText = "Network Logon Completed..."
showstat("Script Completed")
' Close IE status window
If not ie.document.all.holdit.checked then
	ie.quit()
End if

' *********************************************************
' ***	Create IE Status Window			        ***
' *********************************************************
Sub CreateIE()
  On Error Resume Next
  Set IE = CreateObject("InternetExplorer.Application")
  With IE
    .navigate "\\"&strlogonserver&"\netlogon\logon.htm"
    .resizable=0
    .height=480
    .width=350
    .menubar=0
    .toolbar=0
    .statusBar=0
    .visible=1
  End With
  Do while ie.Busy
    ' wait for page to load
    Wscript.Sleep 100
  Loop

End Sub


Sub Main()

' *********************************************************
' ***	Run Trend OfficeScan Client   		        ***
' *********************************************************
' Runs the OfficeScan Updater in the background.  (No DOS box is displayed to the user)

showstat("Updating Virus Definition Files")
objShell.Run "cmd /c \\fileserver\OfficeScan\PCCSRV\AUTOPCC.EXE",0


' *********************************************************
' ***		     Manage Desktop Icons		***
' *********************************************************
' Deletes existing and copies from a central location
' easy way to deploy icons to the users' desktop (or use group policy)

If objFSO.FileExists(struserprofile & "\desktop\some icon.lnk") Then
objFSO.DeleteFile (struserprofile & "\desktop\some icon.lnk")
End If
showstat("Creating some icon")
objFSO.CopyFile "\\fileserver\icons\some icon.lnk" , (struserprofile & "\desktop\some icon.lnk")



' ***********************************************************
' ***		    Map Common Network Drives   	  ***
' ***********************************************************

showstat("Mapping Z: for Public") 
 If Not MapDrive("Z:", "\\fileserver\Public") Then
    MsgBox "Unable to Map Z: to Public"
  End If

showstat("Mapping P: for Departments") 
 If Not MapDrive("P:", "\\fileserver\Departments") Then
    MsgBox "Unable to Map P: to Departments"
  End If


' ***********************************************************
' ***     	Private Network Drive Mappings		  ***
' ***********************************************************
' Map certain drives based on group membership

If IsMember("Accounting") Then
showstat("Mapping T: for Accounting") 
  If Not MapDrive("T:", "\\fileserver\Accounting") Then
    MsgBox "Unable to Map T: to Accounting"
  End If
End If

' *********************************
' ***	End of Drive Mappings	***
' *********************************

' ************************************************************
' ***	Setup Network Printers based on Group Membership   ***
' ************************************************************

' The following is an optional function to delete any existing Network Print mappings:
'showstat("Removing Network Printers")
'on error resume next
'Set oP=objNetwork.EnumPrinterConnections
'C=oP.Count
'Do While C>0
'  objNetwork.RemovePrinterConnection oP.Item(C-1),True,True
'  C=C-2
'Loop 

' Use AddPrinterConnection (instead of AddWindowsPrinterConnection) if you need to do an LPT
' Printer Mapping for some older DOS or telnet type applications

If IsMember("DOSAPP") Then
showstat("Mapping LPT1 for DOSAPP") 
objNetwork.AddPrinterConnection "LPT1", "\\printServer\Print1"
END IF

If IsMember("colorlaser") Then
showstat("Mapping COLOR Laser Printer") 
objNetwork.AddWindowsPrinterConnection "\\printServer\COLOR-LASER"
END IF

If IsMember("Mortgage") or IsMember("Processors") or IsMember("Realty") Then
showstat("Mapping Mortgage Printer") 
objNetwork.AddWindowsPrinterConnection "\\printServer\mortgage"
END IF

IF strcomputername = "frontdesk" Then
showstat("Mapping Front Desk Printer") 
objNetwork.AddWindowsPrinterConnection "\\printServer\front"

End If

IF STRComputername = "HSKIOSK3" or strComputerDN = "HSKIOSK4" THEN
objNetwork.SetDefaultPrinter "\\printServer\realty"
END IF

' If you want to exclude people from setting their default printer add them to the NoDefault group
if not IsMember("NoDefault") then

If IsMember("mortgage") THEN
objNetwork.SetDefaultPrinter "\\printServer\mortgage2"
END IF

IF strUsername = "lmckamie" then
objNetwork.SetDefaultPrinter "\\printServer\office"
END IF

IF strcomputername = "frontdesk" Then
objNetwork.SetDefaultPrinter "\\printserver\front"
End If

END IF 'member of nodefault


' *********************************
' ***	End Printer Mappings	***
' *********************************

' Norton does NOT like the objShell.Run command and will flag your script.  Avoid using these if
' you have Norton security on the desktop

' This will clear out the DNS cache, and make sure the workstation registers with the DNS server.
showstat( "Flushing DNS cache") 
objShell.Run "cmd /c ipconfig /flushdns",0
objShell.Run "cmd /c ipconfig /registerdns",0

End Sub ' MAIN

' Clean up and clear out some variables
Set objNetwork = Nothing
Set objFSO = Nothing
Set objSysInfo = Nothing
Set objGroupList = Nothing
Set objUser = Nothing
Set objComputer = Nothing

' showstat adds comments to the status window, and updates the IE display.
Function showstat(strmessage)
strstatus=strmessage + VBCRLF + strstatus 
ie.document.all.wstatus.InnerText = strstatus
end function

' IsMember is a boolean function to determine group membership.
Function IsMember(strGroup)
' Function to test for group membership,
' returns True if the user or computer is a member of the group.

  If IsEmpty(objGroupList) Then
    Call LoadGroups
  End If
  IsMember = objGroupList.Exists(strGroup)
End Function

Sub LoadGroups
' Subroutine to populate dictionary object with group memberships.
' objUser is the user or computer object, with global scope.
' objGroupList is a dictionary object, with global scope.

  Dim arrbytGroups, j, arrstrGroupSids(), objGroup

  Set objGroupList = CreateObject("Scripting.Dictionary")
  objGroupList.CompareMode = vbTextCompare

  objUser.GetInfoEx Array("tokenGroups"), 0
  arrbytGroups = objUser.Get("tokenGroups")
  If TypeName(arrbytGroups) = "Byte()" Then
    ReDim arrstrGroupSids(0)
    arrstrGroupSids(0) = OctetToHexStr(arrbytGroups)
    Set objGroup = GetObject("LDAP://<SID=" & arrstrGroupSids(0) _
      & ">")
    objGroupList(objGroup.sAMAccountName) = True
    Set objGroup = Nothing
    Exit Sub
  End If
  If UBound(arrbytGroups) = -1 Then
    Exit Sub
  End If

  ReDim arrstrGroupSids(UBound(arrbytGroups))
  For j = 0 To UBound(arrbytGroups)
    arrstrGroupSids(j) = OctetToHexStr(arrbytGroups(j))
    Set objGroup = GetObject("LDAP://<SID=" & arrstrGroupSids(j) _
      & ">")
    objGroupList(objGroup.sAMAccountName) = True
  Next
  Set objGroup = Nothing
End Sub

Function MapDrive(strDrive, strShare)
' Function to map network share to a drive letter.
' If the drive letter specified is already in use, the function
' attempts to remove the network connection.
' objFSO is the File System Object, with global scope.
' objNetwork is the Network object, with global scope.
' Returns True if drive mapped, False otherwise.

  Dim objDrive

  On Error Resume Next
  Err.Clear
  If objFSO.DriveExists(strDrive) Then
    Set objDrive = objFSO.GetDrive(strDrive)
    If Err.Number <> 0 Then
      Err.Clear
      MapDrive = False
      Exit Function
    End If
    If CBool(objDrive.DriveType = 3) Then
      objNetwork.RemoveNetworkDrive strDrive, True, True
    Else
      MapDrive = False
      Exit Function
    End If
    Set objDrive = Nothing
  End If
  objNetwork.MapNetworkDrive strDrive, strShare
  If Err.Number = 0 Then
    MapDrive = True
  Else
    Err.Clear
    MapDrive = False
  End If
  On Error GoTo 0
End Function

Function OctetToHexStr(arrbytOctet)
' Function to convert OctetString (byte array) to Hex string.

  Dim k
  OctetToHexStr = ""
  For k = 1 To Lenb(arrbytOctet)
    OctetToHexStr = OctetToHexStr _
      & Right("0" & Hex(Ascb(Midb(arrbytOctet, k, 1))), 2)
  Next
End Function

TeleData Consulting, Inc.
www.tdonline.com

Edited by - schmecky on 01/19/2005 1:14:03 PM

wkasdo
Administrator

Netherlands
7659 Posts
Status: offline

Posted - 01/19/2005 :  09:46:32 AM  Show Profile  Click to see wkasdo's MSN Messenger address  Reply with Quote
Looks interesting... but could you please enclose the code in the [ code ] and [ /code ] tags? That would make it much more readable. Thanks.

Make it as simple as you can, but not simpler -- Albert Einstein
Go to Top of Page

tmiller
Welcome Newcomer

USA
1 Posts
Status: offline

Posted - 03/14/2006 :  2:01:49 PM  Show Profile  Visit tmiller's Homepage  Reply with Quote
Great Script, how do you get the IE window to not close itself?
Go to Top of Page

christo78
Welcome Newcomer

3 Posts
Status: offline

Posted - 05/30/2006 :  07:19:04 AM  Show Profile  Visit christo78's Homepage  Reply with Quote
Love the login script with the IE window. What I would like to know, is there a way to slow down the login process or have the IE window stay on screen a little longer, I have set up some mappings to suit my domain but the window just flahes up and disappears in a blink. The drives are mapped though
Go to Top of Page

RSA
Here To Stay

Netherlands
179 Posts
Status: offline

Posted - 05/30/2006 :  07:46:18 AM  Show Profile  Visit RSA's Homepage  Click to see RSA's MSN Messenger address  Reply with Quote
Use Wscript.Sleep with a value (mseconds).
Go to Top of Page

christo78
Welcome Newcomer

3 Posts
Status: offline

Posted - 05/30/2006 :  08:50:21 AM  Show Profile  Visit christo78's Homepage  Reply with Quote
I was trying that, but where does it go. ther is already a sleep in this area
*** Create IE Status Window ***
' *********************************************************
Sub CreateIE()
On Error Resume Next
Set IE = CreateObject("InternetExplorer.Application")
With IE
.navigate "\\"&strlogonserver&"\netlogon\logon.htm"
.resizable=0
.height=480
.width=350
.menubar=0
.toolbar=0
.statusBar=0
.visible=1
End With
Do while ie.Busy
' wait for page to load
Wscript.Sleep 100
Loop

End Sub
but it doesnt seen to do anything when I increase it?
Thanks
Go to Top of Page

wim
Honorable But Hopeless Addict

Netherlands
1552 Posts
Status: offline

Posted - 05/31/2006 :  02:40:08 AM  Show Profile  Visit wim's Homepage  Click to see wim's MSN Messenger address  Reply with Quote
ie.document.all.scrolling.InnerText = "Network Logon Completed..."
showstat("Script Completed")
' Close IE status window
If not ie.document.all.holdit.checked then
ie.quit()
End if


I would put the sleep command just before the final close if you just want it to wait a while.

I hear and I forget, I see and I know, I do and I understand.
Go to Top of Page

christo78
Welcome Newcomer

3 Posts
Status: offline

Posted - 05/31/2006 :  05:41:10 AM  Show Profile  Visit christo78's Homepage  Reply with Quote
Thanks to all those who replied. I have it doing what i want. I did put a sleep in, it was just a matter of finding the right place
Go to Top of Page

MikePSmith
Welcome Newcomer

USA
2 Posts
Status: offline

Posted - 07/07/2006 :  5:27:47 PM  Show Profile  Reply with Quote
Thank you for posting this, I've been looking for something like this for a while.
One question...
I get an ActiveX error using IE7. Is there any way to accomplish the same thing without ActiveX?
Go to Top of Page

BangleJ
Welcome Newcomer

1 Posts
Status: offline

Posted - 08/06/2006 :  9:16:38 PM  Show Profile  Reply with Quote
I'm having trouble using the IsMember function with regard to machine accounts. I would like to map printers by machine. So, if a machine account is a member of "OfficePrinter" then no matter who is running the logon.vbs script, the right printer will map for that machine.

If IsMember("OfficePrinter") Then
showstat("Mapping Office Color Printer")
objNetwork.AddWindowsPrinterConnection "\\fileserver\officeptr"
END IF

I have put my machine account into this group and run the script, but the function returns False. How can I make the IsMemeber function work with machine accounts as the script documentation suggests that it does?

Thanks in advance for your time.
Go to Top of Page

wim
Honorable But Hopeless Addict

Netherlands
1552 Posts
Status: offline

Posted - 08/07/2006 :  12:59:26 AM  Show Profile  Visit wim's Homepage  Click to see wim's MSN Messenger address  Reply with Quote
This would only work if the script is run in the context of the machine. Worse, the user will not see the printer as it is mapped in another context. An easy solution to this can be to create a local variable named 'officeprinter' or directly the correct ur. Inside the loginscript you then use this information to make the correct connections.

I hear and I forget, I see and I know, I do and I understand.
Go to Top of Page

Playwell
Honorable But Hopeless Addict

Netherlands
4906 Posts
Status: offline

Posted - 08/07/2006 :  02:27:54 AM  Show Profile  Visit Playwell's Homepage  Click to see Playwell's MSN Messenger address  Reply with Quote
You can ask the computername in a script, and check if that computer is a member of a group. You would just change ismember to pick up the name:


If ismember(StrComputername & "$","OfficePrinter") then
showstat("Mapping COLOR Laser Printer") 
objNetwork.AddWindowsPrinterConnection "\\printServer\COLOR-LASER"
End if


The accountname of a computer in the AD has a dollar sign added, that's why the "$". (spend a few hours troubleshooting the script before it hit me )


'People who think they know everything are a great annoyance to those of us who do. '
Quote by Isaac Asimov


Go to Top of Page

wim
Honorable But Hopeless Addict

Netherlands
1552 Posts
Status: offline

Posted - 08/07/2006 :  03:56:29 AM  Show Profile  Visit wim's Homepage  Click to see wim's MSN Messenger address  Reply with Quote
Does the user have that kind of permission?

I hear and I forget, I see and I know, I do and I understand.
Go to Top of Page

Playwell
Honorable But Hopeless Addict

Netherlands
4906 Posts
Status: offline

Posted - 08/07/2006 :  04:04:48 AM  Show Profile  Visit Playwell's Homepage  Click to see Playwell's MSN Messenger address  Reply with Quote
yah, look at gpresult when run as a regular user.

'People who think they know everything are a great annoyance to those of us who do. '
Quote by Isaac Asimov


Go to Top of Page

El Fuego
Welcome Newcomer

1 Posts
Status: offline

Posted - 08/30/2006 :  1:16:33 PM  Show Profile  Reply with Quote
Hmm... I cannot get this script to run at all on my PCs in the domain.

I get this error right off the bat:
quote:

Script \\server\folder\logon.vbs
Line: 40
Char: 1
Error:Object doesn't support this property or method: 'document.all.scrolling'
Code: 800A01B6
Source: Microsoft VBScript runtime error



Any thoughts?

Edited by - El Fuego on 08/30/2006 1:18:00 PM
Go to Top of Page

rlawrason
Welcome Newcomer

1 Posts
Status: offline

Posted - 11/29/2006 :  1:23:23 PM  Show Profile  Reply with Quote
This script set is great! I absolutely love having an IE page instead of the MsgBox's and command windows of old...awesome job developing it.

I'm having one issue though. For some of my clients, the created IE window is starting in a minimized state near where the start bar is located when windows fully loads. Is there any way to force a maximized window and locate that window in the center of the screen?

I see the .visable = 1 code in the sub routine CreateIE(), and I have it set to 1 currently, but for some of my users it's still minimizing itself :(

Any advice?
Go to Top of Page

zinc
Welcome Newcomer

2 Posts
Status: offline

Posted - 03/29/2007 :  05:22:40 AM  Show Profile  Reply with Quote
Thanks for the script - it works brilliantly... unless IE7 is installed.

Well it does work as expected, but if the user had ended their previous IE session and opts to re-open all active tabs the next time IE runs, they are left with the logon window open with the next active tab in focus. It just looks a bit ugly and forces the user to manually close the IE window (which will ask again if they want the active tabs saved).

It seems that ie.quit only works with the currently selected tab. I've tried to find a way to enumerate all active tabs and close each one in turn (I don't care if tabs aren't remembered for users after a logon) but the documentation on tab management through automation is non-existant.

Does anyone have any ideas how to completely close the IE window.

Many Thanks.
Go to Top of Page

macblazer
Welcome Newcomer

USA
3 Posts
Status: offline

Posted - 04/03/2007 :  01:21:46 AM  Show Profile  Reply with Quote
Here's a question on the drive mapping.

I have a drive share that contains directories for each user that is there privatedata folder. (a folder only they have access to)

In a normal logon batch script I would merely map it as \\server\privatedata\%username%

How do I do that with this vb script?

The directory is always going to be named exactly the same as their logon username.
Go to Top of Page

zinc
Welcome Newcomer

2 Posts
Status: offline

Posted - 04/03/2007 :  07:15:25 AM  Show Profile  Reply with Quote
macblazer,

Dim objNetwork
Set objNetwork = CreateObject("Wscript.Network")

Dim strUsername
strUsername = objNetwork.Username

objNetwork.MapNetworkDrive "Q:", "\\server\privatedata\" & strUsername


Zinc
Go to Top of Page

netmarcos
Honorable But Hopeless Addict

USA
2272 Posts
Status: offline

Posted - 04/03/2007 :  07:19:24 AM  Show Profile  Visit netmarcos's Homepage  Click to see netmarcos's MSN Messenger address  Look at the Skype address for netmarcos  Send netmarcos a Yahoo! Message  Reply with Quote
Witin this particular script, you might try something like this:
showstat("Mapping H: for HomeDirectory") 
  If Not MapDrive("H:", "\\server\privatedata\" & strUserName) Then
    MsgBox "Unable to Map H: to HomeDirectory"
  End If

Mark M. Webster

Genius may have its limitations, but stupidity is not thus handicapped. - Elbert Hubbard


Edited by - netmarcos on 04/03/2007 07:21:03 AM
Go to Top of Page

macblazer
Welcome Newcomer

USA
3 Posts
Status: offline

Posted - 04/03/2007 :  10:55:06 AM  Show Profile  Reply with Quote
One more question...can someone tell me where my error is? I'm a VB newbie. I get an error saying it's expecting an if at line 211 char 5 and I'm not sure where I messed up.

'************************************************************************
'*** ACC VBS Login Script ***
'************************************************************************
' Last modified 1/18/05

Dim objNetwork, objSysInfo, strUserDN
Dim objGroupList, objUser, objFSO
Dim strComputerDN, objComputer,objShell
Dim STRLOGONSERVER
Dim computername, strusername,strComputername,colUserEnvVars,colEnvVars,struserprofile,vfile
Dim WshNetwork, asdPath
Dim strMappedDrives, strStatus,struser
Dim IE,objWMIService,strcomputer,GroupDN,arrTemp,GroupCN
Set objNetwork = CreateObject("Wscript.Network")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objSysInfo = CreateObject("ADSystemInfo")
Set objShell = WScript.CreateObject("WScript.Shell")
Set colEnvVars = objShell.Environment("User")
struserprofile = objShell.ExpandEnvironmentStrings("%USERPROFILE%")
strlogonserver = objShell.ExpandEnvironmentStrings("%logonserver%")
strUserDN = objSysInfo.userName
strComputerDN = objSysInfo.computerName
strUserName = ucase((objNetwork.UserName))
strcomputername = ucase((objnetwork.computername))
Set objUser = GetObject("LDAP://" & strUserDN)
Set objComputer = GetObject("LDAP://" & strComputerDN)
Set objShell = Wscript.CreateObject("Wscript.Shell")
DIM strmessage
' Get the User ID
Set WSHNetwork = WScript.CreateObject("WScript.Network")
strUser = ""
While strUser = ""
strUser = WSHNetwork.UserName
Wend

On error resume next

Call CreateIE()
showstat("Logon Script v1.2 " & Date() & " " & Time())
ie.document.all.scrolling.InnerText = "Please wait while your logon script runs."
ie.document.all.msg1.InnerText = strUser
ie.document.all.msg2.InnerText = strComputername

call main()

ie.document.all.scrolling.InnerText = "Network Logon Completed..."
showstat("Script Completed")
' Close IE status window
If not ie.document.all.holdit.checked then
ie.quit()
End if

' *********************************************************
' *** Create IE Status Window ***
' *********************************************************
Sub CreateIE()
On Error Resume Next
Set IE = CreateObject("InternetExplorer.Application")
With IE
.navigate "\\"&strlogonserver&"\netlogon\logon.htm"
.resizable=0
.height=600
.width=450
.menubar=0
.toolbar=0
.statusBar=0
.visible=1
End With
Do while ie.Busy
' wait for page to load
Wscript.Sleep 100
Loop

End Sub


Sub Main()

' *********************************************************
' *** Run Trend OfficeScan Client ***
' *********************************************************
' Runs the OfficeScan Updater in the background. (No DOS box is displayed to the user)

showstat("Updating Virus Definition Files")
objShell.Run "cmd /c \\avmon1\OFCSCAN\AUTOPCC",0
objShell.Run "cmd /c \\core2\netlogon\ofcpfwsvc_kill.bat",0


' ***********************************************************
' *** Map Common Network Drives ***
' ***********************************************************

showstat("Mapping K: for Publicdata")
If Not MapDrive("K:", "\\fileserver1\publicdata") Then
MsgBox "Unable to Map K: to Publicdata"
End If

showstat("Mapping J: for Privatedata")
If Not MapDrive("J:", "\\fileserver1\privatedata\" & strUserName) Then
MsgBox "Unable to Map J: to Privatedata"
End If

showstat("Mapping P: for Propertydata")
If Not MapDrive("P:", "\\studenthousing.com\root\propertydata") Then
MsgBox "Unable to Map P: to Propertydata"
End if


' ***********************************************************
' *** Private Network Drive Mappings ***
' ***********************************************************
' Map certain drives based on group membership

If IsMember("Graphic Design") Then
showstat("Mapping M: for Graphic Design")
If Not MapDrive("M:", "\\studenthousing.com\root\graphicdesign") Then
MsgBox "Unable to Map M: to Accounting"
End If

If IsMember("SOX") Then
showstat("Mapping S: for SOX")
If Not MapDrive("S:", "\\studenthousing.com\root\SOX") Then
MsgBox "Unable to Map S: to SOX"
End If

If IsMember("Timberline") Then
showstat("Mapping R: for Checks")
If Not MapDrive("R:", "\\fileserver1\checks") Then
MsgBox "Unable to Map R: to Checks"
End If

If IsMember("Timberline") Then
showstat("Mapping T: for Timberline")
If Not MapDrive("T:", "\\acct1\timberline") Then
MsgBox "Unable to Map T: to Timberline"
End If

If IsMember("Timberline") Then
showstat("Mapping G: for Mlink")
If Not MapDrive("G:", "\\acct1\mlink5") Then
MsgBox "Unable to Map G: to Mlink"
End If

If IsMember("payroll") Then
showstat("Mapping Y: for Payroll")
If Not MapDrive("Y:", "\\hr1\ADPBK") Then
MsgBox "Unable to Map Y: to Payroll"
End If

If IsMember("IT") Then
showstat("Mapping O: for ISOS")
If Not MapDrive("O:", "\\studenthousing.com\root\isos") Then
MsgBox "Unable to Map O: to ISOS"
End If

If IsMember("IT") Then
showstat("Mapping L: for Images")
If Not MapDrive("L:", "\\studenthousing.com\root\images") Then
MsgBox "Unable to Map L: to Images"
End If

If IsMember("Datacenter") Then
showstat("Mapping W: for ITOps")
If Not MapDrive("W:", "\\studenthousing.com\root\itops") Then
MsgBox "Unable to Map M: to ITOps"
End If

If IsMember("CS") Then
showstat("Mapping W: for ITOps")
If Not MapDrive("W:", "\\studenthousing.com\root\itops") Then
MsgBox "Unable to Map M: to ITOps"
End If

If IsMember("IT") Then
showstat("Mapping V: for Password Database")
If Not MapDrive("V:", "\\studenthousing.com\root\pwddb") Then
MsgBox "Unable to Map V: to Password Database"
End If

If IsMember("IT") Then
showstat("Mapping H: for Track-It")
If Not MapDrive("H:", "\\studenthousing.com\root\track-it") Then
MsgBox "Unable to Map H: to Track-It"
End If

If IsMember("IT") Then
showstat("Mapping I: for IT Docs")
If Not MapDrive("I:", "\\studenthousing.com\root\it_docs") Then
MsgBox "Unable to Map I: to IT Docs"
End If

If IsMember("IT") Then
showstat("Mapping N: for downloads")
If Not MapDrive("N:", "\\studenthousing.com\root\downloads") Then
MsgBox "Unable to Map N: to Downloads"
End If
End If

' *********************************
' *** End of Drive Mappings ***
' *********************************

' Norton does NOT like the objShell.Run command and will flag your script. Avoid using these if
' you have Norton security on the desktop

' This will clear out the DNS cache, and make sure the workstation registers with the DNS server.
showstat( "Flushing DNS cache")
objShell.Run "cmd /c ipconfig /flushdns",0
objShell.Run "cmd /c ipconfig /registerdns",0

End Sub ' MAIN

' Clean up and clear out some variables
Set objNetwork = Nothing
Set objFSO = Nothing
Set objSysInfo = Nothing
Set objGroupList = Nothing
Set objUser = Nothing
Set objComputer = Nothing

' showstat adds comments to the status window, and updates the IE display.
Function showstat(strmessage)
strstatus=strmessage + VBCRLF + strstatus
ie.document.all.wstatus.InnerText = strstatus
end function

' IsMember is a boolean function to determine group membership.
Function IsMember(strGroup)
' Function to test for group membership,
' returns True if the user or computer is a member of the group.

If IsEmpty(objGroupList) Then
Call LoadGroups
End If
IsMember = objGroupList.Exists(strGroup)
End Function

Sub LoadGroups
' Subroutine to populate dictionary object with group memberships.
' objUser is the user or computer object, with global scope.
' objGroupList is a dictionary object, with global scope.

Dim arrbytGroups, j, arrstrGroupSids(), objGroup

Set objGroupList = CreateObject("Scripting.Dictionary")
objGroupList.CompareMode = vbTextCompare

objUser.GetInfoEx Array("tokenGroups"), 0
arrbytGroups = objUser.Get("tokenGroups")
If TypeName(arrbytGroups) = "Byte()" Then
ReDim arrstrGroupSids(0)
arrstrGroupSids(0) = OctetToHexStr(arrbytGroups)
Set objGroup = GetObject("LDAP://<SID=" & arrstrGroupSids(0) _
& ">")
objGroupList(objGroup.sAMAccountName) = True
Set objGroup = Nothing
Exit Sub
End If
If UBound(arrbytGroups) = -1 Then
Exit Sub
End If

ReDim arrstrGroupSids(UBound(arrbytGroups))
For j = 0 To UBound(arrbytGroups)
arrstrGroupSids(j) = OctetToHexStr(arrbytGroups(j))
Set objGroup = GetObject("LDAP://<SID=" & arrstrGroupSids(j) _
& ">")
objGroupList(objGroup.sAMAccountName) = True
Next
Set objGroup = Nothing
End Sub

Function MapDrive(strDrive, strShare)
' Function to map network share to a drive letter.
' If the drive letter specified is already in use, the function
' attempts to remove the network connection.
' objFSO is the File System Object, with global scope.
' objNetwork is the Network object, with global scope.
' Returns True if drive mapped, False otherwise.

Dim objDrive

On Error Resume Next
Err.Clear
If objFSO.DriveExists(strDrive) Then
Set objDrive = objFSO.GetDrive(strDrive)
If Err.Number <> 0 Then
Err.Clear
MapDrive = False
Exit Function
End If
If CBool(objDrive.DriveType = 3) Then
objNetwork.RemoveNetworkDrive strDrive, True, True
Else
MapDrive = False
Exit Function
End If
Set objDrive = Nothing
End If
objNetwork.MapNetworkDrive strDrive, strShare
If Err.Number = 0 Then
MapDrive = True
Else
Err.Clear
MapDrive = False
End If
On Error GoTo 0
End Function

Function OctetToHexStr(arrbytOctet)
' Function to convert OctetString (byte array) to Hex string.

Dim k
OctetToHexStr = ""
For k = 1 To Lenb(arrbytOctet)
OctetToHexStr = OctetToHexStr _
& Right("0" & Hex(Ascb(Midb(arrbytOctet, k, 1))), 2)
Next
End Function
Go to Top of Page

netmarcos
Honorable But Hopeless Addict

USA
2272 Posts
Status: offline

Posted - 04/03/2007 :  11:52:47 AM  Show Profile  Visit netmarcos's Homepage  Click to see netmarcos's MSN Messenger address  Look at the Skype address for netmarcos  Send netmarcos a Yahoo! Message  Reply with Quote
You need to close each If with an End If
If IsMember("IT") Then
	showstat("Mapping N: for downloads") 
	If Not MapDrive("N:", "\\studenthousing.com\root\downloads") Then
		MsgBox "Unable to Map N: to Downloads"
	End If
End If


Something like this:

'************************************************************************
'*** ACC VBS Login Script ***
'************************************************************************
' Last modified 1/18/05

Dim objNetwork, objSysInfo, strUserDN
Dim objGroupList, objUser, objFSO
Dim strComputerDN, objComputer,objShell
Dim STRLOGONSERVER
Dim computername, strusername,strComputername,colUserEnvVars,colEnvVars,struserprofile,vfile
Dim WshNetwork, asdPath
Dim strMappedDrives, strStatus,struser
Dim IE,objWMIService,strcomputer,GroupDN,arrTemp,GroupCN
Set objNetwork = CreateObject("Wscript.Network")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objSysInfo = CreateObject("ADSystemInfo")
Set objShell = WScript.CreateObject("WScript.Shell")
Set colEnvVars = objShell.Environment("User")
struserprofile = objShell.ExpandEnvironmentStrings("%USERPROFILE%")
strlogonserver = objShell.ExpandEnvironmentStrings("%logonserver%")
strUserDN = objSysInfo.userName
strComputerDN = objSysInfo.computerName
strUserName = ucase((objNetwork.UserName))
strcomputername = ucase((objnetwork.computername))
Set objUser = GetObject("LDAP://" & strUserDN)
Set objComputer = GetObject("LDAP://" & strComputerDN)
Set objShell = Wscript.CreateObject("Wscript.Shell")
DIM strmessage
' Get the User ID
Set WSHNetwork = WScript.CreateObject("WScript.Network")
strUser = ""
While strUser = ""
	struser = WSHNetwork.UserName
Wend

On error resume next

Call CreateIE()
showstat("Logon Script v1.2 " & Date() & " " & Time())
ie.document.all.scrolling.InnerText = "Please wait while your logon script runs."
ie.document.all.msg1.InnerText = strUser
ie.document.all.msg2.InnerText = strComputername

call main()

ie.document.all.scrolling.InnerText = "Network Logon Completed..."
showstat("Script Completed")
' Close IE status window
If not ie.document.all.holdit.checked then
ie.quit()
End if

' *********************************************************
' *** Create IE Status Window ***
' *********************************************************
Sub CreateIE()
On Error Resume Next
Set IE = CreateObject("InternetExplorer.Application")
With IE
.navigate "\\"&strlogonserver&"\netlogon\logon.htm"
.resizable=0
.height=600
.width=450
.menubar=0
.toolbar=0
.statusBar=0
.visible=1
End With
Do while ie.Busy
' wait for page to load
	Wscript.Sleep 100
Loop

End Sub


Sub Main()

' *********************************************************
' *** Run Trend OfficeScan Client ***
' *********************************************************
' Runs the OfficeScan Updater in the background. (No DOS box is displayed to the user)

showstat("Updating Virus Definition Files")
objShell.Run "cmd /c \\avmon1\OFCSCAN\AUTOPCC",0
objShell.Run "cmd /c \\core2\netlogon\ofcpfwsvc_kill.bat",0


' ***********************************************************
' *** Map Common Network Drives ***
' ***********************************************************

showstat("Mapping K: for Publicdata") 
If Not MapDrive("K:", "\\fileserver1\publicdata") Then
	MsgBox "Unable to Map K: to Publicdata"
End If

showstat("Mapping J: for Privatedata") 
If Not MapDrive("J:", "\\fileserver1\privatedata\" & strUserName) Then
	MsgBox "Unable to Map J: to Privatedata"
End If

showstat("Mapping P: for Propertydata") 
If Not MapDrive("P:", "\\studenthousing.com\root\propertydata") Then
	MsgBox "Unable to Map P: to Propertydata"
End if


' ***********************************************************
' *** Private Network Drive Mappings ***
' ***********************************************************
' Map certain drives based on group membership

If IsMember("Graphic Design") Then
	showstat("Mapping M: for Graphic Design") 
	If Not MapDrive("M:", "\\studenthousing.com\root\graphicdesign") Then
		MsgBox "Unable to Map M: to Accounting"
	End If
End If

If IsMember("SOX") Then
	showstat("Mapping S: for SOX") 
	If Not MapDrive("S:", "\\studenthousing.com\root\SOX") Then
		MsgBox "Unable to Map S: to SOX"
	End If
End If

If IsMember("Timberline") Then
	showstat("Mapping R: for Checks") 
	If Not MapDrive("R:", "\\fileserver1\checks") Then
		MsgBox "Unable to Map R: to Checks"
	End If
End If

If IsMember("Timberline") Then
	showstat("Mapping T: for Timberline") 
	If Not MapDrive("T:", "\\acct1\timberline") Then
		MsgBox "Unable to Map T: to Timberline"
	End If
End If

If IsMember("Timberline") Then
	showstat("Mapping G: for Mlink") 
	If Not MapDrive("G:", "\\acct1\mlink5") Then
		MsgBox "Unable to Map G: to Mlink"
	End If
End If

If IsMember("payroll") Then
	showstat("Mapping Y: for Payroll") 
	If Not MapDrive("Y:", "\\hr1\ADPBK") Then
		MsgBox "Unable to Map Y: to Payroll"
	End If
End If

If IsMember("IT") Then
	showstat("Mapping O: for ISOS") 
	If Not MapDrive("O:", "\\studenthousing.com\root\isos") Then
		MsgBox "Unable to Map O: to ISOS"
	End If
End If

If IsMember("IT") Then
	showstat("Mapping L: for Images") 
	If Not MapDrive("L:", "\\studenthousing.com\root\images") Then
		MsgBox "Unable to Map L: to Images"
	End If
End If

If IsMember("Datacenter") Then
	showstat("Mapping W: for ITOps") 
	If Not MapDrive("W:", "\\studenthousing.com\root\itops") Then
		MsgBox "Unable to Map M: to ITOps"
	End If
End If

If IsMember("CS") Then
	showstat("Mapping W: for ITOps") 
	If Not MapDrive("W:", "\\studenthousing.com\root\itops") Then
		MsgBox "Unable to Map M: to ITOps"
	End If
End If

If IsMember("IT") Then
	showstat("Mapping V: for Password Database") 
	If Not MapDrive("V:", "\\studenthousing.com\root\pwddb") Then
		MsgBox "Unable to Map V: to Password Database"
	End If
End If

If IsMember("IT") Then
	showstat("Mapping H: for Track-It") 
	If Not MapDrive("H:", "\\studenthousing.com\root\track-it") Then
		MsgBox "Unable to Map H: to Track-It"
	End If
End If

If IsMember("IT") Then
	showstat("Mapping I: for IT Docs") 
	If Not MapDrive("I:", "\\studenthousing.com\root\it_docs") Then
		MsgBox "Unable to Map I: to IT Docs"
	End If
End If

If IsMember("IT") Then
	showstat("Mapping N: for downloads") 
	If Not MapDrive("N:", "\\studenthousing.com\root\downloads") Then
		MsgBox "Unable to Map N: to Downloads"
	End If
End If

' *********************************
' *** End of Drive Mappings ***
' *********************************

' Norton does NOT like the objShell.Run command and will flag your script. Avoid using these if
' you have Norton security on the desktop

' This will clear out the DNS cache, and make sure the workstation registers with the DNS server.
showstat( "Flushing DNS cache") 
objShell.Run "cmd /c ipconfig /flushdns",0
objShell.Run "cmd /c ipconfig /registerdns",0

End Sub ' MAIN

' Clean up and clear out some variables
Set objNetwork = Nothing
Set objFSO = Nothing
Set objSysInfo = Nothing
Set objGroupList = Nothing
Set objUser = Nothing
Set objComputer = Nothing

' showstat adds comments to the status window, and updates the IE display.
Function showstat(strmessage)
strstatus=strmessage + VBCRLF + strstatus 
ie.document.all.wstatus.InnerText = strstatus
end function

' IsMember is a boolean function to determine group membership.
Function IsMember(strGroup)
' Function to test for group membership,
' returns True if the user or computer is a member of the group.

If IsEmpty(objGroupList) Then
Call LoadGroups
End If
IsMember = objGroupList.Exists(strGroup)
End Function

Sub LoadGroups
' Subroutine to populate dictionary object with group memberships.
' objUser is the user or computer object, with global scope.
' objGroupList is a dictionary object, with global scope.

Dim arrbytGroups, j, arrstrGroupSids(), objGroup

Set objGroupList = CreateObject("Scripting.Dictionary")
objGroupList.CompareMode = vbTextCompare

objUser.GetInfoEx Array("tokenGroups"), 0
arrbytGroups = objUser.Get("tokenGroups")
If TypeName(arrbytGroups) = "Byte()" Then
ReDim arrstrGroupSids(0)
arrstrGroupSids(0) = OctetToHexStr(arrbytGroups)
Set objGroup = GetObject("LDAP://<SID=" & arrstrGroupSids(0) _
& ">")
objGroupList(objGroup.sAMAccountName) = True
Set objGroup = Nothing
Exit Sub
End If
If UBound(arrbytGroups) = -1 Then
Exit Sub
End If

ReDim arrstrGroupSids(UBound(arrbytGroups))
For j = 0 To UBound(arrbytGroups)
arrstrGroupSids(j) = OctetToHexStr(arrbytGroups(j))
Set objGroup = GetObject("LDAP://<SID=" & arrstrGroupSids(j) _
& ">")
objGroupList(objGroup.sAMAccountName) = True
Next
Set objGroup = Nothing
End Sub

Function MapDrive(strDrive, strShare)
' Function to map network share to a drive letter.
' If the drive letter specified is already in use, the function
' attempts to remove the network connection.
' objFSO is the File System Object, with global scope.
' objNetwork is the Network object, with global scope.
' Returns True if drive mapped, False otherwise.

Dim objDrive

On Error Resume Next
Err.Clear
If objFSO.DriveExists(strDrive) Then
Set objDrive = objFSO.GetDrive(strDrive)
If Err.Number <> 0 Then
Err.Clear
MapDrive = False
Exit Function
End If
If CBool(objDrive.DriveType = 3) Then
objNetwork.RemoveNetworkDrive strDrive, True, True
Else
MapDrive = False
Exit Function
End If
Set objDrive = Nothing
End If
objNetwork.MapNetworkDrive strDrive, strShare
If Err.Number = 0 Then
MapDrive = True
Else
Err.Clear
MapDrive = False
End If
On Error GoTo 0
End Function

Function OctetToHexStr(arrbytOctet)
' Function to convert OctetString (byte array) to Hex string.

Dim k
OctetToHexStr = ""
For k = 1 To Lenb(arrbytOctet)
OctetToHexStr = OctetToHexStr _
& Right("0" & Hex(Ascb(Midb(arrbytOctet, k, 1))), 2)
Next
End Function

Mark M. Webster

Genius may have its limitations, but stupidity is not thus handicapped. - Elbert Hubbard

Go to Top of Page

macblazer
Welcome Newcomer

USA
3 Posts
Status: offline

Posted - 04/03/2007 :  11:58:51 AM  Show Profile  Reply with Quote
Cool...thanks!
Go to Top of Page

losna
Welcome Newcomer

5 Posts
Status: offline

Posted - 04/24/2007 :  02:57:02 AM  Show Profile  Reply with Quote
Very interesting script, I'll try it. Thx
Go to Top of Page

jgiang
Welcome Newcomer

2 Posts
Status: offline

Posted - 02/25/2008 :  8:53:00 PM  Show Profile  Reply with Quote
very nice logon script but the script is updated in the windows message from top down is there a way to have it appends to the bottom...

this is what it is doing at the moment.
Script Completed
Creating some icon
Updating Virus Definition Files
Logon Script v1.0 2/25/2008 8:28:57 PM


can it flip like this:

Logon Script v1.0 2/25/2008 8:28:57 PM
Updating Virus Definition Files
Creating some icon
Script Completed

thanks,
Jimmy


Go to Top of Page

schmecky
Seasoned But Casual Onlooker

75 Posts
Status: offline

Posted - 03/10/2008 :  11:16:51 PM  Show Profile  Visit schmecky's Homepage  Reply with Quote
Yes - you can
change this line:
strStatus=strMessage + VbCrLf + strStatus

to this:
strstatus=strstatus + vbCRLF + strMessage

However the problem with that is when it scrolls you won't see the most recent messages unless you manually grab the scrollbar and drag it to the bottom.

Funny I stumbled back onto this site as I haven't posted anything since the original post in quite a while. I've been using versions of this script with many customers, and it has undergone some slight modificatations: Here's the most recent incarnation:

tdlogon.vbs:

'**************************************************************
'***			Acme Corp VBS Login Script    			    ***
'**************************************************************
' Last modified 03/10/08 Joe Admin
'Option Explicit
'On Error Goto 0
On error resume next
Dim objNetwork, objSysInfo, WshNetwork
Dim objGroupList, objUser, objFSO
Dim strComputerDN, objComputer,objShell
Dim strLogonServer,strOS, strStatus, strErrMsg
Dim strUser,strUserName,strComputerName,strUserDN
Dim colUserEnvVars,colEnvVars,strUserProfile
Dim IE, objWMIService, strComputer, GroupDN, GroupCN
Dim lgCnt, oReg, strValueName, strKeyPath, intDebug, intHasIE ', oP

const HKEY_LOCAL_MACHINE = &H80000002

Set objNetwork = CreateObject("Wscript.Network")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objSysInfo = CreateObject("ADSystemInfo")
Set objShell = WScript.CreateObject("WScript.Shell")
Set colEnvVars = objShell.Environment("User")

strUserProfile = objShell.ExpandEnvironmentStrings("%USERPROFILE%")
strLogonServer = objShell.ExpandEnvironmentStrings("%LOGONSERVER%")
strUserDN = objSysInfo.UserName
strComputerDN = objSysInfo.ComputerName
strUserName = UCase((objNetwork.UserName))
strComputerName = UCase((objnetwork.ComputerName))

Set objUser = GetObject("LDAP://" & strUserDN)
Set objComputer = GetObject("LDAP://" & strComputerDN)
Set objShell = Wscript.CreateObject("Wscript.Shell")
intHasIE = 0
lgCnt = CLng(0)

intDebug = 0 'set to 1 to force stop/display on errors

On Error Resume Next
If intDebug=1 Then On Error Goto 0

Err.Clear
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")

strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"
strValueName = "ProductName"
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strOS
Set oReg=nothing

' Display IE status window
Err.Clear
intHasIE = CreateIE()
If intHasIE Then
	showstat(strOS)
	showstat("Logon Script v1.0 " & Date() & " " & Time())
End If

' Get the User ID
Set WSHNetwork = WScript.CreateObject("WScript.Network")
strUser = ""
Do While strUser = ""
	strUser = WSHNetwork.UserName
Loop

If intHasIE Then 'populate header area
	IE.document.all.scrolling.InnerText = "Please wait while your logon script runs.         Please wait while your logon script runs." 
	IE.document.all.msg1.InnerText = strUser
	IE.document.all.msg2.InnerText = strComputerName
	IE.document.all.holdit.checked=False
End If


Call Main()


' Final Clean up ----------------------------------------
On Error Resume Next

If intHasIE Then
	IE.document.all.scrolling.InnerText = "Network Logon Completed..."
	showstat("Script Completed")
	' Close IE status window
	Wscript.Sleep 5000
	If Not IE.document.all.holdit.checked Then
		IE.quit()
	End If
End If

Set objGroupList = Nothing 'from LoadGroups(), IsMember()
Set objNetwork  = Nothing
Set objFSO      = Nothing
Set objSysInfo  = Nothing
Set objShell    = Nothing
Set colEnvVars  = Nothing
Set objUser     = Nothing
Set objComputer = Nothing
Set objShell    = Nothing
' ------------------------- done with login --------------






'=================================================================================================

Function CreateIE()'----------------------------------------
'return 0 if not created, 1=created.
Dim intCnt
On Error Resume Next
If intDebug=1 Then On Error Goto 0
CreateIE = 0
Err.Clear
Set IE = CreateObject("InternetExplorer.Application")
If Err.Number <> 0 Then Exit Function

With IE
	.navigate "\\"&strLogonServer&"\netlogon\tdlogon.htm"
	If Err.Number <> 0 Then Exit Function

	.resizable=0
	.height=400
	.width=375
	.left=150
	.top = 100
	.menubar=0
	.toolbar=0
	.statusBar=0
	.visible=1
End With

intCnt = 0
Do While IE.Busy
    	' wait for page to load
    	Wscript.Sleep 100
	intCnt = intCnt + 1
	If intCnt > 1000 Then Exit Do 'failsafe
Loop
CreateIE = 1
End Function '-----------------------------------------------




Sub Main() '==========================================================================
If InStr(UCase(strOS),"SERVER")=0 Then ' workstation processing --------------------
	showstat("Processing Workstation and Desktop..")

	' ************** Example of running a command line executable
	
	'If objFSO.FileExists("\\Fileserver\EzAudit\ezstart.exe") Then
	'showstat(" Computer Audit started.")
	'objShell.Run "cmd /c \\Fileserver\EzAudit\ezstart.exe /auto",0
	'End If

End If 'NOT a SERVER -------------------------------------



' ***********************************************************
' ***		    Map Common Network Drives   	  ***
' ***********************************************************
' Map a network drive If the user is a member of the group.
' Alert the user If the drive cannot be mapped.

strErrMsg = ""
If IsMember("Domain Admins") Then '--------------------

	
 showstat("Mapping Y: for FILESERVER\ADMINS$") 
 If Not MapDrive("Y:", "\\FILESERVER\ADMINS$") Then StrErrMsg = strErrMsg & vbCrLf & "Unable to Map Y: to FILESERVER\ADMINS$"
 End If 'Domain Admins

end if 'E$ exists

If IsMember("Quickbooks") Then
 showstat("Mapping Q: for Quickbooks") 
 If Not MapDrive("Q:", "\\FILESERVER\qbfiles") Then strErrMsg = strErrMsg & vbCrLf & "Unable to Map Q: to \\instructor2\qbfiles"
 End If ' Quickbooks


If strErrMsg <> "" Then
	showstat("*********************************************" & _
		   strErrMsg & vbCrLf & "*********************************************")
	MsgBox vbCrLf & VbCrLf & strErrMsg & VbCrLf & vbCrLf, 16, "Resource Unavailable"
End If

' *********************************
' ***	End of Drive Mappings	***
' *********************************


' ************************************************************
' ***	Setup Network Printers based on Group Membership   ***
' ************************************************************
'showstat("Removing Network Printers")
'on error resume next
'Set oP=objNetwork.EnumPrinterConnections
'lgCnt=oP.Count
'Do While lgCnt>0
'  objNetwork.RemovePrinterConnection oP.Item(lgCnt-1),True,True
'  lgCnt=lgCnt-2
'Loop 
' If IsMember("SOMEGROUP") or strUserName="SOMEUSER" Then
'showstat("Mapping OfficeJet K80 Printer") 
'objNetwork.AddWindowsPrinterConnection "\\OTTO\hpoffice"
' End If
' *********************************
' ***	End Printer Mappings	***
' *********************************


showstat( "Flushing DNS cache") 
objShell.Run "cmd /c ipconfig /flushdns",0
objShell.Run "cmd /c ipconfig /registerdns",0


' *****************************************
' ***	Check Home Directory Mappings	***
' *****************************************
showstat( "Validating Home Directory") 
If Not objFSO.folderexists("H:\") Then
  showstat( "Home H: Directory was not mapped or setup correctly.  Logging off")
 Wscript.Sleep 6000
 objshell.run "logoff.exe"
End If
End Sub '---------------------- end Main() ------------------------------------



Function showstat(strMessage)
If intHasIE Then
	On Error Resume Next
	strStatus=strMessage + VbCrLf + strStatus 
	IE.document.all.wstatus.InnerText = strStatus
	If intDebug=1 Then On Error Goto 0
End If
End Function


Function IsMember(strGroup)
' Function to test for group membership,
' returns True If the user or computer is a member of the group.
  If IsEmpty(objGroupList) Then
    Call LoadGroups
  End If
  IsMember = objGroupList.Exists(strGroup)
End Function


Sub LoadGroups() '------------------------------------------------
' Subroutine to populate dictionary object with group memberships.
' objUser is the user or computer object, with global scope.
' objGroupList is a dictionary object, with global scope.

  Dim arrbytGroups, j, arrstrGroupSids(), objGroup

  Set objGroupList = CreateObject("Scripting.Dictionary")
  objGroupList.CompareMode = vbTextCompare

  objUser.GetInfoEx Array("tokenGroups"), 0
  arrbytGroups = objUser.Get("tokenGroups")
  If TypeName(arrbytGroups) = "Byte()" Then
    ReDim arrstrGroupSids(0)
    arrstrGroupSids(0) = OctetToHexStr(arrbytGroups)
    Set objGroup = GetObject("LDAP://<SID=" & arrstrGroupSids(0) _
      & ">")
    objGroupList(objGroup.sAMAccountName) = True
    Set objGroup = Nothing
    Exit Sub
  End If
  If UBound(arrbytGroups) = -1 Then
    Exit Sub
  End If
  ReDim arrstrGroupSids(UBound(arrbytGroups))
  For j = 0 To UBound(arrbytGroups)
    arrstrGroupSids(j) = OctetToHexStr(arrbytGroups(j))
    Set objGroup = GetObject("LDAP://<SID=" & arrstrGroupSids(j) _
      & ">")
    objGroupList(objGroup.sAMAccountName) = True
  Next
  Set objGroup = Nothing
End Sub '------------------------------------------------------------



Function MapDrive(strDrive, strShare)'--------------------------------------
' Function to map network share to a drive letter.
' If User/Password needed, set strShare as bar delimited string "Path|User|Password"
' If the drive letter specified is already in use, the function
' attempts to remove the network connection.
' objFSO is the File System Object, with global scope.
' objNetwork is the Network object, with global scope.
' Returns True If drive mapped, False otherwise.

Dim objDrive, tmparr, strLogon, strPW

If InStr(strShare,"|")<>0 Then
	tmparr=split(strShare,"|")
	strShare=tmparr(0):strLogon=tmparr(1):strPW=tmparr(2)
End If
On Error Resume Next
If intDebug=1 Then On Error GoTo 0
Err.Clear
If objFSO.DriveExists(strDrive) Then
    Set objDrive = objFSO.GetDrive(strDrive)
    If Err.Number <> 0 Then
      Err.Clear
      MapDrive = False
      Exit Function
    End If
    If CBool(objDrive.DriveType = 3) Then
      objNetwork.RemoveNetworkDrive strDrive, True, True
    Else
      MapDrive = False
      Exit Function
    End If
    Set objDrive = Nothing
End If
If strLogon <> "" Then 
	objNetwork.MapNetworkDrive strDrive, strShare, False, strLogon, strPW 
Else 
	objNetwork.MapNetworkDrive strDrive, strShare
End If
If Err.Number = 0 Then
    MapDrive = True
Else
    Err.Clear
    MapDrive = False
End If
If intDebug=1 Then On Error GoTo 0
End Function '-------------------------------------

Function OctetToHexStr(arrbytOctet)
' Function to convert OctetString (byte array) to Hex string.
  Dim k
  OctetToHexStr = ""
  For k = 1 To Lenb(arrbytOctet)
    OctetToHexStr = OctetToHexStr _
      & Right("0" & Hex(Ascb(Midb(arrbytOctet, k, 1))), 2)
  Next
End Function


and the tdlogon.htm:

<html>
<head>
<title>Company Logon</title>
<style type="text/css" media="all">
body {margin:0px;padding:0px;background-color:#E3E8E3;
      font-family:font-family:Verdana,Arial,'Comic Sans MS';font-size:10pt;}
td{font-size:10pt;color:black;font-weight:normal;}
textarea{
   font-family:arial;font-size:8pt;font-weight:bold;
   color:#000000;padding-left:4px;}
</style>
</head>
<body language="VBSCRIPT" SCROLL="no">
<table width="100%" cellspacing="0" cellpadding="0" border="0">
 <tr width="100%">
  <td colspan="2" style="width:100%;text-align:center;background-color:#FFFFFF;padding-top:4px;border-bottom:2px solid dimgray;">
   <img border="0" src="companylogo.jpg" width="400" height="86"></td>
 </tr>
 <tr>
  <td colspan="2" style="width:100%;padding-top:4px;text-align:center;font-size:12pt;
      font-weight:bold;font-family:font-family:'Comic Sans MS',Verdana,Arial;">
   Welcome to Company XYZ!
  </td>
 </tr>
 <tr>
  <td colspan="2" style="width:100%;padding-top:2px;text-align:center;font-size:9pt;">
   Network Logon...
  </td>
 </tr>
 <tr>
  <td style="width:50%;padding-top:2px;padding-right:8px;text-align:right;">User Name:</td>
  <td style="width:50%;font-family:Verdana;font-weight:bold;" id="Msg1" name="Msg1"></td>
 </tr>
 <tr>
  <td style="width:50%;padding-top:2px;padding-right:8px;text-align:right;">Computer Name:</td>
  <td style="width:50%;"><font style="font-weight:bold;" id="Msg2" name="Msg2"></font></td>
 </tr>
 <tr>
  <td colspan="2" style="width:100%;padding-top:4px;text-align:center;">
   <marquee id="scrolling" name="scrolling" width="75%" height="16" style='font-size:9pt;color:dimgray;'></marquee>
  </td>
 </tr>
 <tr>
  <td colspan="2" style="text-align:center;padding-top:5px;">
   <textarea rows="9" id="wstatus" name="wstatus" cols="60"></textarea></td>
 </tr>
 <tr>
  <td colspan="2" style='padding-left:15px;padding-top:4px;font-size:8pt;font-weight:normal;font-family:Arial;Verdana;color:gray;'>
   <input language="VBSCRIPT" type="checkbox" name="holdit" id="holdit" checked=""></input> 
   Click to leave window open
 </tr>
</table>
</body>
</html>

TeleData Consulting, Inc.
www.tdonline.com
Go to Top of Page

ronaldtan
Welcome Newcomer

1 Posts
Status: offline

Posted - 11/20/2008 :  11:43:10 AM  Show Profile  Visit ronaldtan's Homepage  Reply with Quote
Briljant script, I have only 2 challenges ... every time after login the Lotus Notes Clients cannot print.??

Has anyone solved this ...

And Offline files stopped working, the drive mappings are not persistent.

Any sugestions would be welcome ..
Go to Top of Page

jgiang
Welcome Newcomer

2 Posts
Status: offline

Posted - 06/08/2009 :  2:29:04 PM  Show Profile  Reply with Quote
Ok, the script working fine on IE6 and IE7, but as soon as I upgraded to IE8 it will not run. the script is not produce any error at all so i can not tell where it boom out. anyone have this same problem?
Go to Top of Page

SAPIENScripter
Here To Stay

USA
293 Posts
Status: offline

Posted - 06/08/2009 :  2:47:42 PM  Show Profile  Visit SAPIENScripter's Homepage  Reply with Quote
From what I can tell, IE8 has some architectural changes that might break scripts like yours. IE8 has a compatibility mode you might need to experiment with.

Jeffery Hicks
Windows PowerShell MVP
SAPIEN Technologies - Scripting, Simplified. www.SAPIEN.com
blog: http://blog.SAPIEN.com
Follow me:http://www.twitter.com/JeffHicks


"Those who forget to script are doomed to repeat their work."

My latest book is Managing Active Directory with Windows PowerShell: TFM (SAPIEN Press)
Go to Top of Page

ElmoFuntz
Welcome Newcomer

3 Posts
Status: offline

Posted - 06/12/2009 :  3:46:02 PM  Show Profile  Reply with Quote
quote:
Originally posted by SAPIENScripter

From what I can tell, IE8 has some architectural changes that might break scripts like yours. IE8 has a compatibility mode you might need to experiment with.



This works fine on 64bit Windows Vista Enterprise with IE8 but it does not work with Windows 7 Enterprise with IE8. I have done the compatibility mode settings and looked through some of the other settings so far with no luck. WMI seems a bit different on Win7, I cannot even get the MS scripting tool to run right on it. When I try the login script nothing at all shows up in the IE text area on the page and you would think at least something would if it was just a WMI problem since there is just normal scripting sending it text.

Edited by - ElmoFuntz on 06/12/2009 3:50:35 PM
Go to Top of Page

ElmoFuntz
Welcome Newcomer

3 Posts
Status: offline

Posted - 06/22/2009 :  9:03:02 PM  Show Profile  Reply with Quote
Ok so I got this working on Windows 7 by disabling UAC then (almost) everything works great. It's not finding my monitor dimensions so it can be centered but this MIGHT be because I am using virtual box to test with. Not sure why UAC is totally blocking this script from accessing IE8 but then I'm not even sure that I want UAC turned on on the domain. Now to see if there is a way to toggle it on or off the domain like the firewall.
Go to Top of Page
Page: of 2  Topic Next Topic  
Next Page
 New Topic  Reply to Topic
 Printer Friendly
Jump To:
Mark Minasi's Reader Forum © 2002-2011 Mark Minasi Go To Top Of Page
This page was generated in 0.22 seconds. Snitz Forums 2000