1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
| 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 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 GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount 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 GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Const WH_CBT As Long = 5
Private Const HC_ACTION As Long = 0
Private Const HCBT_ACTIVATE As Long = 5 ' New window '
Private Const EM_SETPASSWORDCHAR As Long = &HCC
Private Const EM_LIMITTEXT As Long = &HC5
Private Const ID_OK As Long = &H1 'OK button '
Private Const ID_CANCEL As Long = &H2 'Cancel Button '
Private Const ID_TEXT As Long = &H1324 'Input TextBox '
Private Const ID_PROMPT As Long = &H1325 'Prompt label '
Private Const ID_HELP As Long = &H1326 'Help Button '
Private Const FORM_HEIGHT As Long = 2175
Private Const INPUT_TOP As Long = 1360
Private Const PROMPT_WIDTH As Long = 4095
Private Const PROMPT_HEIGHT As Long = 1215
Private Const MAX_PATH As Long = 255
Private hwndHook As Long
Public Function InputBox_PWD(Prompt, Optional Title, Optional Default, Optional XPos, Optional YPos, Optional HelpFile, Optional Context) As String
Dim lngModHwnd As Long, lngThreadID As Long
lngThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandle(vbNullString)
hwndHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
InputBox_PWD = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
UnhookWindowsHookEx hwndHook
End Function
Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim Ret As Long, strClassName As String
If lngCode < HC_ACTION Then
NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
Exit Function
End If
strClassName = String(MAX_PATH, " ")
If lngCode = HCBT_ACTIVATE Then
Ret = GetClassName(wParam, strClassName, MAX_PATH)
If Left$(strClassName, Ret) = "#32770" Then SendDlgItemMessage wParam, ID_TEXT, EM_SETPASSWORDCHAR, Asc("*"), &H0
End If
CallNextHookEx hHook, lngCode, wParam, lParam
End Function |
Partager