Issues masking a password in VB

I have written some code in VB script that does not always present the same dialog box. The attached code should prompt for a password and not allow a blank password. Then prompt to confirm that password, again not allowing a blank. Then compare the 2 and loop if they do not match, or (remarked out) change the password of the stated user (pphread).

the issue I have is that when executed I get a dialog box stating "Please enter the new password for Pphread.". I enter a password and then I should get a prompt stating "Please confirm the password for Pphread.".

Sometimes I get the confirmation prompt and sometime I get just a blank dialog box with a text box and submit button. No text stating "Please confirm the password for Pphread."

It appears to be random as to when it is correct and when it is not.

I have attached the code and a picture of the blank dialog box.

Any suggestions would be great.

Currently testing on Windows 7/64bit w/IE10, but will need to run on Windows XP SP3 32bit w/ IE9

thanks

Option Explicit 
Dim ObjFSO, user, strComputer, X, Y, Z, strPW, strPWConf, oIE, bPasswordBoxOkay, bPasswordBoxWait
strComputer = "LocalHost"
Set ObjFSO = CreateObject("Scripting.FileSystemObject") 

Set user = GetObject("WinNT://" & strComputer & "/Pphread,user") 
		REM strPW = PasswordBox("Please enter the new password for Pphread.") 
		REM strPWConf = PasswordBox("Please confirm the password for Pphread.") 

Do While X = 0
	Do While Y = 0
		strPW = PasswordBox("Please enter the new password for Pphread.") 
		If strPW = "" Then
			Wscript.Echo "You must enter a password."
		Else
			Exit Do
		End If
	Loop

	Do While Z = 0
		strPWConf = PasswordBox("Please confirm the password for Pphread.") 
		If strPWConf = "" Then
			Wscript.Echo "You must confirm the password."
		Else
			Exit Do
		End If
	Loop

	If strPW = strPWConf Then
		Wscript.Echo "Passwords Match."
		Exit Do
	Else
		Wscript.Echo "The Passwords do not match, Please Re-enter."
	End If
Loop
	REM If strPW = "" Then
		REM Wscript.Echo "Blank Passwords are note allowed."
		REM WScript.Quit 1
	REM End If

	REM If strPW = strPWConf Then
		REM Wscript.Echo "Passwords Match."
	REM Else
		REM Wscript.Echo "The Passwords do not match, Please Re-enter."
		REM WScript.Quit 1
	REM End If
	
Wscript.Echo "test"
REM user.setpassword strPW
REM user.setinfo 


Function PasswordBox(sTitle) 
  set oIE = CreateObject("InternetExplorer.Application") 
  With oIE 
    .FullScreen = False 
    .ToolBar   = False : .RegisterAsDropTarget = False 
    .StatusBar = False : .Navigate("about:blank") 
    While .Busy : WScript.Sleep 200 : Wend 
    With .document 
      With .ParentWindow 
        .resizeto 500,100 
        .moveto .screen.width/2-200, .screen.height/2-50 
      End With 
      .WriteLn("<html><body bgColor=Silver><center>") 
      .WriteLn( sTitle ) 
      .WriteLn("<input type=password id=pass>  " & _ 
               "<button id=but0>Submit</button>") 
      .WriteLn("</center></body></html>") 
      With .ParentWindow.document.body 
        .scroll="no" 
        .style.borderStyle = "outset" 
        .style.borderWidth = "3px" 
      End With 
      .all.but0.onclick = getref("PasswordBox_Submit") 
      .all.pass.focus 
      oIE.Visible = True 
      bPasswordBoxOkay = False : bPasswordBoxWait = True 
      On Error Resume Next 
      While bPasswordBoxWait 
        WScript.Sleep 100 
        if oIE.Visible Then bPasswordBoxWait = bPasswordBoxWait 
        if Err Then bPasswordBoxWait = False 
      Wend 
      PasswordBox = .all.pass.value 
	  .Quit
    End With ' document 
    .Visible = False 
	.Quit
  End With   ' IE 
End Function 


Sub PasswordBox_Submit() 
  bPasswordBoxWait = False 
End Sub

Open in new window

IE-blank-submit.jpg
pphreadrAsked:
Who is Participating?
 
Robert SchuttConnect With a Mentor Software EngineerCommented:
Very strange indeed. I have confirmed the behaviour on W7/64,IE10/32. It may be a bug, I haven't been able to establish the reason behind it ("F12 dev tools" shows the text is actually there but invisible) but I did find a solution I think.

It works consistently for me (with a reasonable amount of testing) after changing WriteLn to Write (only the last one I left alone) so it seems the linefeeds in between the html tags are messing with the document somehow:
      .Write("<html><body bgColor=Silver><center>") 
      .Write( sTitle ) 
      .Write("<input type=password id=pass>  " & _ 
               "<button id=but0>Submit</button>") 
      .WriteLn("</center></body></html>") 

Open in new window

It works the same as concatenating the string all into one Writeln.
      .WriteLn("<html><body bgColor=Silver><center>" & sTitle & "<input type=password id=pass>  " & "<button id=but0>Submit</button>" & "</center></body></html>") 

Open in new window

Of course you will still need to test on IE9 anyway, I haven't got that version available.
0
 
pphreadrAuthor Commented:
robert_schutt I have given you the credit seeing as you came up with the fix. Now I have to enter another question because the script does not work on Windows XP. The line:

<code>Set user = GetObject("WinNT://" & strComputer & "/" & strUser & ",user") </code>

Causes Windows XP to error with:

You were not connected because a duplicate name exists on the network. Go to Control Panel and change the computer name and try again.

I will be posting another question to see if this can be fixed. Thank s for this fix.

Pphread

The error is false as the computer name is not a duplicate.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.