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

發現好像沒發過這個...
這個是 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