[VB.NET] MapleFunction 一個方便 VB.NET 使用的楓之谷模組
發現好像沒發過這個...
這個是 ADR 大神頗久以前寫的,發於 CI 論壇,我之後又加了點東西而已 (好像塞了點鬼鬼的東西進去?
MapleFunction.vb
這個是 ADR 大神頗久以前寫的,發於 CI 論壇,我之後又加了點東西而已 (好像塞了點鬼鬼的東西進去?
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
留言
張貼留言