Hook و UnHook کردن پنجره برای مدیریت پیام های ویندوزی

Hook نقطه ای در مکانیزم مدیریت پیام سیستم است که در آن یک برنامه می تواند یک برنامه فرعی برای نظارت بر رفت و آمد پیام  در سیستم نصب کند و انواع خاصی از پیام ها را قبل از رسیدن به رویه ( Procedure )پنجره هدف پردازش نماید.

1- استفاده از تابع SetWindowsHookExA برای ویندوز 64 بیتی یا Vba7 این تابع 3 آرگومان دارد اولی یه ثابت است مثل WH_CBT=5 ( نصب یک رویه زنجیری که اعلان ها را دریافت می نماید CBTProc ) یا WH_MOUSE=7  ( نصب یک رویه که پیام های Mouse را مانیتور می کند MouseProc) دومین آرگومان یک تابع CallBack است وبا AddressOf  و نام تابع مشخص میگردد ، سومی hmod که Null است و چهارمین آرگومان شناسه یک Thread است که تابع GetCurrentThreadId  را در آن قرار می دهیم.( شناسه ی Thread یا رشته ای که با یک رویه Hook قرار است در ارتباط باشد.برای اپلیکیشن های دسکتاپ اگر این پارامتر صفر باشد رویه هوک مرتبط میشود با تمام Thread های در حال اجرا در دسکتاپ مشابه در زمان فراخوانی Thread )

2-درآمدن از زنجیره ی هوک با تابع UnHookWindowsHookEx که حتما باید انجام گیرد.

دقیقا توابع ویندوزی ( نوشتاری ) به حروف کوچک و بزرگ حساسند یا باید در کتابخانه مذکور موجود باشند.فرضا kernel32 باشد ولی user32 نوشته شود.اینها همه باعث خطا می شود.

Function HookWnd()

hhk=SetWindowsHookExA(WH_CBT,AddressOf CBTProc,0&,GetCurrentThreadId)

End Sub

Function CBTProc(Byval Msg As Long,Byval wParam As LongPtr,Byval lParam As LongPtr) As LongPtr

if Msg=5

'SetDlgItemTextA : Sets the title or text of a control in a dialog box.

UnHookWindowsHookEx hhk

End if

CBTProc=False

End Function

CallNextHookEx :

Passes the hook information to the next hook procedure in the current hook chain. A hook procedure can call this function either before or after processing the hook information.

LRESULT CallNextHookEx( [in, optional] HHOOK hhk, [in] int nCode, [in] WPARAM wParam, [in] LPARAM lParam );

Calling CallNextHookEx is optional, but it is highly recommended; otherwise, other applications that have installed hooks will not receive hook notifications and may behave incorrectly as a result. You should call CallNextHookEx unless you absolutely need to prevent the notification from being seen by other applications.

فراخوانی CallNextHookEx انتخابی است اما به شدت توصیه میشود ، در غیر اینصورت سایر برنامه هایی که hook یا قلاب ها را نصب کرده اند ( رویه های فرعی ) اعلان های hook را دریافت نخواهند کرد و ممکن است نتیجه نادرستی داشته باشند.بایستی این تابع فراخوانی شود ، مگر اینکه کاملا لازم باشد از مشاهده اعلان توسط سایر برنامه ها جلوگیری کنید.

'تغییر ویژگی پنجره مشخص شده 

LONG_PTR SetWindowLongPtrA( [in] HWND hWnd, [in] int nIndex, [in] LONG_PTR dwNewLong );

'SubClass Window

Public PreWnd As LongPtr

Public IsSubclassed As Boolean

Function SubClassWnd()

PrevWnd=SetWindowLongPtrA (hWnd,GWLP_WNDPROC,AddressOf WNDProc)

End Function

Function UnSubClassWnd()

if Not IsSubClassed Then 

SetWindowLongPtrA (hWnd,GWLP_WNDPROC,PrevWnd)

IsSubClassed=True

Me.Caption=SubClassed

Else

IsSubClassed=False

End If 

End Function

گرفتن نام کلاس پنجره با تابع زیر 

نام کلاس  جعبه پیام ویندوزی  32770# است

