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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
| Public Type MOUSEINPUT
dx As Long
dy As Long
mouseData As Long
dwFlags As Long
time As Long
dwExtraInfo As Long
End Type
Public Type INPUT_TYPE
dwType As Long
xi(0 To 23) As Byte
End Type
Public Const MOUSEEVENTF_ABSOLUTE = &H8000
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_MIDDLEDOWN = &H20
Public Const MOUSEEVENTF_MIDDLEUP = &H40
Public Const MOUSEEVENTF_MOVE = &H1
Public Const MOUSEEVENTF_RIGHTDOWN = &H8
Public Const MOUSEEVENTF_RIGHTUP = &H10
Public Const MOUSEEVENTF_WHEEL = &H80
Public Const MOUSEEVENTF_XDOWN = &H100
Public Const MOUSEEVENTF_XUP = &H200
Public Const WHEEL_DELTA = 120
Public Const XBUTTON1 = &H1
Public Const XBUTTON2 = &H2
Public Const INPUT_MOUSE = 0
Public Const SW_RESTORE = 9
Public Const SW_SHOW = 5
Public Declare Function SetForegroundWindow Lib "user32" ( _
ByVal hwnd As Long _
) As Long
Public Declare Function ShowWindow Lib "user32" ( _
ByVal hwnd As Long, _
ByVal nCmdShow As Long _
) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String _
) As Long
Public Declare Function SendInput Lib "user32" ( _
ByVal nInputs As Long, _
pInputs As INPUT_TYPE, _
ByVal cbSize As Long _
) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
Destination As Any, _
Source As Any, _
ByVal Length As Long _
)
Private Declare Function GetWindowThreadProcessId Lib "user32" ( _
ByVal hwnd As Long, _
lpdwProcessId As Long _
) As Long
Private Declare Function IsIconic Lib "user32" ( _
ByVal hwnd As Long _
) As Long
Private Declare Function AttachThreadInput Lib "user32" ( _
ByVal idAttach As Long, _
ByVal idAttachTo As Long, _
ByVal fAttach As Long _
) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Public Sub ClickLnRMouseButton(ProgramName As String)
'Rembo created this routine to demonstrate how you would send a left- and right mouse button
'click to a window (program).
Dim hWindow As Long
Dim inputevents(0 To 4) As INPUT_TYPE ' holds information about each mouse event:
' left button down/up and right button down/up
Dim mouseevent As MOUSEINPUT ' temporarily hold mouse input info
If FnSetForegroundWindow(ProgramName) Then
' Load the information needed to imitate pressing the left mouse button.
With mouseevent
.dx = 0 ' no horizontal movement
.dy = 0 ' no vertical movement
.mouseData = 0 ' not needed
.dwFlags = MOUSEEVENTF_RIGHTDOWN ' right button down
.time = 0 ' use the default
.dwExtraInfo = 0 ' not needed
End With
' And copy the structure into the input array's buffer.
inputevents(0).dwType = INPUT_MOUSE
CopyMemory inputevents(0).xi(0), mouseevent, Len(mouseevent)
' Do the same as above, but for releasing the left mouse button.
With mouseevent
.dx = 0 ' no horizontal movement
.dy = 0 ' no vertical movement
.mouseData = 0 ' not needed
.dwFlags = MOUSEEVENTF_RIGHTUP ' left button up
.time = 0 ' use the default
.dwExtraInfo = 0 ' not needed
End With
' And copy the structure into the input array's buffer.
inputevents(1).dwType = INPUT_MOUSE
CopyMemory inputevents(1).xi(0), mouseevent, Len(mouseevent)
' Load the information needed to imitate pressing the right mouse button.
With mouseevent
.dx = 10 ' no horizontal movement
.dy = 55 ' no vertical movement
.mouseData = 0 ' not needed
.dwFlags = MOUSEEVENTF_MOVE ' right button down
.time = 0 ' use the default
.dwExtraInfo = 0 ' not needed
End With
' And copy the structure into the input array's buffer.
inputevents(2).dwType = INPUT_MOUSE
CopyMemory inputevents(2).xi(0), mouseevent, Len(mouseevent)
' Load the information needed to imitate pressing the right mouse button.
With mouseevent
.dx = 0 ' no horizontal movement
.dy = 0 ' no vertical movement
.mouseData = 0 ' not needed
.dwFlags = MOUSEEVENTF_LEFTDOWN ' right button down
.time = 0 ' use the default
.dwExtraInfo = 0 ' not needed
End With
' And copy the structure into the input array's buffer.
inputevents(3).dwType = INPUT_MOUSE
CopyMemory inputevents(3).xi(0), mouseevent, Len(mouseevent)
' Do the same as above, but for releasing the right mouse button.
With mouseevent
.dx = 0 ' no horizontal movement
.dy = 0 ' no vertical movement
.mouseData = 0 ' not needed
.dwFlags = MOUSEEVENTF_LEFTUP ' right button up
.time = 0 ' use the default
.dwExtraInfo = 0 ' not needed
End With
' And copy the structure into the input array's buffer.
inputevents(4).dwType = INPUT_MOUSE
CopyMemory inputevents(4).xi(0), mouseevent, Len(mouseevent)
' Now that all the information for the four input events has been placed
' into the array, finally send it into the input stream.
'SendInput 4, inputevents(0), Len(inputevents(0))
SendInput 5, inputevents(0), Len(inputevents(0))
'SendInput 1, inputevents(1), Len(inputevents(1))
'SendInput 1, inputevents(2), Len(inputevents(2))
'SendInput 1, inputevents(3), Len(inputevents(3))
'SendInput 1, inputevents(4), Len(inputevents(4))
End If
'et voila...
End Sub
Public Function FnSetForegroundWindow(strWindowTitle As String) As Boolean
' Function code reproduced with permission from iTech Masters (http://www.everythingaccess.com)
' Written by Wayne Phillips, Copywrite 2005
Dim MyAppHWnd As Long
Dim CurrentForegroundThreadID As Long
Dim NewForegroundThreadID As Long
Dim lngRetVal As Long
Dim blnSuccessful As Boolean
'Get a handle on the Window you want to send the mouse clicks to
MyAppHWnd = FindWindow(vbNullString, strWindowTitle)
'If handle is found ...
If MyAppHWnd <> 0 Then
'Application window found by the caption
CurrentForegroundThreadID = GetWindowThreadProcessId(GetForegroundWindow(), ByVal 0&)
NewForegroundThreadID = GetWindowThreadProcessId(MyAppHWnd, ByVal 0&)
'AttachThreadInput is used to ensure SetForegroundWindow will work
'even if our application isn't currently the foreground window
'(e.g. an automated app running in the background)
Call AttachThreadInput(CurrentForegroundThreadID, NewForegroundThreadID, True)
lngRetVal = SetForegroundWindow(MyAppHWnd)
Call AttachThreadInput(CurrentForegroundThreadID, NewForegroundThreadID, False)
If lngRetVal <> 0 Then
'Now that the window is active, restore it from the taskbar if it's minimized
'or just show it if it's already opened.
If IsIconic(MyAppHWnd) Then
Call ShowWindow(MyAppHWnd, SW_RESTORE)
Else
Call ShowWindow(MyAppHWnd, SW_SHOW)
End If
blnSuccessful = True
Else
MsgBox "Found the window, but failed to bring it to the foreground!"
End If
Else
'Failed to find the window caption
'(the app is probably closed or the wrong window name is passed)
MsgBox "Application Window '" + strWindowTitle + "' not found!"
End If
FnSetForegroundWindow = blnSuccessful
End Function |
simulation de click droit et gauche
Répondre avec citation
Partager