ALX_2002 писал(а):2 tyomitch: Шеф, если человек просит хук, это значит ему нужен именно хук, а не getwindowtext, о котором знают все![]()
![]()
На форме 2 текстовое поле и кнопка (Text1.Text, Text2.Text , Command1)
В модуль
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Const GWL_WNDPROC = (-4)
Dim PrevProc As Long
Dim hw As Long
Public Sub Hook(Byval wnd)
hw = FindWindow(vbNullString, "" & wnd)
If hw = 0 Then
MsgBox("ERROR")
Exit Sub
End If
PrevProc = SetWindowLong(hw, GWL_WNDPROC, AddressOf WinProc)
End Sub
Public Sub UnHoo()
SetWindowLong hw, GWL_WNDPROC, PrevProc
End Sub
Public Function WinProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Здесь свой код , какието действия
Form1.Text1.Text = "HOOK !" - к примеру
WinProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam) - вернули упр проги
End Function
В Форму
Private Sub Form_Unload(Cancel As Integer)
Call UnHook
End Sub
Private Sub Command1_Click()
Call Hook(Text2.Text)
End Sub
Да лень всем...
А чем тебя не устраивает DLL использовать, которая уже есть
В Модуль
Option Explicit
'misc API constants
Private Const WH_CBT = 5
Private Const GWL_HINSTANCE = (-6)
Private Const HCBT_ACTIVATE = 5
'UDT for passing data through the hook
Private Type MSGBOX_HOOK_PARAMS
hwndOwner As Long
hHook As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'need this declared at module level as
'it is used in the call and the hook proc
Private mhp As MSGBOX_HOOK_PARAMS
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function MessageBox Lib "user32" _
Alias "MessageBoxA" _
(ByVal hwnd As Long, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal wType As Long) 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 MoveWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal bRepaint As Long) As Long
Private Declare Function GetWindowRect Lib "user32" _
(ByVal hwnd As Long, _
lpRect As RECT) As Long
Public Function Msgbox(sPrompt As String, _
Optional dwStyle As Long, _
Optional sTitle As String) As Long
'replaces VB's built in MsgBox function in VB5/6
Dim hInstance As Long
Dim hThreadId As Long
If dwStyle = 0 Then dwStyle = vbOKOnly
If Len(sTitle) = 0 Then sTitle = "VBnet Messagebox Demo"
'Set up the hook
hInstance = GetWindowLong(Form1.hwnd, GWL_HINSTANCE)
hThreadId = GetCurrentThreadId()
'set up the MSGBOX_HOOK_PARAMS values
'By specifying a Windows hook as one
'of the params, we can intercept messages
'sent by Windows and thereby manipulate
'the dialog
With MHP
.hwndOwner = Form1.hwnd
.hHook = SetWindowsHookEx(WH_CBT, _
AddressOf MsgBoxHookProc, _
hInstance, hThreadId)
End With
'call the MessageBox API and return the
'value as the result of this function
Msgbox = MessageBox(Form1.hwnd, sPrompt, sTitle, dwStyle)
End Function
Public Function MsgBoxHookProc(ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim rc As RECT
'temporary vars for demo
Dim newLeft As Long
Dim newTop As Long
Dim dlgWidth As Long
Dim dlgHeight As Long
Dim scrWidth As Long
Dim scrHeight As Long
Dim frmLeft As Long
Dim frmTop As Long
Dim frmWidth As Long
Dim frmHeight As Long
Dim hwndMsgBox As Long
'When the message box is about to be shown,
'centre the dialog
If uMsg = HCBT_ACTIVATE Then
'in a HCBT_ACTIVATE message, wParam holds
'the handle to the messagebox
hwndMsgBox = wParam
'Just as was done in other API hook demos,
'position the dialog centered in the calling
'parent form
Call GetWindowRect(hwndMsgBox, rc)
frmLeft = Form1.Left \ Screen.TwipsPerPixelX
frmTop = Form1.Top \ Screen.TwipsPerPixelY
frmWidth = Form1.Width \ Screen.TwipsPerPixelX
frmHeight = Form1.Height \ Screen.TwipsPerPixelX
dlgWidth = rc.Right - rc.Left
dlgHeight = rc.Bottom - rc.Top
scrWidth = Screen.Width \ Screen.TwipsPerPixelX
scrHeight = Screen.Height \ Screen.TwipsPerPixelY
newLeft = frmLeft + ((frmWidth - dlgWidth) \ 2)
newTop = frmTop + ((frmHeight - dlgHeight) \ 2)
Call MoveWindow(hwndMsgBox, newLeft, newTop, dlgWidth, dlgHeight, True)
'done with the dialog so release the hook
UnhookWindowsHookEx MHP.hHook
End If
'return False to let normal
'processing continue
MsgBoxHookProc = False
End Function
В форму
Option Explicit
Private Sub Command1_Click()
'Display the API message box
Dim sTitle As String
Dim sPrompt As String
Dim dwStyle As Long
sTitle = "VBnet MessageBox Hook Demo"
sPrompt = "This is a demo of the MessageBox API showing how to hook" & vbCrLf & _
"the dialog and centre it with respect to the parent form."
dwStyle = vbAbortRetryIgnore Or vbInformation
Select Case Msgbox(sPrompt, dwStyle, sTitle)
Case vbRetry: Text1.Text = "Retry button pressed"
Case vbAbort: Text1.Text = "Abort button pressed"
Case vbIgnore: Text1.Text = "Ignore button pressed"
End Select
End Sub
MsgBox "Hello"
Сейчас этот форум просматривают: Yandex-бот и гости: 2