Thomas Risi Softwareentwicklung

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() ' Ein String der Passwort übernimmt. Dim strPwd As String ' Den Hook setzen. SetKeyboardHook ' Aufruf einer InputBox und einlesen des Passwortes. strPwd = InputBox("TEST") ' Den Hook entfernen. RemoveKeyboardHook ' Ausgabe/Weiterverarbeitung des Passwortes. 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 ' Tue nichts ... End Select End If WndKeyBoardProc = CallNextHookEx(hHook, uCode, wParam, lParam) End Function

Bewerten Sie bitte dieses Programm.
1 2 3 4 5
Weniger nützlich Sehr nützlich
Bitte teilen Sie uns mit, warum Sie das Programm so bewertet haben. (optional)