Solved

Password Input Mask for an Input Box

Posted on 2004-04-27
19
782 Views
Last Modified: 2007-12-19
Hi, I have the following code to prompt for a password that will enable certain listboxes on frmMainMenu. I am trying to be able to create an input mask (password type) to display ******* when passwords are typed in. I have considered using a separate form with an unbound control, but would much prefer to do through code if possible.

Private Sub btnUnlockCCMenus_Click()
Dim User1 As String
    User1 = InputBox("Greetings, Please enter your password", "Enter Password")
   
   'This user has access to all forms (CC)
   If (User1) = "33" Then
   
   Me.CCForms.Enabled = True
   Me.OPSForms.Enabled = True
   Me.CCMenu3.Enabled = True 'Database Maintenance
   Me.CCReports2.Enabled = True
   
   End If
   
    'Users with this password have access to forms below (PTE Dockerty)
    If (User1) = "shannon" Then
    Me.CCForms.Enabled = True
    Me.OPSForms.Enabled = True
    Me.CCReports2.Enabled = True
    Me.CCMenu3.Enabled = True 'Database Maintenance
    End If
   
   'Users with this password have access to forms below (Carol)
    If (User1) = "stacey" Then
    Me.CCForms.Enabled = True
    Me.CCReports2.Enabled = True
    Me.CCMenu3.Enabled = True 'Database Maintenance
    End If

End Sub

Any assistance would be of great value.

Budorat
0
Comment
Question by:budorat
  • 10
  • 6
  • 3
19 Comments
 
LVL 54

Expert Comment

by:nico5038
ID: 10927354
I always use simply a form with a text box having the Password input mask.
InputBox won't have this possibility.

Even in the table where I store the password I use that mask.

Need more info ?

Nic;o)
0
 
LVL 65

Expert Comment

by:rockiroads
ID: 10927445
either create your own inputbox (via a form) like Nico suggested or try this

http://www.experts-exchange.com/Databases/MS_Access/Q_20949769.html

note, I have not tried this, but came from alan warren, a expert in the top15!
0
 
LVL 5

Author Comment

by:budorat
ID: 10927480
OK, I have created a form called frmSysPassword with an unbound text box called password. I have created the input mask for the text box as password, so it is now showing ***** when typing any text into here.

How would I amend the code to call frmSysPassword and interrogate the entry?

Budorat
0
 
LVL 65

Expert Comment

by:rockiroads
ID: 10927521
to call a form you simply do

DoCmd.OpenForm frmSysPassword

to interrogate the entry, the code is plain text, its just displayed as asterix

so you can continue with if password = 33 ...

you could put the code in the frmSysPassword and close it, so your back in your calling form

if code in frmSysPassword, you would have to call the form itself like
[Forms]![formname]![controlname]
0
 
LVL 65

Expert Comment

by:rockiroads
ID: 10927535
that link I gave, it works!!!
if you want to try that, thats up to you
Im impressed, hey Nico, have a look at it, its pretty good

the code does mask using #, but you can easily change that to *

0
 
LVL 65

Accepted Solution

by:
rockiroads earned 125 total points
ID: 10927550
in your code

Private Sub btnUnlockCCMenus_Click()
Dim User1 As String

    User1 = InputBox("Greetings, Please enter your password", "Enter Password")

'Add this line before the Inputbox
  lTemp = SetTimer(Me.hwnd, NV_INPUTBOX, 1, AddressOf TimerProc)


then place this code in a module

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



Ive change the module so it masks with *



0
 
LVL 54

Expert Comment

by:nico5038
ID: 10927624
Look's indeed nice rockyroads, but I'm more the "lazy" type and normally define a table with userID and a by default masked password.
Thus it's rather straight forward to create a logon form and in general I combine it with the possibility to change the password by the user with the standard:
OldPassWord:
NewPassWord:
ConfirmNew:

Nic;o)
0
 
LVL 65

Expert Comment

by:rockiroads
ID: 10927667
yea, I have actually done the same but in a VB program, my current db validates the name by checking network login name against the database. Throws u out if not a registered user.
Its a internal tool so not worried about hackers getting in, there all accountants here

But its a useful bit of code do have, dont u agree?
0
 
LVL 54

Expert Comment

by:nico5038
ID: 10927733
Yes, I concur :-)

Nic;o)
0
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 65

Expert Comment

by:rockiroads
ID: 10928352
Hey budorat, got bits of code missing in the example give

