Question

我想使用InputBox来检查密码。

如果用户按下＆＃34; OK＆＃34;没有数据输入，InputBox应该再次运行，如果用户按下＆＃34;取消＆＃34;或者＆＃34; ESC＆＃34;，公司子程序退出。

我怎样才能识别＆＃34; ESC＆＃34;或＆＃34;取消＆＃34;输入，不同于＆＃34; null＆＃34;还是空的？

具体如何为我自定义创建的带有API的输入框，以便更改按键显示为＆＃34; *＆＃34;在密码输入中，命名为InputBoxDk：

'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


Private Declare Sub sapiSleep Lib "kernel32" _
    Alias "Sleep" _
    (ByVal dwMilliseconds 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

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

代码参考：http://www.ozgrid.com

Answer 1

Application.InputBox()在取消或Esc时返回False，其中InputBox()返回""。

Sub ProcedureName()

    Dim response As Variant
    Do Until Len(Trim(response)) > 0
        response = Application.InputBox("Type something: ", "InputBox")
    Loop

    If response = vbFalse Then ' in case the use press "Cancel"
        MsgBox "Pressed Cancel"
    End If
End Sub

Answer 2

InputBox("prompt", "title", "default")

我无法对其进行测试，但如果用户点击“确定”，则结果应为"default"。如果点击其他内容，则结果应为""。如果用户清除输入并单击“确定”，则结果为""。无法确保在InputBox中单击了OK，因此您可能需要一个自定义UserForm。

Answer 3

我如何识别＆＃34; ESC＆＃34;或＆＃34;取消＆＃34;输入，不同于＆＃34; null＆＃34;还是空的？

它没有完全记录，但取消的输入框不只返回任何""空字符串：

Debug.Print StrPtr("") ' returns some address
Debug.Print StrPtr(vbNullString) ' returns 0

问题是，将vbNullString与""进行比较会返回True。

所以诀窍是验证返回值的StrPtr：

Dim result As String
result = InputBox(...)

If StrPtr(result) = 0 Then
    ' definitely cancelled
    Exit Sub
End If

If result = vbNullString Then
    ' legit empty string
    '...
Else
    ' non-empty string
    '...
End If

此解决方案适用于VB6以及任何VBA主机。

InputBox取消与vbNullString不同（null）

3 个答案: