Форум программистов, компьютерный форум, киберфорум
The trick
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск  

Кликер

Запись от The trick размещена 16.12.2013 в 17:41
Показов 3553 Комментарии 0
Метки vb

Модуль:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
 ' © Кривоус Анатолий Анатольевич (The trick), 2013
Option Explicit
 
Public Type POINT
    X As Long
    Y As Long
End Type
Public Type MSLLHOOKSTRUCT
    pt As POINT
    mouseData As Long
    flags As Long
    time As Long
    dwExtraInfo As Long
End Type
 
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 CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
 
Private Const HC_ACTION = 0
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
 
Private Const WH_MOUSE_LL = &HE&
Private Const LLMHF_INJECTED = 1
 
Private hHook As Long
 
Public Sub StartHook()
    hHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf LowLevelMouseProc, App.hInstance, 0)
End Sub
Public Sub StopHook()
    UnhookWindowsHookEx hHook
End Sub
 
Public Function LowLevelMouseProc(ByVal uCode As Long, ByVal wParam As Long, lParam As MSLLHOOKSTRUCT) As Long
    Dim hs As MSLLHOOKSTRUCT
    If uCode = HC_ACTION Then
        If wParam = WM_LBUTTONDOWN Then         ' Нажатие
            CopyMemory hs, ByVal lParam, Len(hs)
            If Not CBool(hs.flags And LLMHF_INJECTED) Then
                Debug.Print "Real MouseDown"
                frmMain.tmrClick.Enabled = True
            End If
        ElseIf wParam = WM_LBUTTONUP Then       ' Отпускание
            CopyMemory hs, ByVal lParam, Len(hs)
            If Not CBool(hs.flags And LLMHF_INJECTED) Then
                Debug.Print "Real MouseUp"
                frmMain.tmrClick.Enabled = False
            End If
        End If
    End If
    LowLevelMouseProc = CallNextHookEx(hHook, uCode, wParam, lParam)
End Function
Форма с таймером:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Option Explicit
 
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
 
Private Const MOUSEEVENTF_LEFTDOWN = &H2 '  left button down
Private Const MOUSEEVENTF_LEFTUP = &H4 '  left button up
 
Private Sub Form_Load()
    StartHook
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    StopHook
End Sub
 
Private Sub tmrClick_Timer()
    mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
    mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub
Метки vb
Размещено в Без категории
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Всего комментариев 0
Комментарии
 
Новые блоги и статьи
Мобильное приложение ColorStep
pavlinmavlin 17.09.2026
Реализовал приложение Красный, Зеленый, Синий в Unity3d + c#. Название изменил на ColorStep. Приложение прошло модерацию и теперь доступно для скачивания. Делал его сам, шаг за шагом — и вот,. . .
Запрет дублирования строк в табличной части
Maks 13.09.2026
Реализация из решения ниже выполнена на нетиповом справочнике "Нормы ТО" с табличной часть "Виды ТО", разработанного в КА2, со следующими реквизитами: - ВидТО (СправочникСсылка. ВидыТО); - ВидГСМ. . .
Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр.
Jin X 06.09.2026
Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Работая с форумом и нейросетями в браузере часто хочется что-то подкорректировать или добавить какого-то функционала. Ниже прикреплён. . .
Программа опроса у.з. расходомера SLS-720F
Argus19 02.09.2026
Программа опроса у. з. расходомера SLS-720F Программа опрашивает один раз в минуту три ультразвуковых расходомера SLS-720F через интерфейс RS-485 по протоколу Modbus RTU. Опрашиваются регистры. . .
Hyper-V: Компьютер должен поддерживать доверенный платформенный модуль 2.0.
Maks 31.08.2026
При установке Windows 11 на виртуальную машину Hyper-V 2-го поколения вылезла такая ошибка: Решение: в параметрах виртуальной машины, в разделе "Безопасность" (Security) активировать флаг. . .
Архитектура биовида Стива в Майнкрафте: Зачем бонобо кубический каннибализм
anaschu 30.08.2026
Кубический Вагинокапитализм в Minecraft: Математический инвариант ОДУ и рок Стивов-бонобо Главная задача разработанной «Модели Всего» — наглядно продемонстрировать наличие системной «судьбы». . .
Оттачиваю умение писать js программы.
russiannick 30.08.2026
Проектом выходного дня стало написание Книги шифров Виженера. Итогом стала версия 200, синий туман. Синий туман назван так, потому что замораживает текст под собой. Нажатие синих кнопок управляют. . .
мат медиц модель 30. презентация проекта
anaschu 27.08.2026
хоп хоп хоп хидахоп, а я кладую))
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru