|
网上API实现代码:
- Option Explicit
- #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
复制代码
|
|