Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[3.145.201.71] |
|
Сообщ.
#1
,
|
|
|
Здравствуйте! Написал программу, которая устанавливает хук на своё приложение. Теперь хочу по аналогии сделать установку хука на другое приложение. Всё, что необходимо для начала - это отслеживать изменение размера окна, свёрнуто оно или развёрнуто, не ушёл ли с него фокус.
Попытался через CreateProcess сделать, но ничего не вышло. Вообще, необходимо любое приложение "хукать" (не только через CreateProcess), hWnd приложений все известны, как получить их hInstance и ThreadID я не знаю. Вопрос, как корректно вызвать эту функцию? hHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf Hook_Func, proc_info.dwProcessID, proc_info.dwThreadId) Если написать так, то всё работает идеально, только в рамках моего приложения, а мне нужно на чужое приложение поставить: hHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf Hook_Func, App.hInstance, App.ThreadID) Подскажите, пожалуйста, в чём ошибка у меня? Модуль: Option Explicit Public 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 Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal cb As Long) Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal iCode As Long, ByVal wParam As Long, lParam As Any) As Long Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Public Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Public Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long Public Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long Public Const WH_CALLWNDPROC = 4 Public Const WM_COMMAND = &H111 Public Const NORMAL_PRIORITY_CLASS = &H20& Public Const GW_HWNDNEXT = 2 Public Type STARTUPINFO cb As Long lpReserved As String lpDesktop As String lpTitle As String dwX As Long dwY As Long dwXSize As Long dwYSize As Long dwXCountChars As Long dwYCountChars As Long dwFillAttribute As Long dwFlags As Long wShowWindow As Integer cbReserved2 As Integer lpReserved2 As Long hStdInput As Long hStdOutput As Long hStdError As Long End Type Public Type PROCESS_INFORMATION hProcess As Long hThread As Long dwProcessID As Long dwThreadId As Long End Type Public Type CWPSTRUCT lParam As Long wParam As Long message As Long hWnd As Long End Type Public hHook As Long Public proc_info As PROCESS_INFORMATION Public Function StartHook() hHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf Hook_Func, proc_info.dwProcessID, proc_info.dwThreadId) End Function Public Sub StopHook() UnhookWindowsHookEx hHook End Sub Public Function Hook_Func(ByVal iCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim CWP As CWPSTRUCT CopyMemory CWP, ByVal lParam, Len(CWP) If CWP.message = WM_COMMAND Then Debug.Print CWP.wParam End If Hook_Func = CallNextHookEx(hHook, iCode, wParam, lParam) End Function Public Function ProcIDFromWnd(ByVal hWnd As Long) As Long Dim idProc As Long GetWindowThreadProcessId hWnd, idProc ProcIDFromWnd = idProc End Function Public Function hWndFromPID(ByVal hInstance As Long) As Long Dim tempHwnd As Long tempHwnd = FindWindow(vbNullString, vbNullString) Do Until tempHwnd = 0 If GetParent(tempHwnd) = 0 Then If hInstance = ProcIDFromWnd(tempHwnd) Then hWndFromPID = tempHwnd Exit Do End If End If tempHwnd = GetWindow(tempHwnd, GW_HWNDNEXT) Loop End Function Public Function ExecCmd(ByVal cmdline As String) As Long Dim start As STARTUPINFO Dim ret As Long Dim hWndApp As Long Dim x As Byte x = 0 start.cb = Len(start) ret = CreateProcess(0, cmdline, 0, 0, 1, NORMAL_PRIORITY_CLASS, 0, 0, start, proc_info) RTR: Sleep 50 hWndApp = hWndFromPID(proc_info.dwProcessID) If hWndApp > 0 Then ExecCmd = hWndApp Else If x = 5 Then GoTo EXT Else x = x + 1 GoTo RTR End If End If EXT: ExecCmd = hWndApp End Function Форма: Option Explicit Private Sub Command1_Click() Dim hWndApp As Long hWndApp = ExecCmd(App.Path & "\1.exe") If hWndApp > 0 Then StartHook Me.Caption = hWndApp & Chr(32) & hHook End Sub Private Sub Command2_Click() If hHook > 0 Then StopHook CloseHandle proc_info.hProcess End Sub Private Sub Form_Unload(Cancel As Integer) Command2_Click End Sub Прикреплённый файлhook.zip (5,35 Кбайт, скачиваний: 33) |
Сообщ.
#2
,
|
|
|
похоже, нашёл подходящее решение без DLL и TLB, буду пробовать: https://wasm.in/threads/gotovye-proekty-na-vb6.31728/
|
Сообщ.
#3
,
|
|
|
Цитата salieri @ Подскажите, пожалуйста, в чём ошибка у меня? Для глобального хука нужна DLL. В разделе есть реализации native-DLL на VB6 от SCINER-а и TheTrik, возможно, даже от Хакера. Поиск по "native DLL" и никам в помощь! Добавлено А это с другого форума http://bbs.vbstreets.ru/viewtopic.php?f=15&t=34902 |
Сообщ.
#4
,
|
|
|
Всё получилось! Действительно, всё работает без *.DLL, *.TLB. Авторский исходник (автор TheTrick) прикладываю к сообщению.
Прикреплённый файлMessageLog.zip (25,19 Кбайт, скачиваний: 160) |