[VB 2005] Interception touches

**pedro85** · 02/11/2007, 23h31

Bonjour à tous,
J'ai actuellement une souris sans fil qui a donc besoin de piles, parfois elle tombe en panne dans des moments fâcheux. J'ai donc décidé de me faire une petite appli simple qui me permettrai de déplacer la souris a partir du clavier le temps de recharger.
J'ai trouvé la technique pour déplacé la souris a partir du clavier, mais ca ne marche que lorsque ma form a le focus.
Je suppose qu'il faudrait intercepter tout ça au niveau du system ou bien de explorer mais je ne vois pas trop la technique.
J'ai bien cherché un pu partout avant de poster (

+

) et bien qued'autres avant moi ai posés ce genre de questions je n'ai pas trouvé de réponses claires ou même parfois pas du tout, il y a bien un article chez microsoft mais il ne s'applique pas a ma version(toutefois si quelqu'un qui s'y connait est capable de le retranscrire : http://support.microsoft.com/kb/468105/fr), j'ai donc pensé qu'il serait bien de clarifier cette affaire une fois pour toutes,

Voila
Merci d'avance.

**pedro85** · 02/11/2007, 23h48

Je viens de trouver aussi le

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

devices.keyboard

bien que je n'ai aucune idée de son utilisation sa peut peut-être servire?
Enfin j'dis ça j'dis rien...

**olsimare** · 03/11/2007, 00h05

Bonjour.

A mon avis, le code posté par morpheus doit t'aider :
http://forums.microsoft.com/MSDN-FR/...2990&SiteID=12

Sinon, le meilleur hook clavier/souris que j'ai trouvé se trouve ici :
http://www.colinneller.com/blog/Perm...e5918a39c.aspx

Avec ça, tu peux piloter la souris aprés avoir trappé les entrées clavier via le hook.

Cdt.

**pedro85** · 04/11/2007, 00h13

Envoyé par olsimare

Bonjour.

A mon avis, le code posté par morpheus doit t'aider :
http://forums.microsoft.com/MSDN-FR/...2990&SiteID=12

Sinon, le meilleur hook clavier/souris que j'ai trouvé se trouve ici :
http://www.colinneller.com/blog/Perm...e5918a39c.aspx

Avec ça, tu peux piloter la souris aprés avoir trappé les entrées clavier via le hook.

Cdt.

Bon alors voilà, j'ai essayé de suivre le raisonnement de ces deux la et de corriger les erreurs dûes aux différences de versions et ca me donne ces deux codes (je sais sa fait peur y'en a beaucoup) dans l'ordre ou vous me les avez donnés, et avec leurs erreurs,

Voila le premier:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Imports System.Runtime.InteropServices
 