in module you need to defne

  Global gMsgText As String       'Text in MsgBox() and InputBox() functions
  Global gMsgType As Integer      'Type in MsgBox() and InputBox() functions
  Global gMsgTitle As String      'Title for MsgBox() and InputBox() function
  Global gStatusText As String    'Status bar text used in Application.Echo method


and in form do this

  gMsgTitle = "Enter Password"
  gMsgType = vbOKOnly + vbInformation
  gMsgText = "Greetings, Please enter your password"
 
  lTemp = SetTimer(Me.hwnd, NV_INPUTBOX, 1, AddressOf TimerIBProc)
  sPwd = InputBox(gMsgText, gMsgTitle)


sorry about that



0
 
LVL 5

Author Comment

by:budorat
ID: 10937673
Hi there, firstly sorry it's taken so long to get back to you, but I had to get to bed eventually.

The following line of code

lTemp = SetTimer(Me.hwnd, NV_INPUTBOX, 1, AddressOf TimerIBProc)

always seems to go red whenever I copy it into the form, not sure why!

I am not sure why it's not working, but I am not exactly a guru at this stuff, yet!!! lol

Budorat
0
 
LVL 65

Expert Comment

by:rockiroads
ID: 10937707
sorry that should be

lTemp = SetTimer(Me.hwnd, NV_INPUTBOX, 1, AddressOf TimerProc)
0
 
LVL 5

Author Comment

by:budorat
ID: 10937712
Nico,

Do you have a copy of how you set up the login table, form etc that I may be able to have. I find I learn a lot quicker by reverse engineering what someone else has done and adapting for my own. I believe I learn better this way, or is that I learn to emulate and adapt rather than actually learning?

Budorat
0
 
LVL 5

Author Comment

by:budorat
ID: 10937728
Rocki,

still the same response!!! Frustrating!!! not with you, with my inability to work it out!!!
0
 
LVL 65

Expert Comment

by:rockiroads
ID: 10937741
what version access you using
having a look at that link, apparently some additional code is required if using access97




just paste the code here

form code and module code, tell me which is which
0
 
LVL 5

Author Comment

by:budorat
ID: 10937772
I have both access 97 and XP, but I am building it for a Access 97 platform due to thats what we use at work.

Module code is...

Global gMsgText As String       'Text in MsgBox() and InputBox() functions
Global gMsgType As Integer      'Type in MsgBox() and InputBox() functions
Global gMsgTitle As String      'Title for MsgBox() and InputBox() function
Global gStatusText As String    'Status bar text used in Application.Echo method

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

Module Code as follows:

Private Sub btnUnlockCCMenus_Click()
 
Dim User1 As String
  gMsgTitle = "Enter Password"
  gMsgType = vbOKOnly + vbInformation
  gMsgText = "Greetings, Please enter your password"
 
  lTemp = SetTimer(Me.hwnd, NV_INPUTBOX, 1, AddressOf TimerProc)
  sPwd = InputBox(gMsgText, gMsgTitle)
 
  User1 = InputBoxDK("Greetings, Please enter your password", "Enter Password")
   
   'This user has access to all forms (CC)
   If (User1) = "33" Then
   Me.CCForms.Enabled = True
   Me.OPSForms.Enabled = True
   Me.CCMenu3.Enabled = True 'Database Maintenance
   Me.CCReports2.Enabled = True
   
   End If
   
    'Users with this password have access to forms below (PTE Dockerty)
    If (User1) = "shannon" Then
    Me.CCForms.Enabled = True
    Me.OPSForms.Enabled = True
    Me.CCReports2.Enabled = True
    Me.CCMenu3.Enabled = True 'Database Maintenance
    End If
   
   'Users with this password have access to forms below (Carol)
    If (User1) = "stacey" Then
    Me.CCForms.Enabled = True
    Me.CCReports2.Enabled = True
    Me.CCMenu3.Enabled = True 'Database Maintenance
    End If
End With
End Sub
0
 
LVL 65

Expert Comment

by:rockiroads
ID: 10937791
ok, looks right

right Access97, if you visit the link I gave u, the author used 97 and had the same problem but found a solution to that


here is the copy of that post





There was one problem I encountered, that was that the code did not work in Access 97 as the "AddressOf" function was not supported (works fine in Access 2000), however I managed to find a fix to this by ....

Adding a module " mdlAddrOf "

===============(mdlAddrOf)==========================================

