html使用对话框接收密码,Excel黑科技 vba中用Inputbox对话框接受输入密码时显示为*...

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