带取消功能的VBA密码输入 [英] VBA Password Input with Cancel Function

问题描述

我一直在使用 Daniel Klann 编写的标准密码文本框 (http://www.ozgrid.com/forum/showthread.php?t=72794) 隐藏密码输入.

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.

主要问题是标准的InputBox 返回空字段并以相同的方式取消.Application.InputBox 但是能够在取消时返回 False.

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.

更新 Daniel Klann 的脚本以使用 Application.InputBox 超出了我的能力.这将如何完成?

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

这是丹尼尔的代码:

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 

推荐答案

标准的InputBox返回空字段并以同样的方式取消

the standard InputBox returns empty fields and cancel the same way

不，不是.它在取消时返回一个空指针 (vbNullString)，并为空输入返回一个空字符串 ("").

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

因为InputBoxDK返回InputBox的值不变，同样的逻辑也适用于它.

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

这篇关于带取消功能的VBA密码输入的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！