| Author |
 Topic  |
|
kasethi
Welcome Newcomer
1 Posts
Status: offline |
 Posted - 02/05/2010 : 12:16:15 PM
|
Hi,
Can some one help me with my logon script. I am testing the following VB script, map network drive based on group membership is not working and map Common network drives are mapping fine.
Could some one have a look into my code and help me to sort out this issue. My test user is right group and have access to the folder.
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 10000
Loop
End Sub
Sub Main()
' ***********************************************************
' *** Map Common Network Drives ***
' ***********************************************************
showstat("Mapping Z: for test")
If Not MapDrive("Z:", "\\server.domain.local\test") Then
MsgBox "Unable to Map Z: to test"
End If
showstat("Mapping X: for Test1")
If Not MapDrive("X:", "\\kssfil01.kssdesign.local\test1") Then
MsgBox "Unable to Map X: to test1"
End If
' ***********************************************************
' *** Private Network Drive Mappings ***
' ***********************************************************
' Map certain drives based on group membership
If IsMember("Sec_Directors") Then
showstat("Mapping J: for Confidential")
If Not MapDrive("J:", "\\server.domain.local\Confidential") Then
MsgBox "Unable to Map J: to Confidential"
End If
End If
If IsMember("Sec_Marketing") Then
'showstat("Mapping M: for Marketing")
If Not MapDrive("M:", "\\server.domain.local\Marketing") Then
MsgBox "Unable to Map M: to Marketing"
End If
End If
' *********************************
' *** End of Drive Mappings ***
' *********************************
' ************************************************************
' *** Setup Network Printers based on Group Membership ***
' ************************************************************
' 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
|
 |
|
|
ElmoFuntz
Welcome Newcomer
3 Posts
Status: offline |
Posted - 02/05/2010 : 2:54:05 PM
|
My first guess is this is going to be a permissions thing since the map common drives works. It may also not be seeing the group membership correctly. Have you tried stepping through the script or putting in some debug output to see what it sees for their groups? Your mapdrive function is slightly different than mine but not much. I will paste it below just incase you want to try it.
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 '-------------------------------------
|
|
|
|
eoh7678
Welcome Newcomer
1 Posts
Status: offline |
Posted - 11/06/2012 : 10:45:16 PM
|
Hello!!
Just want to say that I LOVE this script and have used it for years!!
I made the (dubious?) decision to install Windows 8 today, and am having some trouble.
Not sure if it's IE 10, or something in Windows 8, but this script won't run at all.
It just hangs with the IE window open doing nothing. When I try to run it manually, it flashes up for a second, then disappears.
It doesn't write anything at all to the log file.
Any ideas? |
|
|
|
Topic |
|
|
|
VBS & IE Logon Script:
