Der folgende Code demonstriert, wie man mittels eines Hooks die InputBox$-Funktion um folgende Features erweitert:

1. optionale Angabe einer maximalen Länge des Eingabestrings (MaxLength)
2. optional kann die Anzeige der Eingabe unterdrückt werden (Password)
3. optional kann festgelegt werden, daß die Eingabe automatisch in Grossbuchstaben umgesetzt werden soll (UpperCase).

Der Code muss in ein Standard-Modul eingefügt werden.

Option Explicit

Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
  (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
  (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
Declare Function PostMessageByLong Lib "user32" Alias "PostMessageA" _
  (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
  (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
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
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Private MyHook As Long, MaxLen As Long, pwd As Boolean, upc As Boolean

  Type CWPSTRUCT
    lParam As Long
    wParam As Long
    Message As Long
    hwnd As Long
  End Type
            

Public Function InputBoxEx( _
  Prompt As String, Title As String, Optional Default, Optional xpos, Optional ypos, _
  Optional helpfile, Optional context, Optional MaxLength As Long = 0, _
  Optional Password As Boolean = False, Optional UpperCase As Boolean = False) As String

Dim s As String

Const WH_CALLWNDPROC& = 4
MaxLen = MaxLength
pwd = Password
upc = UpperCase
MyHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf InputBoxWndProc, 0&, App.ThreadID)
InputBoxEx = InputBox$(Prompt, Title, Default, xpos, ypos, helpfile, context)
End Function
            

Private Function InputBoxWndProc( _
  ByVal nCode As Long, ByVal wParam As Long, MyStruct As CWPSTRUCT) As Long

Const WM_CREATE& = &H1
Const GWL_STYLE& = (-16)
Const EM_SETLIMITTEXT = &HC5
Const EM_SETPASSWORDCHAR = &HCC
Const ES_UPPERCASE = &H8&

Dim s As String, i As Long

  If MyStruct.Message = WM_CREATE Then
  s = String$(255, 0)
  GetClassName MyStruct.hwnd, s, 256 'Klassennamen des Objekts feststellen
  i = InStr(s, vbNullChar)
  If i Then s = Left$(s, i - 1)
    If LCase$(s) = "edit" Then
    Call UnhookWindowsHookEx(MyHook)
    PostMessageByLong MyStruct.hwnd, EM_SETLIMITTEXT, MaxLen, 0&
      If pwd Then
      PostMessageByLong MyStruct.hwnd, EM_SETPASSWORDCHAR, CLng(Asc("*")), 0&
      End If
      If upc Then
      SetWindowLong MyStruct.hwnd, GWL_STYLE, GetWindowLong(MyStruct.hwnd, GWL_STYLE) Or ES_UPPERCASE
      End If
    End If
  End If
End Function
            

Als Beispiel zum Aufruf die Eingabe eines maximal achtstelligen Passwortes:

Dim x As String
x = InputBoxEx("Bitte Passwort eingeben:", "Passworteingabe", vbNullString, , , , , 8, True)
            

Nähere Ausführungen zum Thema Hooks findet man in dem Artikel "Die Sache mit dem Haken - Subclassing mit dem Windows-Hook" von Dr. Jürgen Thümmler in BasicPro 3/98, S. 46ff..