Option Compare Database
Option Explicit
'-------------------------------------------------------------------------------------------------------------------
'   Declarations
'
'   These function names were puzzled out by using DUMPBIN /exports
'   with VBA332.DLL and then puzzling out parameter names and types
'   through a lot of trial and error and over 100 IPFs in MSACCESS.EXE
'   and VBA332.DLL.
'
'   These parameters may not be named properly but seem to be correct in
'   light of the function names and what each parameter does.
'
'   EbGetExecutingProj: Gives you a handle to the current VBA project
'   TipGetFunctionId: Gives you a function ID given a function name
'   TipGetLpfnOfFunctionId: Gives you a pointer a function given its function ID
'
'-------------------------------------------------------------------------------------------------------------------
Private Declare Function GetCurrentVbaProject Lib "vba332.dll" Alias "EbGetExecutingProj" (hProject As Long) As Long
Private Declare Function GetFuncID Lib "vba332.dll" Alias "TipGetFunctionId" (ByVal hProject As Long, ByVal strFunctionName As String, ByRef strFunctionId As String) As Long
Private Declare Function GetAddr Lib "vba332.dll" Alias "TipGetLpfnOfFunctionId" (ByVal hProject As Long, ByVal strFunctionId As String, ByRef lpfn As Long) As Long

Public Function AddrOf(strFuncName As String) As Long

'-------------------------------------------------------------------------------------------------------------------
'   AddrOf
'
'   Returns a function pointer of a VBA public function given its name. This function
'   gives similar functionality to VBA as VB5 has with the AddressOf param type.
'
'   NOTE: This function only seems to work if the proc you are trying to get a pointer
'       to is in the current project. This makes sense, since we are using a function
'       named EbGetExecutingProj.
'-------------------------------------------------------------------------------------------------------------------
   
    Dim hProject As Long
    Dim lngResult As Long
    Dim strID As String
    Dim lpfn As Long
    Dim strFuncNameUnicode As String
   
    Const NO_ERROR = 0
   
    ' The function name must be in Unicode, so convert it.
    strFuncNameUnicode = StrConv(strFuncName, vbUnicode)
   
    ' Get the current VBA project
    ' The results of GetCurrentVBAProject seemed inconsistent, in our tests,
    ' so now we just check the project handle when the function returns.
    Call GetCurrentVbaProject(hProject)
   
    ' Make sure we got a project handle... we always should, but you never know!
    If hProject <> 0 Then
        ' Get the VBA function ID (whatever that is!)
        lngResult = GetFuncID(hProject, strFuncNameUnicode, strID)
       
        ' We have to check this because we GPF if we try to get a function pointer
        ' of a non-existent function.
        If lngResult = NO_ERROR Then
            ' Get the function pointer.
            lngResult = GetAddr(hProject, strID, lpfn)
           
            If lngResult = NO_ERROR Then
                AddrOf = lpfn
            End If
        End If
    End If
End Function

============== End of (mdlAddOf) ===================================

Then replace the line .....

 lTemp = SetTimer(Me.hwnd, NV_INPUTBOX, 1, AddressOf TimerProc)


With  .....

 lTemp = SetTimer(Me.hwnd, NV_INPUTBOX, 1, AddrOf("TimerProc"))


Then this works fine in Access 97.

0
 
LVL 5

Author Comment

by:budorat
ID: 10937922
I think I should just give up, I cant get it to work!!! I am now getting 'sub or function not defined' and it's highlighting SetTimer.

Below is exactly what I have attached to the form I call the password from, where btnUnlockCCMenus_click() is the object and event.

Private Sub btnUnlockCCMenus_Click()
  gMsgTitle = "Enter Password"
  gMsgType = vbOKOnly + vbInformation
  gMsgText = "Greetings, Please enter your password"
 
lTemp = SetTimer(Me.hwnd, NV_INPUTBOX, 1, AddrOf("TimerProc"))
  sPwd = InputBox(gMsgText, gMsgTitle)
 
Dim User1 As String

    User1 = InputBoxDK("Greetings, Please enter your password", "Enter Password")
   
   'This user has access to all forms (CC)
   If (User1) = "33" Then
   Me.CCForms.Enabled = True
   Me.OPSForms.Enabled = True
   Me.CCMenu3.Enabled = True 'Database Maintenance
   Me.CCReports2.Enabled = True
   
   End If
   
    'Users with this password have access to forms below (PTE Dockerty)
    If (User1) = "shannon" Then
    Me.CCForms.Enabled = True
    Me.OPSForms.Enabled = True
    Me.CCReports2.Enabled = True
    Me.CCMenu3.Enabled = True 'Database Maintenance
    End If
   
   'Users with this password have access to forms below (Carol)
    If (User1) = "stacey" Then
    Me.CCForms.Enabled = True
    Me.CCReports2.Enabled = True
    Me.CCMenu3.Enabled = True 'Database Maintenance
    End If
