Option Explicit
'API宣告
#If Win64 Then
Private Declare PtrSafe Function FindWindow Lib 'user32' Alias 'FindWindowA' (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function FindWindowEx Lib 'user32' Alias 'FindWindowExA' (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function SendMessage Lib 'user32' Alias 'SendMessageA' (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function timeSetEvent Lib 'winmm.dll' (ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpFunction As LongPtr, ByVal dwUser As LongPtr, ByVal uFlags As Long) As Long
Private Declare PtrSafe Function timeKillEvent Lib 'winmm.dll' (ByVal uID As Long) As Long
#Else
Private Declare Function FindWindow Lib 'user32' Alias 'FindWindowA' (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib 'user32' Alias 'FindWindowExA' (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SendMessage Lib 'user32' Alias 'SendMessageA' (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function timeSetEvent Lib 'winmm.dll' (ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpFunction As Long, ByVal dwUser As Long, ByVal uFlags As Long) As Long
Private Declare Function timeKillEvent Lib 'winmm.dll' (ByVal uID As Long) As Long
#End If
'timeSetEvent函数请参考MSDN
Private Const EM_SETPASSWORDCHAR = &HCC
Dim lTimeID As Long 'Timer ID
Const pswdInputBoxTitle = 'pswdInputBox' '输入密码的对话框标题
'TimeProc callback 函数请参考MSDN
Sub TimeProc(ByVal uID As Long, ByVal uMsg As Long, ByVal dwUser As Long, _
ByVal dw1 As Long, ByVal dw2 As Long)
Dim hwd As LongPtr '输入密码的对话框句柄
'VBA InputBox对话框之Class Name是 '#32770',
'标题为 'pswdInputBox', 这是在InputBox函数的Title引述中自订的
'请注意Application.InputBox方法所出现的对话框Class Name是 'bosa_sdm_XL9'
hwd = FindWindow('#32770', pswdInputBoxTitle)
If hwd <> 0 Then '若对话框存在
'取得输入的文字框句柄, 该文字框的Class Name是'Edit', 无标题,
'而Application.InputBox方法所出现的对话框之文字框的Class Name是'EDTBX'
hwd = FindWindowEx(hwd, 0, 'Edit', vbNullString)
'设定密码字符为 '*', '*'的ASCII码为42
SendMessage hwd, EM_SETPASSWORDCHAR, 42, 0
'设定完成, 取消定时器
timeKillEvent lTimeID
End If
End Sub
'自定义函数pswdInputBox, 是一个输入密码使用的InputBox, 输入的内容都以 '*' 显示.
Function pswdInputBox() As Variant
'启动一个特定的Timer事件, 0.01秒延迟, 0.05秒看一次
lTimeID = timeSetEvent(10, 50, AddressOf TimeProc, 1, 1)
'显示InputBox对话框
pswdInputBox = InputBox(Prompt:='请输入管理员密码', Title:=pswdInputBoxTitle)
End Function
Sub TestpswdInputBox()
Dim s
Static x As Integer '静态变量
s = pswdInputBox '在自己的代码中 只需要这一句调用 代替以前的inbutbox即可
If s = '' Then Exit Sub
If s = '123456' Then
MsgBox '管理员登录成功'
Else
x = x + 1
If x = 3 Then
MsgBox '你已经3次输入密码,电脑即将爆炸!'
x = 0
Exit Sub
End If
MsgBox '密码已输入错误' & x & '次,请重新输入'
TestpswdInputBox
End If
End Sub
