قلاب کردن InputBox برای ارسال پیام ویندوزی به آن HOOK /SUBCLASS

تست نشده ولی جواب خواهد داد توابع برای استفاده در Win32 است در Win64 نحوه ی اظهار توابع فرق میکند که در لینک توابع API  در [ پیوندها ] ،  نحوه ی صحیح آن در سایت خارجی درج شده.

Option Explicit 

Necessary constants  for hooking '

Private Const HCBT_ACTIVATE=5

Public Const WH_CBT=5 

Constants for password masking '

Public Const EM_SETPASSWORDCHAR= &HCC 

 Working variables that require global scope in hooking'

module 

Private hHook As Long 

 The API declarations we need 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 

Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Declare Function SendMessage Lib "user32" Alias

 SendMessageA" (ByVal hwnd As Long, ByVal wMsg"

As Long, ByVal wParam As Long, lParam As Any) As Long

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

Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long

Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long 

 Wrapper for the normal InputBox function'

Public Function vbInputBox(Prompt As String, Optional Title As String, Optional Default As String, Optional Xpos As Single, Optional YPos As Single, Optional Helpfile As String, Optional Context As Long) As String 

Optional Buttons As VbMsgBoxStyle = vbOKOnly,'

Optional Title As String, Optional HelpFile As String,' 

Optional Context As Long) As Long ,'

hHook=SetWindowsHookEx(WH_CBT, AddressOf 

(CBTProc,GetModuleHandle(vbNullString), 0

vbInputBox=InputBox(Prompt, Title, Default, Xpos, 

(YPos, Helpfile, Context)

 End Function

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

Dim hwndEditControl As Long 

If lMsg=HCBT_ACTIVATE And ClassName="#32770" Then

("","hwndEditControl=FindWindowEx(wParam,0,"Edit

 get the edit control'

If hwndEditControl Then

Do your stuff here to modify the window'

SendMessage hwndEditControl,

EM_SETPASSWORDCHAR, Asc("*"), 0,

Immediately unhook'

UnhookWindowsHookEx hHook

End If

'allow operation to continue'

CBTProc = 0

End Function

---

مثال دیگر از فروم خارجی 

Private Declare Function CallNextHookEx Lib "user32

ByVal hHook As Long,ByVal ncode As Long, ByVal)

wParam As Long, lParam As Any) As Long

Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) 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 UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _ ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

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

'Constants to be used in our API functions 

Private Const EM_SETPASSWORDCHAR =&HCC

Private Const WH_CBT=5

Private Const HCBT_ACTIVATE=5

Private Const HC_ACTION=0

Private hHook As Long 

Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim RetVal

If lngCode<HC_ACTION Then

(NewProc=CallNextHookEx(hHook,lngCode,wParam,lParam

Exit Function

End

If lngCode=HCBT_ACTIVATE Then

A window has been activated'

If ClassName="#32770" Then

Class name of the Inputbox'

 This changes the edit control'

SendDlgItemMessage wParam,&H1324, EM_SETPASSWORDCHAR,Asc("*"),&H0

End If

End If

CallNextHookEx hHook,lngCode,wParam, lParam

End Function

Function InputBoxDK(Prompt,Title) As String

Dim lngModHwnd As Long,lngThreadID As Long

lngThreadID=GetCurrentThreadId lngModHwnd 

(GetModuleHandle(vbNullString

hHook=SetWindowsHookEx(WH_CBT, AddressOf 

(NewProc,lngModHwnd,lngThreadID

(InputBoxDK=InputBox(Prompt,Title

UnhookWindowsHookEx hHook

End Function