Hide Password in Input Box (1 Viewer)

[KW99]

This should be an easy one but I am not 100% sure how to do it.

I have written the following code on a command button to set up a basic password for opening a 'locked switchboard'. What I really want to do is hide the password being typed into the input box with asterix's. Here is the current code and password:

Private Sub Command8_Click()
On Error GoTo Err_Command8_Click
Retry:
Dim strInput As String
strInput = InputBox("Please Enter the Password", "Enter Password")
If strInput = "datapass1" Then
DoCmd.OpenForm "investmentamendmenu1", acNormal
Else
If MsgBox("You entered the wrong password. Do you wish to try again?", vbQuestion + vbYesNo, "Password Error") = vbYes Then
GoTo Retry
End If
End If
Exit_investmentamendmenu1_Click:
Exit Sub
Err_investmentamendmenu1_Click:
MsgBox Err.Description
Resume Exit_investmentamendmenu1_Click
Dim stDocName As String
Dim stLinkCriteria As String
stDocName = "investmentamendmenu1"
DoCmd.OpenForm stDocName, , , stLinkCriteria
Exit_Command8_Click:
Exit Sub
Err_Command8_Click:
MsgBox Err.Description
Resume Exit_Command8_Click

End Sub

Any ideas on how to modify the code would be great.

Thanks.

 

[HiTechCoach]

Unfortunately the Input box does not have an option to hide the data entry.

You will need to use a form and a text box. Set the input mask for the text box to be password. This will do what you want.

 

[KW99]

Really, that is quite shocking.

I am really surprised that there is not some way of writing in a basic input mask in the code.

I could make some forms up, but it means changing about 9 switchboards and it would have been alot easier to just amend a little bit of the code.

 

[rob.low]

Hi KW99

i use a inputbox with input mask shows *****

Somone on here posted it (cant remember who though) so credit to them.

attached is a demo... hope this helps

Rob

 

[Guy Boswell]

Well done Daniel Klann. I like that. Thank you for passing it on Rob.

 

[dbDamo]

I have this code in a standard module:-

Global gStatusText As String 'Status bar text used in Application.Echo method
' API set A:
' Used by the callback process (TimerProc) to hook into
' the InputBox window
' Ref: [URL="http://pub13.ezboard.com/fvisualbasicexplorervbtips.showMessage?topicID=314.topic"][COLOR=#0000ff]http://pub13.ezboard.com/fvisualbasicexplorervbtips.showMessage?topicID=314.topic[/COLOR][/URL]
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias _
"FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare Function SetTimer& Lib "user32" _
(ByVal hwnd&, ByVal nIDEvent&, ByVal uElapse&, ByVal _
lpTimerFunc&)
 
Public Declare Function KillTimer& Lib "user32" _
(ByVal hwnd&, ByVal nIDEvent&)
Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
' Constants for API set A
Const EM_SETPASSWORDCHAR = &HCC
Public Const NV_INPUTBOX As Long = &H5000&
Public Function TimerProc(ByVal lHwnd&, ByVal uMsg&, _
ByVal lIDEvent&, ByVal lDWTime&) As Long
Dim lTemp As Long
' This function allows for a mask character on an inputbox
' ' Usage (Replace anything between [] with valid names from your project):
' From a form or module:
' 1. Declare a Long variable
' 2. Call the timer function: [variable] = SetTimer([form].Hwnd, NV_INPUTBOX, [elapsed time], AddressOf [function name])
' 2b. Example usage from a form: lTemp = SetTimer(Me.Hwnd, NV_INPUTBOX, 1, AddressOf TimerProc)
' 3. Create your InputBox as usual
 
Dim lEditHwnd As Long
 
' Find a handle to the InputBox window, then to the textbox
' the user types in (Known as "Edit")
' ' **This part is VERY important, here is how the FindWindowEx call should look:
' **Only change the parameters that are enclosed in [ ] in the following example
lTemp = FindWindowEx(FindWindow("#32770", "[gMsgText]"), 0, "Edit", "")
lEditHwnd = FindWindowEx(FindWindow("#32770", gMsgTitle), 0, "Edit", "")
 
' Send the mask character to the target InputBox when the user types
' The mask character in this sample is the Asc("*") - the "*" can be changed
' to whatever you like.
 
Call SendMessage(lEditHwnd, EM_SETPASSWORDCHAR, Asc("*"), 0)
' Destroy the timer object when done (The user clicks OK or Cancel from the InputBox)
KillTimer lHwnd, lIDEvent
End Function

I then use the following code in my command button's OnClick event:-

  Dim pResponse As String
  Dim lSalesPersonID As Long
  Dim lEditHwnd As Long
  Dim lTemp As Long
  Dim sPwd As String
  gMsgTitle = "Security Check"
  gMsgType = vbOKOnly + vbInformation
  gMsgText = "Enter Password"
  Beep
 
  lTemp = SetTimer(Me.hwnd, NV_INPUTBOX, 1, AddressOf TimerProc)
  sPwd = InputBox(gMsgText, gMsgTitle)
  MsgBox "the password you entered was: " & sPwd
 
'Check to see if there is any entry made to input box, or if
'cancel button is pressed. If no entry made then exit sub.
  If sPwd = "" Or sPwd = Empty Then
        MsgBox "No Input Provided", vbInformation, "Required Data"
        Exit Sub
  End If
 
