VBS-script til mapning af netværksdrev på server
Jeg har et problem med et loginscript som ellers virker fint.Når brugeren taster forkert brugernavn eller password kommer der en fejl istedet for at gentage login-proceduren. Jeg har en loginbox som ser således ud.
Function PasswordBox(sPrompt, sDefault)
set oSH = CreateObject("Wscript.Shell")
set oIE = CreateObject("InternetExplorer.Application")
With oIE
.RegisterAsDropTarget = False
.Resizable = False : .FullScreen = True
.width = 400 : .height = 200
.Navigate "about:blank"
Do Until .ReadyState = 4 : WScript.Sleep 100 : Loop
.document.open
.document.write _
"<html><head><" & "script>bboxwait=true;</" _
& "script><title>Netværkslogin</title></head>"_
& "<body style='background-color: #F0F0E2;' scroll=no language=vbs" _
& " style='border-Style:outset;border-Width:3px'" _
& " style='border-Style:outset;border-Width:3px'" _
& " onContextmenu='window.event.cancelbubble=true" _
& ":window.event.returnvalue=false'" _
& " onhelp='window.event.keycode=0" _
& ":window.event.cancelbubble=true" _
& ":window.event.returnvalue=false'" _
& " onkeydown='if ((window.event.keycode>111) and "_
& " (window.event.keycode<117)) or" _
& " window.event.ctrlkey then" _
& " window.event.keycode=0" _
& ":window.event.cancelbubble=true" _
& ":window.event.returnvalue=false'" _
& " onkeypress='if window.event.keycode=13 then" _
& " bboxwait=false'><center>" _
& "<table><tr><td> <b>Brugernavn:</b></td><td>" _
& "<input type=text id=user value=''>" _
& "</td><tr><td> <b>Adgangskode:</b></td><td>" _
& "<input type=password id=pass size=22></td></tr></table><br>" _
& "<button onclick='bboxwait=false;'> Login </button>" _
& "</center></body></html>"
.document.close
Do Until .ReadyState = 4 : WScript.Sleep 100 : Loop
With .document
oIE.left = .parentWindow.screen.width \ 2 - 200
oIE.top = .parentWindow.screen.height\ 2 - 100
.all.user.focus
.all.user.select ' Optional
PasswordBox = Array("CANCELLED")
On Error Resume Next
Do While .parentWindow.bBoxWait
oSH.Appactivate "Netværkslogin"
oIE.Visible = True
if Err Then Exit Function
WScript.Sleep 100
Loop
oIE.Visible = False
PasswordBox = Split(.all.user.value _
& "|" & .all.pass.value, "|")
End With ' document
End With ' IE
End Function
Den kaldes således
input = join(passwordbox("", ""), ", ")
separator = InStr(input, ",")
brugernavn = Mid(input, 1, separator-1)
adgangskode = Mid(input, separator+2, Len(input))
Dim WSHNetwork
Set WshShell = WScript.CreateObject("WScript.Shell")
Set WSHNetwork = WScript.CreateObject("WScript.Network")
Set CheckDrive = WshNetwork.EnumNetworkDrives()
AlreadyConnected = False
Set oShell = CreateObject("WScript.shell")
'DREV
WSHNetwork.MapNetworkDrive "I:", "\\server\sti", "false", brugernavn, adgangskode
Jeg har forsøgt forskellige løsninger på at smide en while eller lign. omkring loginproceduren således at den kaldes hele tiden indtil man taster sit brugernavn og password rigtigt.
Hvordan løser man dette problem, således at den hverken afslutter eller viser fejl såfremt man taster forkert.