Public Class Form1
 
    <Runtime.InteropServices.DllImport("user32.dll", SetLastError:=True)> Friend Shared Function SendInput(ByVal cInputs As Int32, ByRef pInputs As INPUT, ByVal cbSize As Int32) As Int32
 
    End Function
 
    <Runtime.InteropServices.StructLayout(Runtime.InteropServices.LayoutKind.Explicit, pack:=1, Size:=28)> Friend Structure INPUT
 
        <Runtime.InteropServices.FieldOffset(0)> Public dwType As InputType
 
        <Runtime.InteropServices.FieldOffset(4)> Public mi As MOUSEINPUT
 
        <Runtime.InteropServices.FieldOffset(4)> Public ki As KEYBDINPUT
 
        <Runtime.InteropServices.FieldOffset(4)> Public hi As HARDWAREINPUT
 
    End Structure
 
    <Runtime.InteropServices.StructLayout(Runtime.InteropServices.LayoutKind.Sequential, pack:=1)> Friend Structure MOUSEINPUT
 
        Public dx As Int32
 
        Public dy As Int32
 
        Public mouseData As Int32
 
        Public dwFlags As MOUSEEVENTF
 
        Public time As Int32
 
        Public dwExtraInfo As IntPtr
 
    End Structure
 
    <Runtime.InteropServices.StructLayout(Runtime.InteropServices.LayoutKind.Sequential, pack:=1)> Friend Structure KEYBDINPUT
 
        Public wVk As Int16
 
        Public wScan As Int16
 
        Public dwFlags As KEYEVENTF
 
        Public time As Int32
 
        Public dwExtraInfo As IntPtr
 
    End Structure
 
    <Runtime.InteropServices.StructLayout(Runtime.InteropServices.LayoutKind.Sequential, pack:=1)> Friend Structure HARDWAREINPUT
 
        Public uMsg As Int32
 
        Public wParamL As Int16
 
        Public wParamH As Int16
 
    End Structure
 
    Friend Enum InputType As Integer
 
        Mouse = 0
 
        Keyboard = 1
 
        Hardware = 2
 
    End Enum
 
    <Flags()> Friend Enum MOUSEEVENTF As Integer
 
        MOVE = &H1
 
        LEFTDOWN = &H2
 
        LEFTUP = &H4
 
        RIGHTDOWN = &H8
 
        RIGHTUP = &H10
 
        MIDDLEDOWN = &H20
 
        MIDDLEUP = &H40
 
        XDOWN = &H80
 
        XUP = &H100
 
        VIRTUALDESK = &H400
 
        WHEEL = &H800
 
        ABSOLUTE = &H8000
 
    End Enum
 
    <Flags()> Friend Enum KEYEVENTF As Integer
 
        EXTENDEDKEY = 1
 
        KEYUP = 2
 
        [UNICODE] = 4
 
        SCANCODE = 8
 
    End Enum
 
 
 
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
 
    End Sub
 
    Private Sub but1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button1.Click
 
        Dim message As String = "HELLO WORLD"
 
        For Each c As Char In message
 
            Dim key As UInteger = Convert.ToInt16(c)
 
            DoKeyBoard(0, key) ' key down is 0 - no flag...
 
            DoKeyBoard(NativeMethods.KEYEVENTF.KEYUP, key)
 
        Next
 
        DoKeyBoard(0, Keys.Decimal) ' example using keys enum which I think matches the VKEY values
 
        DoKeyBoard(NativeMethods.KEYEVENTF.KEYUP, Keys.Decimal)
 
    End Sub
 
End Class

ERREURS :
"Le nom 'DoKeyBoards' n'est pas déclaré"
"le nom 'NativeMethods' n'est pas déclaré"

Et voila le deuxième:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
Imports System.Runtime.InteropServices
 
Imports System.Windows.Forms
 
 
 
Public Class GlobalHook : Implements IDisposable
 
 
 
    Public Event MouseDown As MouseEventHandler
 
    Public Event MouseMove As MouseEventHandler
 
    Public Event MouseUp As MouseEventHandler
 
    Public Event MouseWheel As MouseEventHandler
 
 
 
    Public Event KeyDown As KeyEventHandler
 
    Public Event KeyPress As KeyPressEventHandler
 
    Public Event KeyUp As KeyEventHandler
 
 
 
#Region " CTOR/DTOR "
 
 
 
    Public Sub New()
 
        InstallHooks()
 
    End Sub
 
 
 
    Protected Overrides Sub Finalize()
 
        Dispose()
 
        MyBase.Finalize()
 
    End Sub
 
 
 
    Public Sub Dispose() Implements System.IDisposable.Dispose
 
        RemoveHooks()
 
    End Sub
 
 
 
#End Region
 
 
 
