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
| Option Explicit
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 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 FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Const WH_CBT As Long = 5
Private Const EM_SETPASSWORDCHAR As Long = &HCC
Private Const HCBT_ACTIVATE As Long = 5
Dim hHook As Long
Public Function ExInputBox(Prompt As String, Optional Title, Optional Default, _
Optional Xpos, Optional ypos, Optional HelpFile, Optional Context) As String
hHook = SetWindowsHookEx(WH_CBT, AddressOf InputBoxProc, App.hInstance, App.ThreadID()) ' Установка CBT хука
ExInputBox = InputBox(Prompt, Title, Default, Xpos, ypos, HelpFile, Context) ' Вызов InputBox'а
End Function
Private Function InputBoxProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long ' Процедура хука
If lMsg = HCBT_ACTIVATE Then ' При активации окна
Dim hEdit As Long ' Хендл текстбокса
hEdit = FindWindowEx(wParam, 0, "Edit", vbNullString) ' Ищем текстбокс
SendMessage hEdit, EM_SETPASSWORDCHAR, Asc("*"), ByVal 0 ' Устанавливаем текстбоксу стиль ввода пароля
UnhookWindowsHookEx hHook ' Отключаем хук
End If
End Function
Sub Main()
Debug.Print ExInputBox("Password") ' Проверка
End Sub |