Option Explicit

Dim arrPasswords, strUserName

strUserName  = "JohnDoe"
arrPasswords = IEChangePwd( strUserName )
WScript.Echo "Change password for  : " & strUserName     & vbCrLf _
           & "The old password was : " & arrPasswords(0) & vbCrLf _
           & "The new password is  : " & arrPasswords(1)

Function IEChangePwd( myUserName )
' This function uses Internet Explorer to create a login dialog.
' It won't close until all fields have valid values and the OK
' button is clicked.
'
' Arguments:  [string] user name
' Returns:    [array]  the old (0) and new (1) passwords
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
	Dim arrPwd, blnValid, objIE
	blnValid = False
	' Create an IE object
	Set objIE = CreateObject( "InternetExplorer.Application" )
	' specify some of the IE window's settings
	objIE.Navigate "about:blank"
	objIE.Document.Title = "Change password........................................"
	objIE.ToolBar        = False
	objIE.Resizable      = False
	objIE.StatusBar      = False
	objIE.Width          = 400
	objIE.Height         = 240
	' Center the dialog window on the screen
	With objIE.Document.ParentWindow.Screen
		objIE.Left = (.AvailWidth  - objIE.Width ) \ 2
		objIE.Top  = (.Availheight - objIE.Height) \ 2
	End With
	' Wait till IE is ready
	Do While objIE.Busy
		WScript.Sleep 200
	Loop
	' Insert the HTML code to prompt for user input
	objIE.Document.Body.InnerHTML = "<DIV ALIGN=""center"">" _
	                              & "<TABLE CELLSPACING=""5"">" _
	                              & "<TR NOWRAP><TH COLSPAN=""2"">" _
	                              & "Change password for " _
	                              & myUserName & ":</TH></TR>" _
	                              & "<TR NOWRAP><TD>Old password:</TD>" _
	                              & "<TD><INPUT TYPE=""password"" SIZE=""20"" " _
	                              & "ID=""OldPassword""></TD></TR>" _
	                              & "<TR NOWRAP><TD>New password:</TD>" _
	                              & "<TD><INPUT TYPE=""password"" SIZE=""20"" " _
	                              & "ID=""NewPassword""></TD></TR>" _
	                              & "<TR NOWRAP><TD>Confirm password:</TD>" _
	                              & "<TD><INPUT TYPE=""password"" SIZE=""20"" " _
	                              & "ID=""ConfirmPassword""></TD></TR>" _
	                              & "</TABLE>" _
	                              & "<P><INPUT TYPE=""hidden"" ID=""OK"" " _
	                              & "NAME=""OK"" VALUE=""0"">" _
	                              & "<INPUT TYPE=""submit"" VALUE="" OK "" " _
	                              & "OnClick=""VBScript:OK.Value=1""></P></DIV>"
	' Make the window visible
	objIE.Visible = True
	' Wait for valid input (2 non-empty equal passwords)
	Do Until blnValid = True
		' Wait till the OK button has been clicked
		Do While objIE.Document.All.OK.Value = 0
			WScript.Sleep 200
		Loop
		' Read the user input from the dialog window
		arrPwd = Array( objIE.Document.All.OldPassword.Value, _
		                objIE.Document.All.NewPassword.Value, _
		                objIE.Document.All.ConfirmPassword.Value )
		' Check if the new password and confirmed password match
		If arrPwd(1) = arrPwd(2) Then
			' Check if the new password isn't empty
			If Trim( arrPwd(1) ) = "" Then
				MsgBox "The new password cannot be empty", _
				       vbOKOnly + vbInformation + vbApplicationModal, _
				       "Type new password"
				objIE.Document.All.NewPassword.Value     = ""
				objIE.Document.All.ConfirmPassword.Value = ""
				objIE.Document.All.OK.Value              = 0
			Else
				blnValid = True
			End If
		Else
			MsgBox "The new and confirmed passwords do not match.", _
			       vbOKOnly + vbInformation + vbApplicationModal, _
			       "Retype new password"
			objIE.Document.All.NewPassword.Value     = ""
			objIE.Document.All.ConfirmPassword.Value = ""
			objIE.Document.All.OK.Value              = 0
		End If
	Loop
	' Close and release the object
	objIE.Quit
	Set objIE = Nothing
	' Return the passwords in an array
	IEChangePwd = Array( arrPwd(0), arrPwd(1) )
End Function