VBA Password Input with Cancel Function

问题

I have been using the standard password textbox written by Daniel Klann (http://www.ozgrid.com/forum/showthread.php?t=72794) to hide the password inputs.

The main problem is that the standard InputBox returns empty fields and cancel the same way. Application.InputBox however is capable of returning a False on cancel.

Updating Daniel Klann\'s script to work with the Application.InputBox is beyond me. How would this be done?

Here is Daniel\'s code:

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
 \'// Works for Xl2000+ due the AddressOf Operator
 \'////////////////////////////////////////////////////////////////////

 \'********************   CALL FROM FORM *********************************
 \'    Dim pwd As String
 \'
 \'    pwd = InputBoxDK(\"Please Enter Password Below!\", \"Database Administration Security Form.\")
 \'
 \'    \'If no password was entered.
 \'    If pwd = \"\" Then
 \'        MsgBox \"You didn\'t enter a password!  You must enter password to \'enter the Administration Screen!\" _
 \'        , vbInformation, \"Security Warning\"
 \'    End If
 \'**************************************



 \'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 = avail to ALL Modules
 \'// 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, AddressOf 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 

回答1:

the standard InputBox returns empty fields and cancel the same way

No it does not. It returns a null pointer (vbNullString) on cancel and an empty string ("") for empty input.

Dim s As String
s = InputBox("Test")

If StrPtr(s) = 0 Then
  'Cancel pressed
Else
  'Ok pressed
End If

Because InputBoxDK returns the InputBox's value unchanged, same logic applies to it.

来源：https://stackoverflow.com/questions/20909417/vba-password-input-with-cancel-function