#Region " PROTECTED OnXXXX SUBS "
 
 
 
    Protected Overridable Sub OnMouseDown(ByVal e As MouseEventArgs)
 
        'Debug.WriteLine("OnMouseDown")
 
        RaiseEvent MouseDown(Me, e)
 
    End Sub
 
 
 
    Protected Overridable Sub OnMouseMove(ByVal e As MouseEventArgs)
 
        'Debug.WriteLine("OnMouseMove")
 
        RaiseEvent MouseMove(Me, e)
 
    End Sub
 
 
 
    Protected Overridable Sub OnMouseUp(ByVal e As MouseEventArgs)
 
        'Debug.WriteLine("OnMouseUp")
 
        RaiseEvent MouseUp(Me, e)
 
    End Sub
 
 
 
    Protected Overridable Sub OnMouseWheel(ByVal e As MouseEventArgs)
 
        'Debug.WriteLine("OnMouseWheel")
 
        RaiseEvent MouseWheel(Me, e)
 
    End Sub
 
 
 
    Protected Overridable Sub OnKeyDown(ByVal e As KeyEventArgs)
 
        'Debug.WriteLine("OnKeyDown")
 
        For Each handler As KeyEventHandler In KeyDownEvent.GetInvocationList
 
            handler.Invoke(Me, e)
 
            If e.Handled Then
 
                Exit For
 
            End If
 
        Next
 
    End Sub
 
 
 
    Protected Overridable Sub OnKeyUp(ByVal sender As Object, ByVal e As KeyEventArgs)
 
        'Debug.WriteLine("OnKeyUp")
 
        For Each handler As KeyEventHandler In KeyUpEvent.GetInvocationList
 
            handler.Invoke(Me, e)
 
            If e.Handled Then
 
                Exit For
 
            End If
 
        Next
 
    End Sub
 
 
 
    Protected Overridable Sub OnKeyPress(ByVal sender As Object, ByVal e As KeyPressEventArgs)
 
        'Debug.WriteLine("OnKeyPress")
 
        For Each handler As KeyPressEventHandler In KeyPressEvent.GetInvocationList
 
            handler.Invoke(Me, e)
 
            If e.Handled Then
 
                Exit For
 
            End If
 
        Next
 
    End Sub
 
 
 
