Thomas Risi Softwareentwicklung
Addins - Datenbanklösungen - Komponenten - RTDServer - WebServices
Passwort in InputBox verschleiern
Aus einer Frage in einem Forum ...
In einer regulären VB/VBA-InputBox (InputBox-Funktion) kann man die Eingaben nicht maskieren, z.B. durch '*'. Damit ist die InputBox
zur Eingabe von Passwörtern wenig geeignet. Im WWW kursieren einige Bastlerlösungen mit API-Timer. Hier nun eine Lösung mit Hook ...
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 CallNextHookEx Lib "user32" ( _
ByVal hHook As Long, _
ByVal ncode As Long, _
ByVal wParam As Long, _
ByVal lParam As Any) 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 GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" ( _
ByVal hWnd As Long, _
ByRef lpdwProcessId As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Const WH_KEYBOARD = 2
Private Const HC_ACTION = 0
Private Const EM_SETPASSWORDCHAR = &HCC
Dim hHook As Long
Dim hThread As Long
Dim hWnd As Long
Dim IsHooked As Boolean
Sub test_inputboxhook()
Dim strPwd As String
SetKeyboardHook
strPwd = InputBox("TEST")
RemoveKeyboardHook
MsgBox strPwd
End Sub
Public Sub SetKeyboardHook()
If Not IsHooked Then
hWnd = GetForegroundWindow
hThread = GetWindowThreadProcessId(hWnd, 0)
If hThread Then _
hHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf WndKeyBoardProc, 0, hThread)
If hHook Then _
IsHooked = True
End If
End Sub
Public Sub RemoveKeyboardHook()
Dim RetVal As Long
RetVal = UnhookWindowsHookEx(hHook)
IsHooked = False
End Sub
Public Function WndKeyBoardProc(ByVal uCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If uCode >= 0 Then
Select Case uCode
Case HC_ACTION
Call SendMessage(FindWindowEx(GetForegroundWindow, 0, "Edit", ""), EM_SETPASSWORDCHAR, 42, lParam)
Case Else
End Select
End If
WndKeyBoardProc = CallNextHookEx(hHook, uCode, wParam, lParam)
End Function
© 2001 -
by Thomas Risi