2008-08-04

以 VB.Net (Visual Studio 2005) 模擬滑鼠動作

玩一些網路 Flash Game 的時候,常常需要狂暴的點擊滑鼠,而所謂的 "滑鼠連點程式" 就成了第一選擇。網路上可以搜尋到不同作者篆寫的版本,像是 windsheep 寫的 windclick,或是..... 忘了,不重要 XD 不過之前有次想抓的時候,發現載點好像掛了,就只好自己寫一個囉。

要送出滑鼠事件,例如點擊 (Click)、壓下按鍵 (Mouse Down)、放開按鍵 (Mouse Up)、或是移動滑鼠 (Mouse Move),必需透過視窗訊息 (Windows Message) 運作,然而 .Net Framework 並沒有提供這樣的功能,因此只能透過 API。網路上可以找到一些關於所需 API 的說明,而這邊有人寫出基本的模組供使用,而這邊則有包好的 Class 源碼。

但考量到平台 (32 or 64 bit system) 和版本的關係,那個模組需要做一點修改。VS 2005 + vista x64 底下的 Long 是 8 byte,而 Integer 是 4 byte,但並非所有作業系統及 Compiler 下均是如此;相對的,user32.dll 所提供的 API 如 SetCursorPos 與 GetCursorPos 則明顯不使用 8 byte 的變數型態,因此將相關的變數型態指定為 int32 會是比較安全的做法。然後 TYPE 在 VS 2005 中已經被拿掉了,只要改成 Structure 就好。

修改過的模組檔如下:
Option Explicit On

Module MManip
'API 定義
Public Declare Sub Mouse_Event Lib "user32" _
(ByVal dwFlags As int32, ByVal dx As int32, ByVal dy As int32, _
ByVal cButtons As int32, ByVal dwExtraInfo As int32)

Public Declare Function SetCursorPos Lib "user32" _
(ByVal X As int32, ByVal Y As int32) As int32
Public Declare Function GetCursorPos Lib "user32"
(ByRef lpPoint As POINTAPI) As int32

Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_MIDDLEDOWN = &H20
Public Const MOUSEEVENTF_MIDDLEUP = &H40
Public Const MOUSEEVENTF_RIGHTDOWN = &H8
Public Const MOUSEEVENTF_RIGHTUP = &H10
Public Const MOUSEEVENTF_MOVE = &H1

Public Structure POINTAPI
Dim X As Int32
Dim Y As Int32

End Structure

'取得目前滑鼠座標
Public Function GetCurrentPos As POINTAPI
Dim Position As POINTAPI
GetCursorPos(Position)
GetCurrentPos = Position

End Function

'取得目前滑鼠座標 x 值
Public Function GetCurrentX() As int32
Dim Position As POINTAPI
GetCursorPos(Position)
GetCurrentX = Position.X

End Function

'取得目前滑鼠座標 y 值
Public Function GetCurrentY() As int32
Dim Position As POINTAPI
GetCursorPos(Position)
GetCurrentY = Position.Y

End Function

'滑鼠左擊
Public Sub LeftClick()
LeftDown()
LeftUp()

End Sub

'按下滑鼠左鍵
Public Sub LeftDown()
Mouse_Event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
End Sub

'放開滑鼠左鍵
Public Sub LeftUp()
Mouse_Event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
End Sub

'滑鼠中擊
Public Sub MiddleClick()
MiddleDown()
MiddleUp()

End Sub

'按下滑鼠中鍵
Public Sub MiddleDown()
Mouse_Event(MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0)
End Sub

'放開滑鼠中鍵
Public Sub MiddleUp()
Mouse_Event(MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0)
End Sub

'移動滑鼠
Public Sub MoveMouse(ByVal xMove As int32, ByVal yMove As int32)
Mouse_Event(MOUSEEVENTF_MOVE, xMove, yMove, 0, 0)
End Sub

'滑鼠右擊
Public Sub RightClick()
RightDown()
RightUp()

End Sub

'按下滑鼠右鍵
Public Sub RightDown()
Mouse_Event(MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0)
End Sub

'放開滑鼠右鍵
Public Sub RightUp()
Mouse_Event(MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0)
End Sub

End Module

沒有留言: