[分享] [VB.NET] MapleFunction 一個方便 VB.NET 使用的楓之谷模組

[複製鏈接]

ai1118

468 主題	0 好友	522 積分

高級會員

Rank: 4

UID: 70473
帖子: 471
主題: 468
精華: 0
積分: 522
楓幣: 738
威望: 521
存款: 0
贊助金額: 0
推廣: 0
ＧＰ: 43
閱讀權限: 50
性別: 保密
在線時間: 28 小時
註冊時間: 2014-7-14
最後登入: 2015-5-16

發消息

電梯直達

1樓

發表於 2014-7-14 09:43:29 |只看該作者 |倒序瀏覽

MapleFunction.vb

Module MapleFunction
'----------------------------------系統API宣告-----------------------------------'
Private Declare Function OpenProcess Lib "kernel32" (ByVal Access As Integer, ByVal Handle As Boolean, ByVal ProcessId As Integer) As IntPtr
Private Declare Function WriteProcessMemory Lib "kernel32" Alias "WriteProcessMemory" (ByVal hProcess As IntPtr, ByVal lpBaseAddress As Integer, ByVal lpBuffer() As Byte, ByVal nSize As Integer, ByVal lpNumberOfBytesWritten As Integer) As Integer
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As IntPtr, ByVal lpBaseAddress As Integer, ByRef lpBuffer As Integer, ByVal nSize As Integer, ByVal lpNumberOfBytesWritten As Integer) As Integer
'----------------------------------啟用所有CheckBox-----------------------------------'
Public Sub AllCrackMemoryFunctionCheckBoxEnable(ByVal ParentControls As System.windows.Forms.Control.ControlCollection)
For Each i As Control In ParentControls
If i.Name.Contains("CheckBox") Then i.Enabled = True
Next
End Sub
Structure MapleStoryProcess
Shared WriteMapleStoryIntptr As IntPtr = IntPtr.Zero
Shared MProcess As Process = Nothing
'Public ID As Integer = Nothing '如VB2008編譯上出錯,請把這行的註解拿掉.
'----------------------------------自定義指標格式-----------------------------------'
Structure Pointer
Public Address As Integer
Public Offset
End Structure
'----------------------------------讀取楓之谷遊戲-----------------------------------'
Public Function LoadMemory() As Boolean
Try
Dim MapleStoryProcess As Process = Process.GetProcessesByName("MapleStory")(0)
If MapleStoryProcess.MainWindowHandle.Equals(IntPtr.Zero) = False Then
WriteMapleStoryIntptr = OpenProcess(&H1F0FFF, False, MapleStoryProcess.Id)
MProcess = MapleStoryProcess
Return True
End If
Return False
Catch ex As Exception
Return False
End Try
End Function
'--------------------------------讀取楓之谷遊戲(可指定Handle)------------------------'
Public Function LoadMemory(ByVal Handle As IntPtr) As Boolean
Try
Dim AllProcessInHandle As Process() = Process.GetProcesses
For Each P As Process In AllProcessInHandle
If P.MainWindowHandle = Handle Then
WriteMapleStoryIntptr = OpenProcess(&H1F0FFF, False, P.Id)
MProcess = P
Return True
End If
Next
Return False
Catch ex As Exception
Return False
End Try
End Function
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Integer
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Integer, ByRef lpdwProcessId As Integer) As Integer
'--------------------------------讀取楓之谷遊戲(指定視窗)------------------------'
Public Function OpenProcessByWindow(ByVal lpWindowName As String, Optional ByVal lpClassName As String = vbNullString) As Boolean
Try
Dim Pid As Integer
GetWindowThreadProcessId(FindWindow(lpClassName, lpWindowName), Pid)
Dim MapleStoryProcess As Process = Process.GetProcessById(Pid)
If MapleStoryProcess.MainWindowHandle.Equals(IntPtr.Zero) = False Then
WriteMapleStoryIntptr = OpenProcess(&H1F0FFF, False, MapleStoryProcess.Id)
MProcess = MapleStoryProcess
Return True
End If
Return False
Catch ex As Exception
Return False
End Try
End Function
'----------------------------------寫入遊戲記憶體-----------------------------------'
Public Function WriteByte(ByVal Address As Integer, ByVal ArrayOfByte As Byte())
On Error Resume Next
If WriteMapleStoryIntptr.Equals(IntPtr.Zero) Then
MsgBox("Application Can't Catch MapleStory Process.", MsgBoxStyle.Critical, "Error")
Return False
End If
WriteProcessMemory(WriteMapleStoryIntptr, Address, ArrayOfByte, ArrayOfByte.Length, False)
Return True
End Function
Private Declare Function WriteProcessMemoryAPI Lib "kernel32" Alias "WriteProcessMemory" (ByVal hProcess As IntPtr, ByVal lpBaseAddress As Integer, ByRef lpBuffer As Integer, ByVal nSize As Integer, ByVal lpNumberOfBytesWritten As Integer) As Integer
Public Function WriteLong(ByVal lpAddress As Integer, ByVal lpValue As Integer) As Integer
Try
Return WriteProcessMemoryAPI(WriteMapleStoryIntptr, lpAddress, lpValue, Len(lpValue), False)
Catch ex As Exception
Return 0
End Try
End Function
Public Function MakeJmp(ByVal lpAddress As Long, ByVal lpJmpAddress As Long, Optional ByVal lpNops As Long = 0) As Long
Dim JmpByte As Byte() = {&HE9}
MakeJmp = CBool(WriteByte(lpAddress, JmpByte)) And CBool(WriteLong(lpAddress + 1, lpJmpAddress - lpAddress - 5))
If lpNops = 0 Then Exit Function
Return MakeJmp
End Function
Public Function MakeCall(ByVal lpAddress As Long, ByVal lpCallAddress As Long, Optional ByVal lpNops As Long = 0) As Long
Dim CallByte As Byte() = {&HE8}
MakeCall = CBool(WriteByte(lpAddress, CallByte)) And CBool(WriteLong(lpAddress + 1, lpCallAddress - lpAddress - 5))
If lpNops = 0 Then Exit Function
Return MakeCall
End Function
'----------------------------------讀取地址的Value-----------------------------------'
Public Function GetValue(ByVal Address As Integer) As Integer
On Error Resume Next
If WriteMapleStoryIntptr.Equals(IntPtr.Zero) Then
MsgBox("Application Can't Catch MapleStory Process.", MsgBoxStyle.Critical, "Error")
Return False
End If
Dim GetRetValue As Integer = vbNullString
ReadProcessMemory(WriteMapleStoryIntptr, Address, GetRetValue, 4, False)
Return GetRetValue
End Function
Public Function ReadLong(ByVal lpAddress As Long) As Long
Dim Value As Integer = vbNullString
ReadProcessMemory(WriteMapleStoryIntptr, lpAddress, Value, 4, False)
Return Value
End Function
'----------------------------------讀取指標的Value-----------------------------------'
Public Function GetPointerValue(ByVal Pointer As MapleStoryProcess.Pointer) As Integer
On Error Resume Next
If WriteMapleStoryIntptr.Equals(IntPtr.Zero) Then
MsgBox("Application Can't Catch MapleStory Process.", MsgBoxStyle.Critical, "Error")
Return False
End If
Dim GetPointerMain, GetTheTrueValue As Integer
ReadProcessMemory(WriteMapleStoryIntptr, "&H" + Pointer.Address, GetPointerMain, 4, False)
ReadProcessMemory(WriteMapleStoryIntptr, GetPointerMain + "&H" + Pointer.Offset, GetTheTrueValue, 4, False)
Return GetTheTrueValue
End Function
Public Function ReadPointer(ByVal lpAddress As Long, ByVal lpOffset As Long) As Long
Return ReadLong(ReadLong(lpAddress) + lpOffset)
End Function
'----------------------------------十進位轉換16進位(Hex)-----------------------------------'
Public Function IntegerHex(ByVal InPutInt As String) As Integer
On Error Resume Next
Return Microsoft.VisualBasic.Hex(InPutInt)
End Function
'----------------------------------16進位轉十進位(UnHex)-----------------------------------'
Public Function IntegerUnHex(ByVal InPutInt As String) As Integer
On Error Resume Next
Return CLng("&H" & InPutInt)
End
End Function
'----------------------------------結束遊戲<強制>-------------------------------------------'
Public Function KillMapleStory() As Boolean
Try
MProcess.Kill()
Return True
Catch ex As Exception
Return False
End Try
End Function
'---------------------------------結束遊戲<普通>--------------------------------------------'
Public Function EndMapleStory() As Boolean
Try
MProcess.CloseMainWindow()
Return True
Catch ex As Exception
Return False
End Try
End Function
'-------------------------------確認遊戲是否存在---------------------------------------------'
Public Function MapleStoryCloseOrNot() As Boolean
Return MProcess.HasExited
End Function
'------------------------------- Auto Key Press ---------------------------------------------'
Private Declare Auto Function PostMessage Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Boolean
Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Integer, ByVal wMapType As Integer) As Integer
Private Declare Function ExitWindowsEx Lib "user32 " (ByVal uFlags As Integer, ByVal dwReserved As Integer) As Integer
Private Const WM_KEYDOWN As Integer = &H100
Dim hModuleNoFree As Integer
Public Function RingPst(ByVal HWnd As Integer, ByVal KeyType As String, ByVal KeyCode As String)
If KeyCode = "關閉電腦" Then ExitWindowsEx(1, 0)
Dim myKeyValue As Integer = toKeyValue(KeyCode)
Select Case KeyType
Case "Press"
PostMessage(HWnd, &H100, myKeyValue, MakeKeyLparam(myKeyValue, &H100))
PostMessage(HWnd, &H101, myKeyValue, MakeKeyLparam(myKeyValue, &H101))
Return 1
Case "Down"
PostMessage(HWnd, &H100, myKeyValue, MakeKeyLparam(myKeyValue, &H100))
Return 1
Case "Up"
PostMessage(HWnd, &H101, myKeyValue, MakeKeyLparam(myKeyValue, &H101))
Return 1
Case Else
Return 0
End Select
End Function
Private Function toKeyValue(ByVal KeyCode As String) As Integer
Dim strKey() As String = {"None", "Enter", "Shift", "Ctrl", "Alt", "Space", "PageUp", "PageDown", "Insert", "Delete", "Home", "End", "Left", "Up", "Right", "Down", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "F1", "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9", "F10", "F11", "F12", "ESCAPE"}
Dim intKey() As Integer = {0, &HD, &H10, &H11, &H12, &H20, &H21, &H22, &H2D, &H2E, &H24, &H23, &H25, &H26, &H27, &H28, &H30, &H31, &H32, &H33, &H34, &H35, &H36, &H37, &H38, &H39, &H41, &H42, &H43, &H44, &H45, &H46, &H47, &H48, &H49, &H4A, &H4B, &H4C, &H4D, &H4E, &H4F, &H50, &H51, &H52, &H53, &H54, &H55, &H56, &H57, &H58, &H59, &H5A, &H70, &H71, &H72, &H73, &H74, &H75, &H76, &H77, &H78, &H79, &H7A, &H7B, &H1B}
For i = 0 To strKey.Length - 1
If strKey(i) = KeyCode Then Return intKey(i)
Next
Return False
End Function
Private Function MakeKeyLparam(ByVal VirtualKey As Integer, ByVal flag As Integer) As Integer
'參數VirtualKey表示按鍵虛擬碼,flag表示是按下鍵還是釋放鍵，用WM_KEYDOWN和WM_KEYUP這兩個常數表示
Dim s As String
Dim Firstbyte As String 'lparam參數的24-31位
If flag = WM_KEYDOWN Then '如果是按下鍵
Firstbyte = "00"
Else
Firstbyte = "C0" '如果是釋放鍵
End If
Dim Scancode As Long
'獲得鍵的掃描碼
Scancode = MapVirtualKey(VirtualKey, 0)
Dim Secondbyte As String 'lparam參數的16-23位元，即虛擬鍵掃描碼
Secondbyte = Right("00" & Hex(Scancode), 2)
s = Firstbyte & Secondbyte & "0001" '0001為lparam參數的0-15位，即發送次數和其他擴展資訊
MakeKeyLparam = Val("&H" & s)
End Function
'------------------------------- 申請記憶體 ---------------------------------------------'
Private Declare Function VirtualAllocEx Lib "kernel32.dll" (ByVal hProcess As IntPtr, ByVal lpAddress As IntPtr, ByVal dwSize As IntPtr, ByVal flAllocationType As Integer, ByVal flProtect As Integer) As IntPtr
Public Function Alloc(ByVal lpSize As Integer, Optional ByVal lpAddress As Integer = 0) As Integer
Const MEM_COMMIT As Integer = &H1000
Const PAGE_EXECUTE_READWRITE As Integer = &H40
Dim pBlob As IntPtr = VirtualAllocEx(WriteMapleStoryIntptr, New IntPtr(lpAddress), New IntPtr(lpSize), MEM_COMMIT, PAGE_EXECUTE_READWRITE)
If pBlob = IntPtr.Zero Then Throw New Exception
Return pBlob.ToInt32
End Function
'------------------------------- Address2Aob ---------------------------------------------'
Public Function Adr2Aob(ByVal Address As Integer) As String
Dim tmpAOB As String = Hex(Address).PadLeft(8, "0")
Dim reAOB As String = Nothing
For i = 1 To 7
If (i Mod 2) = 1 Then
reAOB = Mid(tmpAOB, i, 2) & " " & reAOB
End If
Next
Return Trim(reAOB)
End Function
End Structure
End Module