问题描述
我一直在使用Daniel Klann编写的标准密码文本框()来隐藏密码输入。
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?
这是Daniel的代码:
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
推荐答案
不,没有。它返回一个空指针取消,空字符串为空输入。
No it does not. It returns a null pointer 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密码输入的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!