[2 days left] What’s wrong with your cloud strategy? Learn why multicloud solutions matter with Nimble Storage.Register Now

x
?
Solved

Mask password in VB Script

Posted on 2008-10-12
10
Medium Priority
?
2,894 Views
Last Modified: 2012-08-13
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
'===================
0
Comment
Question by:eServ
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
10 Comments
 
LVL 65

Expert Comment

by:RobSampson
ID: 22699684
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
 
LVL 1

Expert Comment

by:Peter_Brabrand_Rasmussen
ID: 22699702
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
 

Author Comment

by:eServ
ID: 22699716
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
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
LVL 65

Expert Comment

by:RobSampson
ID: 22699726
Can you please post the error that you got?

Rob.
0
 

Author Comment

by:eServ
ID: 22699760
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
 
LVL 65

Accepted Solution

by:
RobSampson earned 2000 total points
ID: 22699823
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
 

Author Closing Comment

by:eServ
ID: 31505529
Rob you are the man!  This is what I need thank you very much and have a great night
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22699859
No problem.  Thanks for the grade.

Regards,

Rob.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 22699862
P.S. There's some beginners info on HTA's here:
http://www.microsoft.com/technet/scriptcenter/hubs/htas.mspx

Rob.
0
 
LVL 1

Expert Comment

by:tracyms
ID: 23065441
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

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

We have adopted the strategy to use Computers in Student Labs as the bulletin boards. The same target can be achieved by using a Login Notice feature in Group policy but it’s not as attractive as graphical wallpapers with message which grabs the att…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
Two types of users will appreciate AOMEI Backupper Pro: 1 - Those with PCIe drives (and haven't found cloning software that works on them). 2 - Those who want a fast clone of their boot drive (no re-boots needed) and it can clone your drive wh…
We’ve all felt that sense of false security before—locking down external access to a database or component and feeling like we’ve done all we need to do to secure company data. But that feeling is fleeting. Attacks these days can happen in many w…

656 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question