int GetClassNameA( [in] HWND hWnd, [out] LPSTR lpClassName, [in] int nMaxCount );

lpClassName:

variable  Buffer=String(35,vbNullChar)

nMaxCount:

Len(Buffer)

lRet=GetClassNameA(hWnd,Buffer,Len(Buffer)

If the function succeeds, the return value is the number of characters copied to the buffer, not including the terminating null character.

اگر تابع موفق عمل کند ، مقدار برگشتی ( integer : عدد صحیح ) عددی از کاراکترهای کپی شده به بافر است .بخاطر همین در بالا کاراکترهای خالی در حافظه موقت ایجاد شد

Char=Left(Buffer,lRet)

ارسال پیام به کنترل دیالوگ باکس :

SendDlgItemMessageA( [in] HWND hDlg, [in] int nIDDlgItem, [in] UINT Msg, [in] WPARAM wParam, [in] LPARAM lParam

HANDLE LoadImageA( [in, optional] HINSTANCE hInst, [in] LPCSTR name, [in] UINT type, [in] int cx, [in] int cy, [in] UINT fuLoad

fuLoad:LR_LOADFROMFILE=&H10

BM_SETIMAGE : &HF7 : 15×16+7=247

یک تصویر جدید ( icon یا bitmap ) را با باتن مرتبط می کند

wParam : IMAGE_BITMAP Or IMAGE_ICON

lParam : hBitmap Or hLoadImage Or HICON

h:Handle To

HICON LoadIconA( [in, optional] HINSTANCE hInstance, [in] LPCSTR lpIconName );

IDI_APPLICATION=32512
IDI_HAND=32513
IDI_QUESTION=32514
IDI_ASTERISK=32516

LoadIconA 0&,IDI_APPLICATION

USER32

Programs call functions from Windows USER to perform operations such as creating and managing windows, receiving window messages (which are mostly user input such as mouse and keyboard events, but also notifications from the operating system), displaying text in a window, and displaying message boxes.

برنامه ها توابع را از Windowse User برای اجرای عملیاتی مثل ایجاد یا مدیریت پنجره ها ، دریافت پیام های پنجره ( که کاربر وارد می کند مثل رویدادهای کیبورد و ماوس ، اما همچنین اعلان هایی از سیستم عملیاتی ) ، مشاهده متن در یک پنجره و مشاهده جعبه های پیام فراخوانی می نمایند.

• Hook Chains
• Hook Procedures
• Hook Types
• WH_CALLWNDPROC and WH_CALLWNDPROCRET
• WH_CBT
• WH_DEBUG
• WH_FOREGROUNDIDLE
• WH_GETMESSAGE
• WH_JOURNALPLAYBACK
• WH_JOURNALRECORD
• WH_KEYBOARD_LL
• WH_KEYBOARD
• WH_MOUSE_LL
• WH_MOUSE
• WH_MSGFILTER and WH_SYSMSGFILTER
• WH_SHELL

UINT_PTR SetTimer( [in, optional] HWND hWnd, [in] UINT_PTR nIDEvent, [in] UINT uElapse, [in, optional] TIMERPROC lpTimerFunc );

BOOL KillTimer( [in, optional] HWND hWnd, [in] UINT_PTR uIDEvent );

Creating a Timer.

'no timer callback

Private IDT_TIMER1 As Long

Private IDT_TIMER2 As Long

Sub StopClock()
 
    KillTimer 0, lTimerID
    lTimerID = 0
 
End Sub
 

SetTimer hwnd,IDT_TIMER1,10000,NULL
SetTimer hwnd,IDT_TIMER2,300000,NULL


Select Case Msg

'DECIMAL :1×16^(2)+1×16^(1)+3×16^(0)=275

'HEXADECIMAL : &H113

case WM_TIMER  '&H113
     Select Case wParam
         case IDT_TIMER1
            'process the 10-second timer
            'return 0
        case IDT_TIMER2
           'process the five-minute timer
           'return 0
End Select
End Select

تایمر بستن پنجره با کلاس 32770#

بسته شدن پنجره زمانیکه کپشن به عدد 10 رسید.

 : 64BIT

Declare PtrSafe Function SetTimer Lib "user32" Alias "SetTimer" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr

Declare PtrSafe Function KillTimer Lib "user32" Alias "KillTimer" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long

Private Const TIMER1 = 1001

SetTimer hWndMainWnd,TIMER1,1000,0

(WndProc(HWND hWnd,UINT uMsg,WPARAM 

Static xtimer

    Select Case uMsg

      xtimer=xtimer+1

    case WM_TIMER

        if wParam = TIMER1

          SetWindowTextA hwnd, xtimer

           If xtimer = 10 Then SendMessageA hwnd, WM_CLOSE, 0, 0: xtimer = 0

        End if 

عدم نمایش شورتکات در ادیت کنترل در ساب کلاس کردن  Case WM_CONTEXTMENU 

            Exit Function

    Case WM_DESTROY, WM_NCDESTROY

          KillTimer hwnd, TIMER1

          xtimer = 0

Source

Source

مورد بالا تست شده و طبق منبع اعمال گردیده

WM_MOUSEMOVE در Custom Draw Control

---

برگرفته از فروم خارجی 

Dim r As RECT

(HWND h=GetDlgItem(hwndDlg,IDC_YOURCTLID

GetWindowRect h, r ' get window rect of control relative to screen

POINT pt={r.left,r.top } 'new point object using rect x, y

Above means ->>>??? pt.x=r.left:pt.y=r.top '

ScreenToClient hwndDlg,pt ' convert screen co-ords to

 client based points

example if I wanted to move said control'

-MoveWindow h,pt.x,pt.y+15,r.right-r.left, r.bottom

(r.top,TRUE

 r.right - r.left, r.bottom - r.top to keep control at its '

current size

---

برگرفته از فروم خارجی

(void CMyButton::OnTimer(UINT nIDEvent

()DWORD GetMessagePos'

Point p(GetMessagePos

Dim p As PONIAPI And p=GetMessagePos ??? '

'BOOL ScreenToClient(HWND hWnd,LPPOINT lpPoint'

ScreenToClient hBtn ,p

(Get the bounds of the control (just the client area '
 CRect rect

(BOOL GetClientRect(HWND hWnd,LPRECT lpRect'

GetClientRect hBtn,rect

 Check the mouse is inside the control '

(BOOL PtInRect(const RECT *lprc,POINT pt'

if PtInRect(rect,p)<>0 Then

Else
 ...if not then stop looking '
m_bOverControl=FALSE

(BOOL KillTimer(HWND hWnd,UINT_PTR uIDEvent'

KillTimer lhwnd,m_nTimerID

 ...and redraw the control '
  InvalidateRect ? Or Redraw 

CButton::OnTimer(nIDEvent ??? '

Form Closing Timer ( تایمر بسته شدن فرم )

Timeinterval را در رویداد Open فرم می توانید روی 1000 میلی تنظیم کنید .

Side Bar ( سابفرم بازشو بصورت عرضی !!!... منبع جستجو در وب سایت خارجی سال 2004 animated popup )

TOGGLE BUTTON :  TRUE/FALSE

X تعداد تکرار است که حتما باید باشد فرضا  عرض سابفرم 2.4583 اینچ باشد که در ویوی فرم  اگر پراپرتی عرض سابفرم را بگیریم میشود 3540 به  واحد twips ( یعنی عدد پراپرتی عرض در  حالت دیزاین سابفرم که به اینچ داده را در 1440 ضرب کردیم  ،  گردش کنیم یا عدد صحیح آنرا در نظر بگیریم میشود 3540 به واحد twips ) حال باید بگوئیم چند واحد چند واحد به عرض سابفرم اضافه شود یا کسر شود ( تا زمانیکه کامل به عرض خود برسد یا صفر شود ) فرضا میخواهید زمانیکه که Toggle فشرده میشود 295 واحد ( twips ) به عرض قبلی اضافه شود و همینطور ادامه پیدا کند 295 واحد 295 واحد تا بعرض 3540 برسد لازمست که لوپی ایجاد شود و بگوئیم این لوپ چند بار انجام شود عدد 3540 تقسیم بر 295 میشود عدد 12 پس لوپ ما باید 12 بار تکرار شود از این رو در زیر متغیر X تعریف شده شما میتوانید نام متغیر را تغییر دهید. Timer اینجا نقشش مکث یا Pause است وگرنه در حالت لوپ X شما تغییرات را سریع می بینید و به یکباره ، ولی زمان استفاده از Timer با توجه به مکث در هر پارت شما تغییرات اضافه شدن عرض تا کامل شدن یا کسر شدن از عرض تا زمان به صفر رسیدن را با چشمان تیزبین خود خواهید دید مثل عکس پایین تر از عکس بیان خارجی عملکرد.

در رویداد کلیک Toggleباتن طبق تصویر  زیرین توسط دوستان خارجی چرا از پراپرتی Left سابفرم استفاده شده؟ چون  عرض گرفتن سابفرم به سمت راست آن است نه چپ یعنی زمانیکه شما به سابفرم عرض میدهید Left آن تغییر نمیکند از این رو زمانیکه شما میخواهید به عرضی که صفر است عدد بدهید باید بگوئید پراپرتی Left هم تغییر کند ... فرضا عرض سابفرم را صفر کرده اید و به  منتهی علیه سمت راست فرم اصلی برده اید اگر Left را منفی نکنید ( واحد به واحد )  چنانچه امتحان بنمائید به سمت راست عرض می گیرد در صورتیکه شما میخواهید سابفرم به سمت چپ بازشود لذا در حالیکه سابفرم طبق لوپ X عرض می گیرد آنهم واحد به واحد باید کاری کنید که Left آن هم به سمپ چپ فرم اصلی متمایل شود .... یعنی اگر Toggle فشرده شد مثبت 295 واحد به عرض سابفرم اضافه شود و از آنطرف منفی 295 واحد از عدد پراپرتی Left آن کسر گردد تا به سمت چپ کشیده شود و اگر Toggle به حالت اول برگردد عرض آن منفی 295 واحد شود و در اینجا به عدد پراپرتی Left آن مثبت 295 واحد اضافه شود.

حال که به نحوه ی عملکرد آن دست یافتید می توانید سابفرم بازشو ( با همراهی تابع Timer )  را برای خود یا دوستانتان تهیه کرده و یک مهارت به مهارت های دیگرتان اضافه کنید. کار سختی نبود یکم فکر کردن لازمه البته تسلط به عملکرد پراپرتیها در رسیدن به هدف Major Priority است. گذاشتن توضیحات کامل و تصاویر و منابع کار درستی نیست چون اینها کاری تجاری هستند و افراد می توانند از طریق همین دانسته ها کسب درآمد کنند ولی چون منابع خارجی هستند و از خودمان نیست  و آنها هم به اشتراک گذاشته اند لذا از نظر شرعی کاملا حلال است.

(Sub timeout(duration_ms As Double

Start_Time = Timer

Do

DoEvents

Loop Until (Timer - Start_Time) >= duration_ms

End Sub

()Private Sub Toggle4_Click

---

---

---

 Inside OnLoad Event Set The Width Of Subform to Zero  And the Left  Property Of Subform To the Left  

.Property Of Toggle Button Plus Its Width 

If Use ToggleButton would be better otherwise in case of using Command Button You Shall Declare A Variable As Boolean So That Manage Whether Button  

 Pressed

 You Can Use MouseDown  Event Of the MainForm to return back the subform if the toggle button was true, if  you did it you must define a boolean variable and set to true also in Toggle Click Event Write if the specified variable was true then toggle set to False And the end of the  code set it ( Variable ) to false

تایمر در توابع API

مربوط به 32 بیت 

Declare Function SetTimer Lib “user32” (ByVal hWnd As Long, ByVal nIDEvent_ As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Declare Function KillTimer Lib “user32” (ByVal hWnd As Long, _ ByVal nIDEvent As Long) As Long

Dim timerID As Long

Create a timer that sends a notification every 500'

milliseconds. 

(timerID = SetTimer(0, 0, 500, AddressOf Timer_CBK

Destroy the timer created previously '

KillTimer  0,timerID

Sub Timer_CBK(ByVal hWnd As Long, ByVal uMsg As Long, _ ByVal idEvent As Long, ByVal SysTime As Long)

 Just display the system time in a label control '

Form1.lblTimer = SysTime 

End Sub