troubleshooting Question

Password Mask for MS Access Inputbox

Avatar of Gazza110
Gazza110 asked on
Microsoft Access
27 Comments1 Solution29906 ViewsLast Modified:
Hi,

I know that this has been asked before but I want some code to create an inputbox in MS Access that has a password character *  in it rather than displaying the text.

I know this is possible in MS Excel by creating a customer Inputbox in module code, however the Excel code does not work in MS Access.

Here is a sample of the Excel Code :

#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~

(basAddrOf) - Module


Option Explicit
'// My thanks to:
'// Ken Getz and Michael Kaplan
'// For their brilliant work with
'// Using Callbacks with Office 97
'// KNG Consulting, Inc.
'// Copyright © 1998
'// Ken Getz & Michael Kaplan
'// All rights reserved.
'-------------------------------------------------------------------------------------------------------------------
'   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

'-------------------------------------------------------------------------------------------------------------------
'   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.
'-------------------------------------------------------------------------------------------------------------------
Public Function AddrOf(strFuncName As String) As Long
    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


#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~

(ModInput)  -  Module



Option Explicit

'////////////////////////////////////////////////////////////////////
'Password masked inputbox
'Allows you to hide characters entered in a VBA Inputbox.
'
'Code written by Daniel Klann
'http://www.danielklann.com/
'March 2003

'// Kindly permitted to be amended
'// Amended by Ivan F Moala
'// http://www.xcelfiles.com
'// April 2003
'// Amended for XL97
'////////////////////////////////////////////////////////////////////


'API functions to be used
Private Declare Function CallNextHookEx _
    Lib "user32" ( _
    ByVal hHook As Long, _
    ByVal ncode As Long, _
    ByVal wParam As Long, _
    lParam As Any) _
As Long

Private Declare Function GetModuleHandle _
    Lib "kernel32" _
    Alias "GetModuleHandleA" ( _
    ByVal lpModuleName As String) _
As Long

Private Declare Function SetWindowsHookEx _
    Lib "user32" _
    Alias "SetWindowsHookExA" ( _
    ByVal idHook As Long, _
    ByVal lpfn As Long, _
    ByVal hmod As Long, _
    ByVal dwThreadId As Long) _
As Long

Private Declare Function UnhookWindowsHookEx _
    Lib "user32" ( _
    ByVal hHook As Long) _
As Long

Private Declare Function SendDlgItemMessage _
    Lib "user32" Alias "SendDlgItemMessageA" ( _
    ByVal hDlg As Long, _
    ByVal nIDDlgItem As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) _
As Long

Private Declare Function GetClassName _
    Lib "user32" _
    Alias "GetClassNameA" ( _
    ByVal hwnd As Long, _
    ByVal lpClassName As String, _
    ByVal nMaxCount As Long) _
As Long

Private Declare Function GetCurrentThreadId _
    Lib "kernel32" () _
As Long

'Constants to be used in our API functions
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0

Private hHook As Long

Public Function NewProc(ByVal lngCode As Long, _
                        ByVal wParam As Long, _
                        ByVal lParam As Long) As Long

Dim RetVal
Dim strClassName As String, lngBuffer As Long

If lngCode < HC_ACTION Then
    NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
    Exit Function
End If

strClassName = String$(256, " ")
lngBuffer = 255

If lngCode = HCBT_ACTIVATE Then    'A window has been activated
    RetVal = GetClassName(wParam, strClassName, lngBuffer)
    If Left$(strClassName, RetVal) = "#32770" Then  'Class name of the Inputbox
        'This changes the edit control so that it display the password character *.
        'You can change the Asc("*") as you please.
        SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
    End If
End If
   
'This line will ensure that any other hooks that may be in place are
'called correctly.
CallNextHookEx hHook, lngCode, wParam, lParam

End Function

'// Make it public
'// Lets simulate the VBA Input Function
Public Function InputBoxDK(Prompt As String, Optional Title As String, _
            Optional Default As String, _
            Optional Xpos As Long, _
            Optional Ypos As Long, _
            Optional Helpfile As String, _
            Optional Context As Long) As String
   
Dim lngModHwnd As Long, lngThreadID As Long
   
'// Lets handle any Errors JIC! due to HookProc> App hang!
On Error GoTo ExitProperly
lngThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandle(vbNullString)
   
hHook = SetWindowsHookEx(WH_CBT, AddrOf("NewProc"), lngModHwnd, lngThreadID)
If Xpos Then
    InputBoxDK = InputBox(Prompt, Title, Default, Xpos, Ypos, Helpfile, Context)
Else
    InputBoxDK = InputBox(Prompt, Title, Default, , , Helpfile, Context)
End If

ExitProperly:
UnhookWindowsHookEx hHook

End Function

Sub TestDKInputBox()
Dim x

x = InputBoxDK("Type your password here.", "Password Required")
If x = "" Then End
If x <> "yourpassword" Then
    MsgBox "You didn't enter a correct password."
    End
End If

MsgBox "Welcome Creator!", vbExclamation
   
End Sub


#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~

You would then use InputBoxDK function as opposed to InputBox and this would * out the entered text as you enter it (just like a password character).

Can something simular be done with MS Access, as I don't want to have to create custom form, I want to just be able to use code to accomplish the relevant task.

Many thanks,

Gaz.




ASKER CERTIFIED SOLUTION
Alan Warren
Practice Manager

Our community of experts have been thoroughly vetted for their expertise and industry experience.

Log in to continue reading
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform for $9.99/mo
View membership options
Unlock 1 Answer and 27 Comments.
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
See how we're fighting big data
The Value of Experts Exchange in My Daily IT Life

Experts Exchange (EE) has become my company's go-to resource to get answers. I've used EE to make decisions, solve problems and even save customers. OutagesIO has been a challenging project and... Keep reading >>

Mike

Owner of Outages.IO
Phoenix, Arizona, United States
Member Since 2016
Join a full scale community that combines the best parts of other tools into one platform.
Unlock 1 Answer and 27 Comments.
View membership options
“All of life is about relationships, and EE has made a virtual community a real community. It lifts everyone's boat.”
William Peck

Member since 2004