Mask password in VB Script

I have the VB Script below that works great, but I really need to mask the password.  I am not a programmer at all as I found this script online, so I need just a little help to get this password masked.
 I have read a lot and tried to figure this out and it sounds like you have to make a HTML call as VB script does not support the password masking.  I found some html script but I have no idea how to make the call and then bring it back into my VB script.


strDriveToMap = "H:"
strShareToMap = "\\servername\share"
strServer = Mid(strShareToMap, 3, InStr(Mid(strShareToMap, 3), "\") - 1)

' Create the WSH Network object to map drives with
Set objNetwork = CreateObject("WScript.Network")

' Here you can explicitly enter the username and password,
' OR you can get the credentials from the user
' Explicit:
'strUsername = "DOMAINNAME\username"
'strPassword = "thepassword"
' OR from User:
strUsername = InputBox("Enter the user name to access " & strServer, "Network Username", "username@domain")
strPassword = InputBox("Enter the password for the user " & strUsername, "Network Password")

' Then construct the command to run to add those credentials.
strCommand = "cmd /c cmdkey /add:" & strServer & " /user:" & strUsername & " /pass:" & strPassword

Set objShell = CreateObject("WScript.Shell")
objShell.Run strCommand, 0, True

MsgBox strUsername & " has been added to the credentials list."

' This you may need. I have commented it out for now, but if the drive does Not
' map, try uncommenting the four lines from Set ... to Next, inclusive.
' Disconnect ALL mapped drives
'Set colDrives = objNetwork.EnumNetworkDrives
'For intDrive = 0 to colDrives.Count -1 Step 2
'`      objNetwork.RemoveNetworkDrive colDrives.Item(i), True, True
'Next

' Now map the drive
On Error Resume Next
objNetwork.MapNetworkDrive strDriveToMap, strShareToMap
If Err.Number <> 0 Then
      MsgBox "There was an error mapping " & strDriveToMap & " to " & strShareToMap & _
            VbCrLf & "Error number: " & Err.Number
      Err.Clear
      On Error GoTo 0
Else
      On Error GoTo 0
      MsgBox strDriveToMap & " has been mapped to " & strShareToMap
End If

strCommand = "cmd /c cmdkey /delete:" & strServer'
objShell.Run strCommand, 0, True

'MsgBox strReturnVal
'===================
eServAsked:
Who is Participating?
 
RobSampsonConnect With a Mentor Commented:
In that case, what you need is called a HTML Application.  These scripts have a HTA extension instead of VBS, and combine a HTML GUI with VBScirpt or JavaScript code to perform actions.

Save the code below into a file called something like
MyHTA.hta

and double-click it.

You can see in the code that I've placed your code into the procedure called
Sub RunScript

Regards,

Rob.
<head>
<title>Run Script</title>
<HTA:APPLICATION 
     APPLICATIONNAME="Map Drive"
     BORDER="thin"
     SCROLL="no"
     SINGLEINSTANCE="yes"
     WINDOWSTATE="normal"
>
</head>
 
<script language="VBScript">
 
Sub Window_onLoad
	intWidth = 400
	intHeight = 300
	Me.ResizeTo intWidth, intHeight
    Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
End Sub
 
Sub Default_Buttons
	If Window.Event.KeyCode = 13 Then
		btn_runscript.Click
	End If
End Sub
 
Sub RunScript
	If Trim(txt_username.Value) = "" Then
		MsgBox "Please enter a username."
		txt_username.Focus
	ElseIf Trim(txt_password.Value) = "" Then
		MsgBox "Please enter a password."
		txt_password.Focus
	Else
		strDriveToMap = "H:"
		strShareToMap = "\\servername\share"
		strServer = Mid(strShareToMap, 3, InStr(Mid(strShareToMap, 3), "\") - 1)
		
		' Create the WSH Network object to map drives with
		Set objNetwork = CreateObject("WScript.Network")
		
		' Here you can explicitly enter the username and password,
		' OR you can get the credentials from the user
		' Explicit:
		'strUsername = "DOMAINNAME\username"
		'strPassword = "thepassword"
		' OR from User:
		'strUsername = InputBox("Enter the user name to access " & strServer, "Network Username", "username@domain")
		'strPassword = InputBox("Enter the password for the user " & strUsername, "Network Password")
		strUsername = txt_username.Value
		strPassword = txt_password.Value
		
		' Then construct the command to run to add those credentials.
		strCommand = "cmd /c cmdkey /add:" & strServer & " /user:" & strUsername & " /pass:" & strPassword
		
		Set objShell = CreateObject("WScript.Shell")
		objShell.Run strCommand, 0, True
		
		MsgBox strUsername & " has been added to the credentials list."
		
		' This you may need. I have commented it out for now, but if the drive does Not
		' map, try uncommenting the four lines from Set ... to Next, inclusive.
		' Disconnect ALL mapped drives
		'Set colDrives = objNetwork.EnumNetworkDrives
		'For intDrive = 0 to colDrives.Count -1 Step 2
		'`      objNetwork.RemoveNetworkDrive colDrives.Item(i), True, True
		'Next
		
		' Now map the drive
		On Error Resume Next
		objNetwork.MapNetworkDrive strDriveToMap, strShareToMap
		If Err.Number <> 0 Then
		      MsgBox "There was an error mapping " & strDriveToMap & " to " & strShareToMap & _
		            VbCrLf & "Error number: " & Err.Number
		      Err.Clear
		      On Error GoTo 0
		Else
		      On Error GoTo 0
		      MsgBox strDriveToMap & " has been mapped to " & strShareToMap
		End If
		
		strCommand = "cmd /c cmdkey /delete:" & strServer'
		objShell.Run strCommand, 0, True
		
		'MsgBox strReturnVal
	End If
End Sub
 
</script>
 
<body style="background-color:#B0C4DE; font-family: arial" onkeypress='vbs:Default_Buttons'>
	<table width='90%' height = '100%' align='center' border='0'>
		<tr>
			<td align='center'>
				<h2>Run Script</h2>
			</td>
		</tr>
		<tr>
			<td>
				User Name:<br>
				<input type="text" maxlength="30" size="40" id="txt_username" name="txt_username"><br><br>
			</td>
		</tr>
		<tr>
			<td>
				Pasword:<br>
				<input type="password" maxlength="30" size="40" id="txt_password" name="txt_password"><br><br>
			</td>
		</tr>
		<tr>
			<td align='center'>
				<input type="button" value="Run Script" name="btn_runscript"  onClick="vbs:RunScript">&nbsp&nbsp&nbsp&nbsp&nbsp
				<input type="button" value="Exit" name="btn_exit"  onClick="vbs:window.close"><br><br>
			</td>
		</tr>
	</table>
 
</body>

Open in new window

0
 
RobSampsonCommented:
Hi, you can change this line:
strPassword = InputBox("Enter the password for the user " & strUsername, "Network Password")

to this
Set objPassword = CreateObject("ScriptPW.Password")
Wscript.StdOut.Write "Please enter your password: "
strPassword = objPassword.GetPassword()

but you also need to be running with CScript, not WScript.....I have added a bit at the top to force that.

Regards,

Rob.
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /c cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If
 
strDriveToMap = "H:"
strShareToMap = "\\servername\share"
strServer = Mid(strShareToMap, 3, InStr(Mid(strShareToMap, 3), "\") - 1)
 
' Create the WSH Network object to map drives with
Set objNetwork = CreateObject("WScript.Network")
 
' Here you can explicitly enter the username and password,
' OR you can get the credentials from the user
' Explicit:
'strUsername = "DOMAINNAME\username"
'strPassword = "thepassword"
' OR from User:
'strUsername = InputBox("Enter the user name to access " & strServer, "Network Username", "username@domain")
WScript.StdOut.Write "Enter the user name to access " & strServer & ": "
strUsername = WScript.StdIn.ReadLine
'strPassword = InputBox("Enter the password for the user " & strUsername, "Network Password")
Set objPassword = CreateObject("ScriptPW.Password")
Wscript.StdOut.Write "Please enter your password: "
strPassword = objPassword.GetPassword()
 
' Then construct the command to run to add those credentials.
strCommand = "cmd /c cmdkey /add:" & strServer & " /user:" & strUsername & " /pass:" & strPassword
 
Set objShell = CreateObject("WScript.Shell")
objShell.Run strCommand, 0, True
 
MsgBox strUsername & " has been added to the credentials list."
 
' This you may need. I have commented it out for now, but if the drive does Not
' map, try uncommenting the four lines from Set ... to Next, inclusive.
' Disconnect ALL mapped drives
'Set colDrives = objNetwork.EnumNetworkDrives
'For intDrive = 0 to colDrives.Count -1 Step 2
'`      objNetwork.RemoveNetworkDrive colDrives.Item(i), True, True
'Next
 
' Now map the drive
On Error Resume Next
objNetwork.MapNetworkDrive strDriveToMap, strShareToMap
If Err.Number <> 0 Then
      MsgBox "There was an error mapping " & strDriveToMap & " to " & strShareToMap & _
            VbCrLf & "Error number: " & Err.Number
      Err.Clear
      On Error GoTo 0
Else
      On Error GoTo 0
      MsgBox strDriveToMap & " has been mapped to " & strShareToMap
End If
 
strCommand = "cmd /c cmdkey /delete:" & strServer'
objShell.Run strCommand, 0, True
 
'MsgBox strReturnVal

Open in new window

0
 
Peter_Brabrand_RasmussenCommented:
The inputbox you are using for input does not support masking. I am assuming that you want the input masked when a user types his password. Sorry.. :(
0
Receive 1:1 tech help

Solve your biggest tech problems alongside global tech experts with 1:1 help.

 
eServAuthor Commented:
Rob I replaced strPassword = InputBox("Enter the password for the user " & strUsername, "Network Password" with what you suggested and it get a script error.  

Peter Brabrand Rasmussen - you are correct I would like the iput masked when the user types his password.

Thanks for the quick response and again I am just a network admin so scripting is not my thing. :)
0
 
RobSampsonCommented:
Can you please post the error that you got?

Rob.
0
 
eServAuthor Commented:
Hey Rob -

Ok the error came as I had a few extra words in the vb script.  So the script opens up in a DOS file asking for a user name.  This is not really what I am looking for as I need it to display an example of how to log in domian\username.  With the oringal VB Script it would do that.  Anyway to keep the look of the orginal code and just mask the password?

Sorry the person that needs this code needs this to be very simple and easy for end users to figure out.

Atteched the script as you had it

Thanks for the help
script.jpg
0
 
eServAuthor Commented:
Rob you are the man!  This is what I need thank you very much and have a great night
0
 
RobSampsonCommented:
No problem.  Thanks for the grade.

Regards,

Rob.
0
 
RobSampsonCommented:
P.S. There's some beginners info on HTA's here:
http://www.microsoft.com/technet/scriptcenter/hubs/htas.mspx

Rob.
0
 
tracymsCommented:
RobSampson,

The hta looks similar to what I'd like to do, please see my post:
http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_23928007.html
0
All Courses

From novice to tech pro — start learning today.