#End Region
 
 
 
    Private Shared hMouseHook As Integer = 0
 
    Private Shared hKeyboardHook As Integer = 0
 
 
 
    Private MouseHookProcedure As Win32.HookProc
 
    Private KeyboardHookProcedure As Win32.HookProc
 
 
 
    Public Sub InstallHooks()
 
        If hMouseHook = 0 Then
 
            MouseHookProcedure = New Win32.HookProc(AddressOf MouseHookProc)
 
 
 
            hMouseHook = Win32.SetWindowsHookEx(Win32.WH.WH_MOUSE_LL, MouseHookProcedure,Marshal.GetHINSTANCE(Reflection.Assembly.GetExecutingAssembly().GetModules()(0)),0)
 
 
            If hMouseHook = 0 Then 'SetWindowsHookEx failed
 
                RemoveHooks()
 
                Throw New Exception("SetWindowsHookEx failed.")
 
            End If
 
        End If
 
 
 
        If hKeyboardHook = 0 Then ' install Keyboard hook 
 
            KeyboardHookProcedure = New Win32.HookProc(AddressOf KeyboardHookProc)
 
            hKeyboardHook = Win32.SetWindowsHookEx(Win32.WH.WH_KEYBOARD_LL,KeyboardHookProcedure,Marshal.GetHINSTANCE(Reflection.Assembly.GetExecutingAssembly().GetModules()(0)),0)
 
 
 
            If (hKeyboardHook = 0) Then 'SetWindowsHookEx failed
 
                RemoveHooks()
 
                Throw New Exception("SetWindowsHookEx failed.")
 
            End If
 
        End If
 
    End Sub
 
 
 
    Public Sub RemoveHooks()
 
        Dim mouseResult As Boolean = True
 
        Dim keyboardResult As Boolean = True
 
 
 
        If hMouseHook <> 0 Then
 
            mouseResult = Win32.UnhookWindowsHookEx(hMouseHook)
 
            hMouseHook = 0
 
        End If
 
 
 
        If hKeyboardHook <> 0 Then
 
            keyboardResult = Win32.UnhookWindowsHookEx(hKeyboardHook)
 
            hKeyboardHook = 0
 
        End If
 
 
 
        If Not (mouseResult And keyboardResult) Then 'UnhookWindowsHookEx failed
 
            Throw New Exception("UnhookWindowsHookEx failed.")
 
        End If
 
    End Sub
 
 
 
    Private Function MouseHookProc(ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer
 
        If nCode >= 0 Then
 
            Select Case wParam
 
                Case Win32.WM.WM_LBUTTONDOWN,Win32.WM.WM_LBUTTONDBLCLK,Win32.WM.WM_MBUTTONDOWN,Win32.WM.WM_MBUTTONDBLCLK,Win32.WM.WM_RBUTTONDOWN,Win32.WM.WM_RBUTTONDBLCLK,Win32.WM.WM_XBUTTONDOWN,Win32.WM.WM_XBUTTONDBLCLK()
 
                    If MouseDownEvent Is Nothing Then
 
                        Win32.CallNextHookEx(hMouseHook, nCode, wParam, lParam)
 
                        Exit Function
 
                    End If
 
                Case Win32.WM.WM_LBUTTONUP, Win32.WM.WM_MBUTTONUP, Win32.WM.WM_RBUTTONUP, Win32.WM.WM_XBUTTONUP()
 
                    If MouseUpEvent Is Nothing Then
 
                        Win32.CallNextHookEx(hMouseHook, nCode, wParam, lParam)
 
                        Exit Function
 
                    End If
 
 
 
                Case Win32.WM.WM_MOUSEWHEEL
 
                    If MouseWheelEvent Is Nothing Then
 
                        Win32.CallNextHookEx(hMouseHook, nCode, wParam, lParam)
 
                        Exit Function
 
                    End If
 
 
 
                Case Win32.WM.WM_MOUSEMOVE
 
                    If MouseMoveEvent Is Nothing Then
 
                        Win32.CallNextHookEx(hMouseHook, nCode, wParam, lParam)
 
                        Exit Function
 
                    End If
 
            End Select
 
 
 
            Dim clickCount As Integer = 0
 
            Dim buttons As MouseButtons = MouseButtons.None
 
            Dim mhs As New Win32.MSLLHOOKSTRUCT
 
            Dim hiWord As Integer
 
            Dim delta As Integer = 0
 
 
 
            Marshal.PtrToStructure(lParam, mhs)
 
            hiWord = Win32.HIWORD(mhs.mouseData)
 
 
 
            Select Case (wParam)
 
                Case Win32.WM.WM_LBUTTONDOWN, Win32.WM.WM_LBUTTONUP, Win32.WM.WM_LBUTTONDBLCLK()
 
                    buttons = MouseButtons.Left
 
 
 
                Case Win32.WM.WM_MBUTTONDOWN, Win32.WM.WM_MBUTTONUP, Win32.WM.WM_MBUTTONDBLCLK()
 
                    buttons = MouseButtons.Middle
 
 
 
                Case Win32.WM.WM_RBUTTONDOWN, Win32.WM.WM_RBUTTONUP, Win32.WM.WM_RBUTTONDBLCLK()
 
                    buttons = MouseButtons.Right
 
 
 
                Case Win32.WM.WM_XBUTTONDOWN, Win32.WM.WM_XBUTTONUP, Win32.WM.WM_XBUTTONDBLCLK, Win32.WM.WM_NCXBUTTONDOWN, Win32.WM.WM_NCXBUTTONUP, Win32.WM.WM_NCXBUTTONDBLCLK()
 
 
 
                    If hiWord = 1 Then
 
                        buttons = MouseButtons.XButton1
 
                    ElseIf hiWord = 2 Then
 
                        buttons = MouseButtons.XButton2
 
                    End If
 
 
 
                Case Win32.WM.WM_MOUSEWHEEL
 
                    delta = hiWord
 
 
 
            End Select
 
 
 
            If buttons <> MouseButtons.None Then
 
                Select Case wParam
 
                    Case Win32.WM.WM_LBUTTONDBLCLK, Win32.WM.WM_MBUTTONDBLCLK, Win32.WM.WM_RBUTTONDBLCLK, Win32.WM.WM_XBUTTONDBLCLK()
 
                        clickCount = 2
 
                    Case Else
 
                        clickCount = 1
 
                End Select
 
            End If
 
 
 
            Dim e As New MouseEventArgs(buttons, clickCount, mhs.pt.X, mhs.pt.Y, delta)
 
 
 
            Select Case wParam
 
                Case Win32.WM.WM_LBUTTONDOWN, Win32.WM.WM_LBUTTONDBLCLK, Win32.WM.WM_MBUTTONDOWN, Win32.WM.WM_MBUTTONDBLCLK, Win32.WM.WM_RBUTTONDOWN, Win32.WM.WM_RBUTTONDBLCLK, Win32.WM.WM_XBUTTONDOWN, Win32.WM.WM_XBUTTONDBLCLK()
 
                    OnMouseDown(e)
 
                Case Win32.WM.WM_LBUTTONUP, Win32.WM.WM_MBUTTONUP, Win32.WM.WM_RBUTTONUP, Win32.WM.WM_XBUTTONUP()
 
                    OnMouseUp(e)
 
 
 
                Case Win32.WM.WM_MOUSEWHEEL
 
                    OnMouseWheel(e)
 
 
 
                Case Win32.WM.WM_MOUSEMOVE
 
                    OnMouseMove(e)
 
            End Select
 
        End If
 
 
 
        Return Win32.CallNextHookEx(hMouseHook, nCode, wParam, lParam)
 
    End Function
 
 
 
    Private Function KeyboardHookProc(ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer
 
        Dim handled As Boolean = False
 
 
 
        If nCode >= 0 Then
 
            Dim khs As Win32.KeyboardHookStruct
 
            Dim keyState(256) As Byte
 
            Dim inBuffer(2) As Byte
 
            Dim ctrl, alt, shift As Keys
 
 
 
            If Not (KeyDownEvent Is Nothing) Then
 
            AndAlso (wParam = Win32.WM.WM_KEYDOWN Or wParam = Win32.WM.WM_SYSKEYDOWN) Then
 
                khs = New Win32.KeyboardHookStruct
 
                Marshal.PtrToStructure(lParam, khs)
 
                Dim keyData As Keys = CType(khs.vkCode, Keys)
 
                Win32.GetKeyboardState(keyState)
 
 
 
                If Win32.IsKeyDown(Keys.ControlKey) Then
 
                    ctrl = Keys.Control
 
                End If
 
                If Win32.IsKeyDown(Keys.Menu) Then
 
                    alt = Keys.Alt
 
                End If
 
                If Win32.IsKeyDown(Keys.ShiftKey) Then
 
                    shift = Keys.Shift
 
                End If
 
 
 
                Dim e As New KeyEventArgs(keyData Or ctrl Or alt Or shift)
 
                OnKeyDown(e)
 
                handled = e.Handled
 
 
 
                If Not handled And wParam <> Win32.WM.WM_SYSKEYDOWN Then
 
                    If Win32.ToAscii(khs.vkCode, khs.scanCode, keyState, inBuffer, khs.flags) > 0 Then
 
                        Dim args As New KeyPressEventArgs(BitConverter.ToChar(inBuffer, 0))
 
                        OnKeyPress(Me, args)
 
                        handled = e.Handled
 
                    End If
 
                End If
 
            End If
 
 
 
            If Not (KeyUpEvent Is Nothing) Then
 
            AndAlso (wParam = Win32.WM.WM_KEYUP Or wParam = Win32.WM.WM_SYSKEYUP) Then
 
                If khs Is Nothing Then
 
                    khs = New Win32.KeyboardHookStruct
 
                    Marshal.PtrToStructure(lParam, khs)
 
                End If
 
 
 
                Dim keyData As Keys = CType(khs.vkCode, Keys)
 
                Dim e As New KeyEventArgs(keyData)
 
                OnKeyUp(Me, e)
 
                handled = e.Handled
 
            End If
 
        End If
 
 
 
        If handled Then
 
            Return -1
 
        Else
 
            Return Win32.CallNextHookEx(hKeyboardHook, nCode, wParam, lParam)
 
        End If
 
    End Function
 
 
 
End Class

ERREURS:
"Le nom 'Win32' n'est pas déclaré"
"Type 'Win32.HookProc' non défini"
"Type 'Win32.KeyboardHookStruct' non défini"
"Type 'Win32.MSLLHOOKSTRUCT' non défini"

Je suppose qu'il doit falloir remplacer toutes ces expressions par leur équivalent en VB2005 Express Edition.
???

A force de recherches j'en suis arrivé a la conclusion que c'est bien l'api 'SetWindowsHookEx' qu'il faut utiliser mais malgré tous les exemples de codes je n'arrive pas à cerner le principe, et d'ailleurs en fait c'est quoi exactement une api?
Désolé de mon ignorance mais j'avoue que la je commence a nager un peu dans tous ces termes a assimiler en même temps.

**olsimare** · 04/11/2007, 01h01

Bonjour.

Ben non, y'a pas d'erreur du aux versions ou autre...

c'est que pour le premier post, il faut encapsuler la fin du code dans une classe NativeMethods et dans le deuxiéme, normalement, tu as une class win32 qui encapsule toutes les méthodes liées aux API.

API = Application Programming Interface.

Passer par les API dans notre contexte --> utiliser des fonctions mises à disposition par l'OS (ici windows) non managées par le framework.
Ex : positionner un hook souris en framework 2.0 n'est pas possible via les class mises à dispo, d'où passage obligé par du code non managé et les API.

Cdt.

**pedro85** · 08/11/2007, 22h40

Donc voila ce que ça donne en clair pour le premier:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Imports System.Runtime.InteropServices
 
Public Class Form1
 
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
 
    End Sub
 
    Private tb As New TextBox
    Private WithEvents but1 As New Button
 
    Sub New()
        InitializeComponent()
        tb = New TextBox : tb.Location = New Point(10, 10)
        but1 = New Button : but1.Location = New Point(10, 40)
        but1.Text = "example"
        Me.Controls.Add(but1) : Me.Controls.Add(tb)
    End Sub
 
    Private Sub DoMouse(ByVal flags As NativeMethods.MOUSEEVENTF, ByVal newPoint As Point)
        Dim input As New NativeMethods.INPUT
        Dim mi As New NativeMethods.MOUSEINPUT
        input.dwType = NativeMethods.InputType.Mouse
        input.mi = mi
        input.mi.dwExtraInfo = IntPtr.Zero
        ' mouse co-ords: top left is (0,0), bottom right is (65535, 65535)
        ' convert screen co-ord to mouse co-ords...
        input.mi.dx = newPoint.X * (65535 / Screen.PrimaryScreen.Bounds.Width)
        input.mi.dy = newPoint.Y * (65535 / Screen.PrimaryScreen.Bounds.Height)
        input.mi.time = 0
        input.mi.mouseData = 0  ' can be used for WHEEL event see msdn
        input.mi.dwFlags = flags
        Dim cbSize As Integer = Marshal.SizeOf(GetType(NativeMethods.INPUT))
        Dim result As Integer = NativeMethods.SendInput(1, input, cbSize)
        If result = 0 Then Debug.WriteLine(Marshal.GetLastWin32Error)
    End Sub
 
    Private Sub DoKeyBoard(ByVal flags As NativeMethods.KEYEVENTF, ByVal key As Keys)
        Dim input As New NativeMethods.INPUT
        Dim ki As New NativeMethods.KEYBDINPUT
        input.dwType = NativeMethods.InputType.Keyboard
        input.ki = ki
        input.ki.wVk = Convert.ToInt16(key)
        input.ki.wScan = 0
        input.ki.time = 0
        input.ki.dwFlags = flags
        input.ki.dwExtraInfo = IntPtr.Zero
        Dim cbSize As Integer = Marshal.SizeOf(GetType(NativeMethods.INPUT))
        Dim result As Integer = NativeMethods.SendInput(1, input, cbSize)
        If result = 0 Then Debug.WriteLine(Marshal.GetLastWin32Error)
    End Sub
 
    Private Sub but1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles but1.Click
        'move to the textbox, click it to focus, keydown some chars...
        ' get textbox location in screen co-ords
        Dim tbLocation As Point = Me.PointToScreen(Me.tb.Location)
        ' nudge it into the tb
        tbLocation.X += 5
        tbLocation.Y += 5
        ' move to the TB. it is a MOVE event, and we use ABSOLUTE co-ordinates
        DoMouse(NativeMethods.MOUSEEVENTF.MOVE Or NativeMethods.MOUSEEVENTF.ABSOLUTE, tbLocation)
        ' click the TB
        DoMouse(NativeMethods.MOUSEEVENTF.LEFTDOWN, New Point(0, 0))
        ' release the mouse
        DoMouse(NativeMethods.MOUSEEVENTF.LEFTUP, New Point(0, 0))
        ' the key codes are virtual keycodes (see mdsn)
        ' I'm using a shortcut to save space - casting chars to ints
        ' if you want to change case, you need to send a shift key with the letter...
        Dim message As String = "HELLO WORLD"
        For Each c As Char In message
            Dim key As UInteger = Convert.ToInt16(c)
            DoKeyBoard(0, key)  ' key down is 0 - no flag...
            DoKeyBoard(NativeMethods.KEYEVENTF.KEYUP, key)
        Next
        DoKeyBoard(0, Keys.Decimal) ' example using keys enum which I think matches the VKEY values
        DoKeyBoard(NativeMethods.KEYEVENTF.KEYUP, Keys.Decimal)
    End Sub
 
End Class
Public Class NativeMethods
 
    <DllImport("user32.dll", SetLastError:=True)> _
        Friend Shared Function SendInput(ByVal cInputs As Int32, ByRef pInputs As INPUT, ByVal cbSize As Int32) As Int32
    End Function
 
    <StructLayout(LayoutKind.Explicit, pack:=1, Size:=28)> _
    Friend Structure INPUT
        <FieldOffset(0)> Public dwType As InputType
        <FieldOffset(4)> Public mi As MOUSEINPUT
        <FieldOffset(4)> Public ki As KEYBDINPUT
        <FieldOffset(4)> Public hi As HARDWAREINPUT
    End Structure
 
    <StructLayout(LayoutKind.Sequential, pack:=1)> _
    Friend Structure MOUSEINPUT
        Public dx As Int32
        Public dy As Int32
        Public mouseData As Int32
        Public dwFlags As MOUSEEVENTF
        Public time As Int32
        Public dwExtraInfo As IntPtr
    End Structure
 
    <StructLayout(LayoutKind.Sequential, pack:=1)> _
    Friend Structure KEYBDINPUT
        Public wVk As Int16
        Public wScan As Int16
        Public dwFlags As KEYEVENTF
        Public time As Int32
        Public dwExtraInfo As IntPtr
    End Structure
 
    <StructLayout(LayoutKind.Sequential, pack:=1)> _
    Friend Structure HARDWAREINPUT
        Public uMsg As Int32
        Public wParamL As Int16
        Public wParamH As Int16
    End Structure
 
    Friend Enum InputType As Integer
        Mouse = 0
        Keyboard = 1
        Hardware = 2
    End Enum
 
    <Flags()> _
    Friend Enum MOUSEEVENTF As Integer
        MOVE = &H1
        LEFTDOWN = &H2
        LEFTUP = &H4
        RIGHTDOWN = &H8
        RIGHTUP = &H10
        MIDDLEDOWN = &H20
        MIDDLEUP = &H40
        XDOWN = &H80
        XUP = &H100
        VIRTUALDESK = &H400
        WHEEL = &H800
        ABSOLUTE = &H8000
    End Enum
 
    <Flags()> _
    Friend Enum KEYEVENTF As Integer
        EXTENDEDKEY = 1
        KEYUP = 2
        [UNICODE] = 4
        SCANCODE = 8
    End Enum
 
End Class

Si vous cliquez sur exemple le curseur se déplace sur la textbox, clique, relache, et l'apli envoie hello world. a la textbox.
Je travaille sur le deuxième pour comprendre le hook et je met tout ça au propre si ça peut aider qqn d'autre.

[VB 2005] Interception touches

Windows Forms

Vue hybride

Discussions similaires

Partager

Partager