Private Sub Form_Load()

Me.Caption = InputBoxEx("Наберите пароль:", "Программа...")

End Sub

Option Explicit

 

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 SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) 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 SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

 

Private Const WH_CBT = 5

Private Const HCBT_ACTIVATE = 5

Private m_lMsgHandle As Long

Private m_lhHook As Long

Private Const ES_CENTER = &H1&

 

Private Function GetMessageBoxHandle(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

If lMsg = HCBT_ACTIVATE Then

m_lMsgHandle = wParam

UnhookWindowsHookEx m_lhHook

m_lhHook = 0

End If

GetMessageBoxHandle = False

End Function

 

Private Sub InputBoxTimerUpdateEvent(hWnd As Long, uiMsg As Long, idEvent As Long, dwTime As Long)

Dim res As Long

If m_lMsgHandle = 0 Then Exit Sub

res = FindWindowEx(m_lMsgHandle, 0, "Edit", "")

SendMessage res, 1052, 42, ByVal 0&

SendMessage res, &H441, ES_CENTER, ByVal 0&

End Sub

 

Public Function InputBoxEx(sMsgText As String, Optional sTitle As String = "Secured InputBox") As String

Dim lTimerUpdate As Long

m_lhHook = SetWindowsHookEx(WH_CBT, AddressOf GetMessageBoxHandle, App.hInstance, GetCurrentThreadId)

lTimerUpdate = SetTimer(0, 0, 0, AddressOf InputBoxTimerUpdateEvent)

InputBoxEx = InputBox(sMsgText, sTitle)

KillTimer 0, lTimerUpdate

End Function