VPF::Hook - Форум программистов

Vano-K

Дата 11.1.2005, 07:50 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 58
Регистрация: 4.4.2003
Где: Украина, Днепропе тровск

Репутация: нет
Всего: нет

Уважаемые программеры...
Я ищу распространенный пример Hook`a на мыш и клавиатуру. Их в инете полно, но есть одна проблема, все они используют какую, нибудь dll(без исходника), а мне нужно целолитой файл. Чтобы в итоге был только 1 файл и всё нормально работало. Программа должна работать как Key logger.
Если можно отправте мне на мыло [email protected] данный пример, или ссылочку, буду очень признателен.

Vano-K

Дата 14.1.2005, 04:55 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Так, с етим я разобрался(клавиатурой), но у мен возникла одна маленькая проблемка, я никак не могу найти нигде примера или инфы на Hook(мышку)(мне нужно ловить только нажатие левой кнопки мышки, а не её передвижение), но как и в предыдущем сообщении не использовать при этом не роднае библиотеки.

Люди, я вас очень прошу помогите рлз, проект полностью готов, можно отдавать, он полнофункциональный, но мне необходимо только этот маленький кусочек.

Нужно по зарез, горю, задыхаюсь...

Gannibal

Дата 14.1.2005, 20:29 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 742
Регистрация: 15.4.2003
Где: 010101

Репутация: 18
Всего: 17

Данный пример покажет, как можно установить глобальный хук на мышь, и ваша программа будет считать количество нажатий на клавиши мыши и на колесо прокрутки. Также ваша программа будет реагировать на нажатие любой клавиши клавиатуры.

Также данный пример в окне DEBUG располагает информацию о местоположении курсора.

Добавьте модуль в вашу программу и также расположите на форме 5 элементов TextBox.

Код


'КОД ФОРМЫ

Private Sub Form_Load()
Text1 = "0"
Text2 = "0"
Text3 = "0"
Text4 = "0"
Text5 = "0"
hHook = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf HookProc, 0, 0)
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call UnhookWindowsHookEx(hHook)
End Sub

'КОД МОДУЛЯ

Option Explicit
Public Type POINTAPI
x As Long
y As Long
End Type
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 CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal
lParam As Long) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)

Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_MBUTTONDOWN = &H207
Private Const WM_MBUTTONUP = &H208
Private Const WM_MBUTTONDBLCLK = &H209
Private Const WM_MOUSEWHEEL = &H20A
Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101

Public Const WH_JOURNALRECORD = 0

Type CBTACTIVATESTRUCT
fMouse As Long
hWndActive As Long
End Type
Dim CBT As CBTACTIVATESTRUCT
Public hHook As Long

Public Function HookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
CopyMemory CBT, ByVal lParam, Len(CBT)

Select Case CBT.fMouse
Case WM_MOUSEMOVE
Dim CurPos As POINTAPI
GetCursorPos CurPos
Debug.Print "Move at pos ", CurPos.x, CurPos.y

Case WM_KEYDOWN
Form1.Text5 = Form1.Text5 + 1
Case WM_KEYUP
Debug.Print "KeyUp"

Case WM_MOUSEWHEEL
Form1.Text4 = Form1.Text4 + 1

Case WM_LBUTTONDOWN
Form1.Text1 = Form1.Text1 + 1

Case WM_LBUTTONUP
Debug.Print "LeftUp"

Case WM_RBUTTONDOWN
Form1.Text3 = Form1.Text3 + 1

Case WM_RBUTTONUP
Debug.Print "RightUp"

Case WM_MBUTTONDOWN
Form1.Text2 = Form1.Text2 + 1

Case WM_MBUTTONUP
Debug.Print "MiddleUp"
End Select
HookProc = CallNextHookEx(hHook, nCode, wParam, lParam)
End Function

Это сообщение отредактировал(а) M.E.G.U.S - 14.1.2005, 20:30

--------------------

Я родился в этом безумном мире - и Я сделаю всё чтобы в нём выжить!

bom

Дата 14.1.2005, 22:41 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 329
Регистрация: 22.2.2004
Где: Казахстан, Алматы

Репутация: 4
Всего: 6

Vano-K

Цитата

мне нужно ловить только нажатие левой кнопки мышки

Код


Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Private Sub Timer1_Timer()
If GetAsyncKeyState(1) Then ' Левый клик мыши
End Sub

M.E.G.U.S
Насколько я знаю, без подключения библиотеки хуки на мышу и клаву не поставить smile

Gannibal

Дата 15.1.2005, 08:18 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 742
Регистрация: 15.4.2003
Где: 010101

Репутация: 18
Всего: 17

Цитата

M.E.G.U.S Насколько я знаю, без подключения библиотеки хуки на мышу и клаву не поставить

а причём здесь я? я вобощето об библиотеках незаикался ;)

--------------------

Я родился в этом безумном мире - и Я сделаю всё чтобы в нём выжить!

Guest

Дата 15.1.2005, 12:10 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

Цитата(M @ 15.1.2005, 08:18)

я вобощето об библиотеках незаикался ;)

Про чё и говорю: без выноса процедуры хука в отдельную библиотеку и динамического ее подключения из своей программы, глобальный хук на мышь и клаву из своей проги не поставишь. smile

Твой код от 14.1.2005, 20:29, кстати, у меня тоже не фунциклирует smile

bom

Дата 15.1.2005, 12:12 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 329
Регистрация: 22.2.2004
Где: Казахстан, Алматы

Репутация: 4
Всего: 6

Это был я

Gannibal

Дата 15.1.2005, 13:49 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 742
Регистрация: 15.4.2003
Где: 010101

Репутация: 18
Всего: 17

Цитата

Твой код от 14.1.2005, 20:29, кстати, у меня тоже не фунциклирует

код работает ;)

попробуй вот так

Код


Private Const MOUSEEVENTF_MOVE = &H1 
Private Const MOUSEEVENTF_ABSOLUTE = &H8000 
Private Const MOUSEEVENTF_LEFTDOWN = &H2 
Private Const MOUSEEVENTF_LEFTUP = &H4 

mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_MOVE, x, y, 0, 0 
mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_LEFTDOWN, x, y, 0, 0 
mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_LEFTUP, x, y, 0, 0

--------------------

Я родился в этом безумном мире - и Я сделаю всё чтобы в нём выжить!

Gannibal

Дата 15.1.2005, 14:06 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 742
Регистрация: 15.4.2003
Где: 010101

Репутация: 18
Всего: 17

вот переписал тот код который типо неработает smile

:Д на это смотрите.. пробуйте

Код


'КОД ФОРМЫ

Private Sub Form_Load()
SetHook
End Sub

Private Sub Form_Unload(Cancel As Integer)
RemoveHook
End Sub

'КОД МОДУЛЯ

Option Explicit

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 CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal
lParam As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)
Private Declare Function GetAsyncKeyState% Lib "user32" (ByVal vKey As Long)
Private Declare Function GetForegroundWindow& Lib "user32" ()
Private Declare Function GetWindowThreadProcessId& Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long)
Private Declare Function GetKeyboardLayout& Lib "user32" (ByVal dwLayout As Long)
Private Declare Function MapVirtualKeyEx Lib "user32" Alias "MapVirtualKeyExA" (ByVal uCode As Long, ByVal uMapType As Long,
 ByVal dwhkl As Long) As Long

Private Const WH_JOURNALRECORD = 0

Type EVENTMSG
     wMsg As Long
     lParamLow As Long
     lParamHigh As Long
     msgTime As Long
     hWndMsg As Long
End Type

Dim EMSG As EVENTMSG
Dim hHook As Long

Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_MBUTTONDOWN = &H207
Private Const WM_MBUTTONUP = &H208
Private Const WM_MBUTTONDBLCLK = &H209
Private Const WM_MOUSEWHEEL = &H20A



Public Function HookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim Char As Long
  If nCode < 0 Then
     HookProc = CallNextHookEx(hHook, nCode, wParam, lParam)
     Exit Function
  End If
  Dim i%, J%
  CopyMemory EMSG, ByVal lParam, Len(EMSG)
  Select Case EMSG.wMsg
    Case WM_LBUTTONUP
            frMMain.Caption = "WM_LBUTTONDBLCLK"
    Case WM_KEYUP
            If GetAsyncKeyState(vbKeyShift) Then J = 1
            If GetAsyncKeyState(vbKeyControl) Then J = 2
            If GetAsyncKeyState(vbKeyMenu) Then J = 4
            If (EMSG.lParamLow And &HFF) > 31 Then
                Char = MapVirtualKeyEx(EMSG.lParamLow And &HFF, 2, GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, 0)))
            Else
               Char = EMSG.lParamLow And &HFF
            End If
            frMMain.Text1 = frMMain.Text1 + Chr(Char)
  End Select
               

  Call CallNextHookEx(hHook, nCode, wParam, lParam)
End Function

Public Sub SetHook()
   hHook = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf HookProc, 0, 0)
End Sub

Public Sub RemoveHook()
   UnhookWindowsHookEx hHook
End Sub

--------------------

Я родился в этом безумном мире - и Я сделаю всё чтобы в нём выжить!

Exception

Дата 15.1.2005, 15:03 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 4525
Регистрация: 26.12.2004

Репутация: 7
Всего: 186

А разве чтоб работало её в отдельный dll выносить не надо? В смысле глоб. хук поставить надо её в длл выносить или я не прав?

bom

Дата 16.1.2005, 12:00 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 329
Регистрация: 22.2.2004
Где: Казахстан, Алматы

Репутация: 4
Всего: 6

Не работает не под каким соусом smile

Может кроме M.E.G.U.S у кого то еще работает, плиз откликнитесь smile

Exception

Дата 16.1.2005, 20:20 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 4525
Регистрация: 26.12.2004

Репутация: 7
Всего: 186

Цитата из одной умной книжки про вб и апи:

Цитата

Для этого процесс А ставит ловушку на события процесса Б. Но когда поток Б получает сообщение от мыши, вызывается ловушка процесса Б.
... Windows в процессе вызова процессом А SetWindowsHookEx сама заботится о месте ловушки в адресном пространстве. Но для этого ловушка должна находиться в DLL ...

имхо из этого всё понятно. Книжка - "Программирование в Win32 API на Visual Basic".

__Sergey__

Дата 19.1.2005, 03:25 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

В VB на уровне системы отслеживать мышь можно, но систем-хук на клаву нет.
Т.к. в VB-dll для этого не предназначена.

Exception

Дата 24.1.2005, 17:04 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 4525
Регистрация: 26.12.2004

Репутация: 7
Всего: 186

Цитата

В VB на уровне системы отслеживать мышь можно

Пример дай

__Sergey__

Дата 25.1.2005, 01:14 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 67
Регистрация: 21.1.2005

Репутация: 4
Всего: 4

На

Код


Begin VB.Form Form1 
   Caption         =   "Mouse Track"
   ClientHeight    =   2280
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   2280
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Start"
      Height          =   495
      Left            =   1200
      TabIndex        =   1
      Top             =   1440
      Width           =   2295
   End
   Begin VB.Label Label1 
      Caption         =   "Tracking the mouse."
      Height          =   615
      Left            =   360
      TabIndex        =   0
      Top             =   240
      Width           =   3855
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Option Explicit

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, _
    ByVal yPoint 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 Type POINTAPI
        X As Long
        Y As Long
End Type
Private gStop As Boolean

Private Sub Command1_Click()
Dim mousePT As POINTAPI
Dim prevWindow As Long, curWindow As Long
Dim X As Long, Y As Long
Dim className As String
Dim retValue As Long

    'Track mouse here
    If Command1.Caption = "Start" Then
        Command1.Caption = "Stop"
        gStop = False
        prevWindow = 0
        'Track until user stops
        Do
            'Stop tracking
            If gStop = True Then Exit Do
            Call GetCursorPos(mousePT)
            X = mousePT.X
            Y = mousePT.Y
            'Get window under mouse
            curWindow = WindowFromPoint(X, Y)
            If curWindow <> prevWindow Then
                className = String$(256, " ")
                prevWindow = curWindow
                retValue = GetClassName(curWindow, className, 255)
                className = Left$(className, InStr(className, vbNullChar) - 1)
                If className = "SysListView32" Then
                    Label1.Caption = "The mouse is over the desktop."
                Else
                    Label1.Caption = "The mouse is over " & className
                End If
            End If
            DoEvents
        Loop
    'Stop tracking the mouse
    Else
        Command1.Caption = "Start"
        gStop = True
    End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    gStop = True
End Sub

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| VB6 \| Следующая тема »