AW: Inputbox EIngaben als Stern
08.07.2010 18:40:31
Martin
Hallo Steffen,
ist nur relativ umständlich lösbar.
Viele Grüße
Martin
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("Bitte geben Sie den Code ein:")
' 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