'If correct password is entered open Project form
'If incorrect password entered give message and exit sub
   If sPwd = "reddevils" Then
        DoCmd.OpenForm "Project", acNormal
   Else
        MsgBox "Sorry, you do not have access to perform this operation", _
               vbOKOnly, "Important Information"
        Exit Sub
   End If

 

[mmf100]

Hi KW99

i use a inputbox with input mask shows *****

Somone on here posted it (cant remember who though) so credit to them.

attached is a demo... hope this helps

Rob

i had to thank you for the demo and thank how ever make it, it solve my problems

thanks again

 

[Kvracing]

Just downloaded the database and tried it on my 64bit system.
Updated Declare function to Declare PtrSafe function, but getting a Type mismatch on the AddressOf NewProc part of SetWindowsHookEx

Anyone know whats need to be changed? I use 2013 btw.

 

[Kvracing]

None has converted this code to 64 bit 2013 system?

I find it very strange that all the codes I find around on different sites are just for around 2002 access?

 

[smig]

This tree is few years old

 

[gemma-the-husky]

2002 code will surely work in 2013.

I do not know about 64bit. Even MS recommend using 32bit, rather than 64bit (unless I misunderstood the installation message)

 

[Kvracing]

Yeah, it's that I have a 64 bit system. Don't know how to get it converted though.

 

[gemma-the-husky]

it's relatively simple to design a form that resembles an inputbox, but where you can use a password mask.

the easy way is to store the entered password in a public variable

 

[Kvracing]

I can just post the code so it's no missunderstandings:

The code are now:

Public sPwd As String
Public gMsgTitle As String
Public gMsgType As String
Public gMsgText As String
Public gStatusText As String

"FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias _
"FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, _
ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr

Public Declare PtrSafe Function SetTimer& Lib "user32" _
(ByVal hwnd&, ByVal nIDEvent&, ByVal uElapse&, ByVal _
lpTimerFunc&)

Public Declare PtrSafe Function KillTimer& Lib "user32" _
(ByVal hwnd&, ByVal nIDEvent&)

Private Declare PtrSafe Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As LongPtr, _
ByVal wParam As LongPtr, lParam As Any) As LongPtr

Const EM_SETPASSWORDCHAR = &HCC
Public Const NV_INPUTBOX As Long = &H5000&

And Function:

Public Function TimerProc(ByVal lHwnd&, ByVal uMsg&, _
ByVal lIDEvent&, ByVal lDWTime&) As LongPtr

Dim lTemp As Long
Dim lEditHwnd As Long
lTemp = FindWindowEx(FindWindow("#32770", "gMsgText"), 0, "Edit", "")
lEditHwnd = FindWindowEx(FindWindow("#32770", "gMsgTitle"), 0, "Edit", "")

Call SendMessage(lEditHwnd, EM_SETPASSWORDCHAR, Asc("*"), 0)

KillTimer lHwnd, lIDEvent
End Function

Input box:

Private Sub OpnAdm_Click()

gMsgTitle = "Begrenset Omrde"
gMsgType = vbOKOnly + vbInformation
gMsgText = "Tast inn passord"
  

lTemp = SetTimer(Me.hwnd, NV_INPUTBOX, 1, AddressOf TimerProc)
sPwd = InputBox(gMsgText, gMsgTitle)


If strPasswd = "" Or strPasswd = Empty Then
Exit Sub
End If

If strPasswd = "yslg53481" Then
DoCmd.OpenForm "frmBatchReg"
Else
MsgBox "Beklager, du har ikke tilgang til denne delen av programmet", vbOKOnly, "Sikkerhetssjekk"
Exit Sub
End If


End Sub

Missing anything? The error I get is type missmatch on AddressOf TimerProc. But I know its also needs converting to 64 bit. Don't know how tough.

 

[Kvracing]

it's relatively simple to design a form that resembles an inputbox, but where you can use a password mask.

the easy way is to store the entered password in a public variable

I know, and but I rather have more code and less forms And it get's on my nerves that I cant find it out, so just need see this through, especially when so many other 32 bit users got it to work

 

[Kvracing]

Posted this on other forums; Just for information (got some angry moderators breathing down my neck:
I have posted this issue on several forums, simply because I don't think it's an easy fix, and most likley It's just a few people who can solve this. Where they are is hard to know, so I have multiplyed the chances of finding them by going wide on the internett Do not worry on dobbeltsolving this problem, the minuite we find a solution its out on every forum. I don not want others to use as much time on this as I have. In fact I hope to mabe make a youtube video But first the problem needs solving So thx anyway for reading, I am quite on my deapth here now, so ain't getting further here without anyone with a little more experience

Regards
-Kv

 

[Kvracing]

I converted to 32 bit. Solved the whole problem

 

[bejaranoangel]

Hi KW99

i use a inputbox with input mask shows *****

Somone on here posted it (cant remember who though) so credit to them.

attached is a demo... hope this helps

Rob

This worked for me... Many thanks

 

[smig]

This thread is 1 year old

 

[swenger]

Hi,

I have been using the code from Daniel Klann for a while and it is great. I just upgraded office to 64 bit and the error I get is to upgrade the code for 64bit and make sure to mark them with PtrSafe attribute. Do you have this code updated for 64 bit?

Thanks,
Sam

Hi KW99

i use a inputbox with input mask shows *****

Somone on here posted it (cant remember who though) so credit to them.

attached is a demo... hope this helps

Rob