End With
End Sub

The following is the code thats in one module exactly as follows:

Option Compare Database
Option Explicit


Global gMsgText As String       'Text in MsgBox() and InputBox() functions
Global gMsgType As Integer      'Type in MsgBox() and InputBox() functions
Global gMsgTitle As String      'Title for MsgBox() and InputBox() function
Global gStatusText As String    'Status bar text used in Application.Echo method

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&
'-------------------------------------------------------------------------------------------------------------------
'   Declarations
'
'   These function names were puzzled out by using DUMPBIN /exports
'   with VBA332.DLL and then puzzling out parameter names and types
'   through a lot of trial and error and over 100 IPFs in MSACCESS.EXE
'   and VBA332.DLL.
'
'   These parameters may not be named properly but seem to be correct in
'   light of the function names and what each parameter does.
'
'   EbGetExecutingProj: Gives you a handle to the current VBA project
'   TipGetFunctionId: Gives you a function ID given a function name
'   TipGetLpfnOfFunctionId: Gives you a pointer a function given its function ID
'
'-------------------------------------------------------------------------------------------------------------------
Private Declare Function GetCurrentVbaProject Lib "vba332.dll" Alias "EbGetExecutingProj" (hProject As Long) As Long
Private Declare Function GetFuncID Lib "vba332.dll" Alias "TipGetFunctionId" (ByVal hProject As Long, ByVal strFunctionName As String, ByRef strFunctionId As String) As Long
Private Declare Function GetAddr Lib "vba332.dll" Alias "TipGetLpfnOfFunctionId" (ByVal hProject As Long, ByVal strFunctionId As String, ByRef lpfn As Long) As Long

Public Function AddrOf(strFuncName As String) As Long

'-------------------------------------------------------------------------------------------------------------------
'   AddrOf
'
'   Returns a function pointer of a VBA public function given its name. This function
'   gives similar functionality to VBA as VB5 has with the AddressOf param type.
'
'   NOTE: This function only seems to work if the proc you are trying to get a pointer
'       to is in the current project. This makes sense, since we are using a function
'       named EbGetExecutingProj.
'-------------------------------------------------------------------------------------------------------------------
   
    Dim hProject As Long
    Dim lngResult As Long
    Dim strID As String
    Dim lpfn As Long
    Dim strFuncNameUnicode As String
   
    Const NO_ERROR = 0
   
    ' The function name must be in Unicode, so convert it.
    strFuncNameUnicode = StrConv(strFuncName, vbUnicode)
   
    ' Get the current VBA project
    ' The results of GetCurrentVBAProject seemed inconsistent, in our tests,
    ' so now we just check the project handle when the function returns.
    Call GetCurrentVbaProject(hProject)
   
    ' Make sure we got a project handle... we always should, but you never know!
    If hProject <> 0 Then
        ' Get the VBA function ID (whatever that is!)
        lngResult = GetFuncID(hProject, strFuncNameUnicode, strID)
       
        ' We have to check this because we GPF if we try to get a function pointer
        ' of a non-existent function.
        If lngResult = NO_ERROR Then
            ' Get the function pointer.
            lngResult = GetAddr(hProject, strID, lpfn)
           
            If lngResult = NO_ERROR Then
                AddrOf = lpfn
            End If
        End If
    End If
End Function


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 have to have something wrong!!!
0
 
LVL 65

Expert Comment

by:rockiroads
ID: 10938032
is some code missing?

I couldnt find this


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&)

put this lot of code where
Public Declare Function KillTimer& Lib "user32" _
(ByVal hwnd&, ByVal nIDEvent&)


is defined

0

Featured Post

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

When you are entering numbers in a speadsheet, and don't remember what 6×7 is, you just type “=6*7" instead. It works in every cell! This is not so in Access. To enter the elusive 42 in a text box, you have to find a calculator, and then copy the re…
QuickBooks® has a great invoice interface that we were happy with for a while but that changed in 2001 through no fault of Intuit®. Our industry's unit names are dictated by RUS: the Rural Utilities Services division of USDA. Contracts contain un…
In Microsoft Access, learn how to “cascade” or have the displayed data of one combo control depend upon what’s entered in another. Base the dependent combo on a query for its row source: Add a reference to the first combo on the form as criteria i…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

746 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

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now