Imports System.Runtime.InteropServices
Module ReadWriteMemory_Advanced
#Region "ReadWriteMemory"
    Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Integer, ByVal bInheritHandle As Integer, ByVal dwProcessId As Integer) As Integer
    Private Declare Function CloseHandle Lib "kernel32" (ByVal hProcess As Integer) As Integer

    <DllImport("kernel32.dll", SetLastError:=True, ExactSpelling:=True)> _
    Public Function VirtualAllocEx(ByVal hProcess As IntPtr, ByVal lpAddress As IntPtr, _
     ByVal dwSize As UInteger, ByVal flAllocationType As UInteger, _
     ByVal flProtect As UInteger) As IntPtr
    End Function
    <DllImport("kernel32", CharSet:=CharSet.Auto, SetLastError:=True)> _
    Public Function VirtualProtectEx(ByVal hProcess As IntPtr, ByVal lpAddress As IntPtr, _
    ByVal dwSize As IntPtr, ByVal flNewProtect As UInteger, _
    ByRef lpflOldProtect As UInteger) As Boolean
    End Function
	<DllImport("kernel32.dll", SetLastError:=True)> Private Function ReadProcessMemory _
(ByVal hProcess As IntPtr, ByVal lpBaseAddress As IntPtr, ByRef lpBuffer As Byte, _
 ByVal iSize As Integer, ByRef lpNumberOfBytesRead As Integer) As Boolean
    End Function

    Private Declare Function CoTaskMemAlloc Lib "ole32.dll" Alias "CoTaskMemAlloc" (ByVal nSize As Integer) As Integer

    Private Declare Function WriteProcessMemory1 Lib "kernel32" Alias "WriteProcessMemory" (ByVal hProcess As Integer, ByVal lpBaseAddress As Integer, ByRef lpBuffer As Integer, ByVal nSize As Integer, ByRef lpNumberOfBytesWritten As Integer) As Integer
    Private Declare Function WriteProcessMemory2 Lib "kernel32" Alias "WriteProcessMemory" (ByVal hProcess As Integer, ByVal lpBaseAddress As Integer, ByRef lpBuffer As Single, ByVal nSize As Integer, ByRef lpNumberOfBytesWritten As Integer) As Single
    Private Declare Function WriteProcessMemory3 Lib "kernel32" Alias "WriteProcessMemory" (ByVal hProcess As Integer, ByVal lpBaseAddress As Integer, ByRef lpBuffer As Long, ByVal nSize As Integer, ByRef lpNumberOfBytesWritten As Integer) As Long

    Private Declare Function ReadProcessMemory1 Lib "kernel32" Alias "ReadProcessMemory" (ByVal hProcess As Integer, ByVal lpBaseAddress As Integer, ByRef lpBuffer As Integer, ByVal nSize As Integer, ByRef lpNumberOfBytesWritten As Integer) As Integer
    Private Declare Function ReadProcessMemory2 Lib "kernel32" Alias "ReadProcessMemory" (ByVal hProcess As Integer, ByVal lpBaseAddress As Integer, ByRef lpBuffer As Single, ByVal nSize As Integer, ByRef lpNumberOfBytesWritten As Integer) As Single
    Private Declare Function ReadProcessMemory3 Lib "kernel32" Alias "ReadProcessMemory" (ByVal hProcess As Integer, ByVal lpBaseAddress As Integer, ByRef lpBuffer As Long, ByVal nSize As Integer, ByRef lpNumberOfBytesWritten As Integer) As Long
    Private Declare Function ReadProcessMemory4 Lib "kernel32" Alias "ReadProcessMemory" (ByVal hProcess As Integer, ByVal lpBaseAddress As Integer, <Out()> ByVal lpBuffer() As Byte, ByVal nSize As Integer, ByRef lpNumberOfBytesWritten As Integer) As Boolean

    Const PROCESS_ALL_ACCESS = &H1F0FF

    <DllImport("kernel32.dll", SetLastError:=True)> _
    Public Function WriteProcessMemory(ByVal hProcess As IntPtr, ByVal lpBaseAddress As IntPtr, ByVal lpBuffer As Byte(), ByVal nSize As System.UInt32, <Out()> ByRef lpNumberOfBytesWritten As Int32) As Boolean
    End Function

    Private Declare Function WriteProcessMemory4 Lib "kernel32" Alias "WriteProcessMemory" (ByVal hProcess As Int32, ByVal lpBaseAddress As Int32, ByRef lpBuffer As Int32, ByVal nSize As Int32, ByRef lpNumberOfBytesWritten As Int32) As Int32

    Public Function StrToByteArray(ByVal str As String) As Byte()
        Dim encoding As New System.Text.UTF8Encoding()
        Return encoding.GetBytes(str)
    End Function

    Public Function RemoveProtection(ByVal ProcessName As String, ByVal AddressOfStart As Integer, ByVal SizeToRemoveProtectionInBytes As Integer)
        For Each p As Process In Process.GetProcessesByName(ProcessName)
            Const PAGE_EXECUTE_READWRITE As Integer = &H40
            Dim oldProtect As Integer
            If Not VirtualProtectEx(p.Handle, New IntPtr(AddressOfStart), New IntPtr(SizeToRemoveProtectionInBytes), PAGE_EXECUTE_READWRITE, oldProtect) Then Throw New Exception
            p.Dispose()
        Next
    End Function

    Public Function AllocMem(ByVal ProcessName As String, ByVal AddressOfStart As Integer, ByVal SizeOfAllocationInBytes As Integer)
        Try

            For Each p As Process In Process.GetProcessesByName(ProcessName)
                Const MEM_COMMIT As Integer = &H1000
                Const PAGE_EXECUTE_READWRITE As Integer = &H40
                Dim pBlob As IntPtr = VirtualAllocEx(p.Handle, New IntPtr(AddressOfStart), New IntPtr(SizeOfAllocationInBytes), MEM_COMMIT, PAGE_EXECUTE_READWRITE)
                If pBlob = IntPtr.Zero Then
                    p.Dispose()
                End If
            Next
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Function

    Public Function TestAlloc(ByVal ProcessName As String, ByVal AddressOfStart As Integer, ByVal nsize As Integer) As IntPtr
        Dim MyP As Process() = Process.GetProcessesByName(ProcessName)
        Dim hProcess As IntPtr = OpenProcess(PROCESS_ALL_ACCESS, 0, MyP(0).Id)
        Const MEM_COMMIT As Integer = &H1000
        Const PAGE_EXECUTE_READWRITE As Integer = &H40
        Dim buffer As IntPtr
        buffer = VirtualAllocEx(hProcess, New IntPtr(AddressOfStart), nsize, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
        CloseHandle(hProcess)
        Return buffer
    End Function

    Public Function WriteDMAInteger(ByVal Process As String, ByVal Address As Integer, ByVal Offsets As Integer(), ByVal Value As Integer, ByVal Level As Integer, Optional ByVal nsize As Integer = 4) As Boolean
        Try
            Dim lvl As Integer = Address
            For i As Integer = 1 To Level
                lvl = ReadInteger(Process, lvl, nsize) + Offsets(i - 1)
            Next
            WriteInteger(Process, lvl, Value, nsize)
            Return True
        Catch ex As Exception
            Return False
        End Try
    End Function

    Public Function ReadDMAInteger(ByVal Process As String, ByVal Address As Integer, ByVal Offsets As Integer(), ByVal Level As Integer, Optional ByVal nsize As Integer = 4) As Integer
        Try
            Dim lvl As Integer = Address
            For i As Integer = 1 To Level
                lvl = ReadInteger(Process, lvl, nsize) + Offsets(i - 1)
            Next
            Dim vBuffer As Integer
            vBuffer = ReadInteger(Process, lvl, nsize)
            Return vBuffer
        Catch ex As Exception

        End Try
    End Function

    Public Function WriteDMAFloat(ByVal Process As String, ByVal Address As Integer, ByVal Offsets As Integer(), ByVal Value As Single, ByVal Level As Integer, Optional ByVal nsize As Integer = 4) As Boolean
        Try
            Dim lvl As Integer = Address
            For i As Integer = 1 To Level
                lvl = ReadFloat(Process, lvl, nsize) + Offsets(i - 1)
            Next
            WriteFloat(Process, lvl, Value, nsize)
            Return True
        Catch ex As Exception
            Return False
        End Try
    End Function

    Public Function ReadDMAFloat(ByVal Process As String, ByVal Address As Integer, ByVal Offsets As Integer(), ByVal Level As Integer, Optional ByVal nsize As Integer = 4) As Single
        Try
            Dim lvl As Integer = Address
            For i As Integer = 1 To Level
                lvl = ReadFloat(Process, lvl, nsize) + Offsets(i - 1)
            Next
            Dim vBuffer As Single
            vBuffer = ReadFloat(Process, lvl, nsize)
            Return vBuffer
        Catch ex As Exception

        End Try
    End Function

    Public Function WriteDMALong(ByVal Process As String, ByVal Address As Integer, ByVal Offsets As Integer(), ByVal Value As Long, ByVal Level As Integer, Optional ByVal nsize As Integer = 4) As Boolean
        Try
            Dim lvl As Integer = Address
            For i As Integer = 1 To Level
                lvl = ReadLong(Process, lvl, nsize) + Offsets(i - 1)
            Next
            WriteLong(Process, lvl, Value, nsize)
            Return True
        Catch ex As Exception
            Return False
        End Try
    End Function

    Public Function ReadDMALong(ByVal Process As String, ByVal Address As Integer, ByVal Offsets As Integer(), ByVal Level As Integer, Optional ByVal nsize As Integer = 4) As Long
        Try
            Dim lvl As Integer = Address
            For i As Integer = 1 To Level
                lvl = ReadLong(Process, lvl, nsize) + Offsets(i - 1)
            Next
            Dim vBuffer As Long
            vBuffer = ReadLong(Process, lvl, nsize)
            Return vBuffer
        Catch ex As Exception

        End Try
    End Function

    Public Sub WriteNOPs(ByVal ProcessName As String, ByVal Address As Long, ByVal NOPNum As Integer)
        Dim C As Integer
        Dim B As Integer
        Dim MyP As Process() = Process.GetProcessesByName(ProcessName)
        Dim hProcess As IntPtr = OpenProcess(PROCESS_ALL_ACCESS, 0, MyP(0).Id)

        B = 0
        For C = 1 To NOPNum
            Call WriteProcessMemory1(hProcess, Address + B, &H90, 1, 0&)
            CloseHandle(hProcess)
            B = B + 1
        Next C
    End Sub

    Public Sub WriteXBytes(ByVal ProcessName As String, ByVal Address As Long, ByVal Value As String)
        Dim MyP As Process() = Process.GetProcessesByName(ProcessName)
        Dim hProcess As IntPtr = OpenProcess(PROCESS_ALL_ACCESS, 0, MyP(0).Id)

        Dim C As Integer
        Dim B As Integer
        Dim D As Integer
        Dim V As Byte

        B = 0
        D = 1
        For C = 1 To Math.Round((Len(Value) / 2))
            V = Val("&H" & Mid$(Value, D, 2))
            Call WriteProcessMemory1(hProcess, Address + B, V, 1, 0&)
            CloseHandle(hProcess)
            B = B + 1
            D = D + 2
        Next C

    End Sub

    Public Sub WriteInteger(ByVal ProcessName As String, ByVal Address As Integer, ByVal Value As Integer, Optional ByVal nsize As Integer = 4)
        If ProcessName.EndsWith(".exe") Then
            ProcessName = ProcessName.Replace(".exe", "")
        End If
        Dim MyP As Process() = Process.GetProcessesByName(ProcessName)
        Dim hProcess As IntPtr = OpenProcess(PROCESS_ALL_ACCESS, 0, MyP(0).Id)

        Dim hAddress, vBuffer As Integer
        hAddress = Address
        vBuffer = Value
        WriteProcessMemory1(hProcess, hAddress, CInt(vBuffer), nsize, 0)
        CloseHandle(hProcess)
    End Sub

    Public Sub WriteFloat(ByVal ProcessName As String, ByVal Address As Integer, ByVal Value As Single, Optional ByVal nsize As Integer = 4)
        If ProcessName.EndsWith(".exe") Then
            ProcessName = ProcessName.Replace(".exe", "")
        End If
        Dim MyP As Process() = Process.GetProcessesByName(ProcessName)
        Dim hProcess As IntPtr = OpenProcess(PROCESS_ALL_ACCESS, 0, MyP(0).Id)

        Dim hAddress As Integer
        Dim vBuffer As Single

        hAddress = Address
        vBuffer = Value
        WriteProcessMemory2(hProcess, hAddress, vBuffer, nsize, 0)
        CloseHandle(hProcess)
    End Sub

    Public Sub WriteLong(ByVal ProcessName As String, ByVal Address As Integer, ByVal Value As Long, Optional ByVal nsize As Integer = 4)
        If ProcessName.EndsWith(".exe") Then
            ProcessName = ProcessName.Replace(".exe", "")
        End If
        Dim MyP As Process() = Process.GetProcessesByName(ProcessName)
        Dim hProcess As IntPtr = OpenProcess(PROCESS_ALL_ACCESS, 0, MyP(0).Id)

        Dim hAddress As Integer
        Dim vBuffer As Long

        hAddress = Address
        vBuffer = Value
        WriteProcessMemory3(hProcess, hAddress, vBuffer, nsize, 0)
        CloseHandle(hProcess)
    End Sub

    Public Sub WriteString(ByVal ProcessName As String, ByVal Address As Integer, ByVal Value As String, Optional ByVal nsize As Integer = 4)
        If ProcessName.EndsWith(".exe") Then
            ProcessName = ProcessName.Replace(".exe", "")
        End If
        Dim MyP As Process() = Process.GetProcessesByName(ProcessName)
        Dim hProcess As IntPtr = OpenProcess(PROCESS_ALL_ACCESS, 0, MyP(0).Id)

        Dim hAddress As Integer
        Dim vBuffer As Byte()

        hAddress = Address
        vBuffer = StrToByteArray(Value)
        WriteProcessMemory(hProcess, hAddress, vBuffer, vBuffer.Length, 0)
        CloseHandle(hProcess)
    End Sub

    Public Function WriteString2(ByVal ProcessName As String, ByVal Address As Integer, ByVal str As String) As Boolean
        Dim MyP As Process() = Process.GetProcessesByName(ProcessName)
        Dim hProcess As IntPtr = OpenProcess(PROCESS_ALL_ACCESS, 0, MyP(0).Id)
        For i As Integer = 0 To Len(str) - 1
            WriteProcessMemory4(hProcess, Address + i, Asc(Mid(str, i + 1, 1)), str.Length, 0)
            CloseHandle(hProcess)
        Next i
        Return 0
    End Function

    Public Function ReadInteger(ByVal ProcessName As String, ByVal Address As Integer, Optional ByVal nsize As Integer = 4) As Integer
        If ProcessName.EndsWith(".exe") Then
            ProcessName = ProcessName.Replace(".exe", "")
        End If
        Dim MyP As Process() = Process.GetProcessesByName(ProcessName)
        If MyP.Length = 0 Then
            MessageBox.Show(ProcessName & " isn't open!")
            Exit Function
        End If
        Dim hProcess As IntPtr = OpenProcess(PROCESS_ALL_ACCESS, 0, MyP(0).Id)
        If hProcess = IntPtr.Zero Then
            MessageBox.Show("Failed to open " & ProcessName & "!")
            Exit Function
        End If

        Dim hAddress, vBuffer As Integer
        hAddress = Address
        ReadProcessMemory1(hProcess, hAddress, vBuffer, nsize, 0)
        Return vBuffer
    End Function

    Public Function ReadFloat(ByVal ProcessName As String, ByVal Address As Integer, Optional ByVal nsize As Integer = 4) As Single
        Dim MyP As Process() = Process.GetProcessesByName(ProcessName)
        Dim hProcess As IntPtr = OpenProcess(&H10, 0, MyP(0).Id)
        Dim hAddress As Integer
        Dim vBuffer As Single
        hAddress = Address
        ReadProcessMemory2(hProcess, hAddress, vBuffer, nsize, 0)
        CloseHandle(hProcess)
        Return vBuffer
    End Function

    Public Function ReadLong(ByVal ProcessName As String, ByVal Address As Integer, Optional ByVal nsize As Integer = 4) As Long
        Dim MyP As Process() = Process.GetProcessesByName(ProcessName)
        Dim hProcess As IntPtr = OpenProcess(&H10, 0, MyP(0).Id)

        Dim hAddress As Integer
        Dim vBuffer As Long

        hAddress = Address
        ReadProcessMemory3(hProcess, hAddress, vBuffer, nsize, 0)
        CloseHandle(hProcess)
        Return vBuffer
    End Function
	
	Private Function GetTextinMemory(ByVal ProcessHandle As IntPtr, ByVal MemoryAddress As IntPtr, ByVal CharsToRead As Integer, Optional ByVal IsUnicode As Boolean = True) As String
        Dim ReturnValue As String = vbNullString
        Dim StringBuffer() As Byte
        If IsUnicode Then
            ReDim StringBuffer(CharsToRead * 2 - 1)
        Else
            ReDim StringBuffer(CharsToRead - 1)
        End If
        Try
            'Dim p As Process() = Process.GetProcessesByName(process0)
            If ReadProcessMemory(ProcessHandle, MemoryAddress, StringBuffer(0), StringBuffer.Length, Nothing) Then
                If IsUnicode Then
                    ReturnValue = System.Text.Encoding.ASCII.GetString(StringBuffer)
                Else
                    ReturnValue = System.Text.Encoding.Default.GetString(StringBuffer)
                End If
            End If

        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
        Return ReturnValue
    End Function
	
	Public Function ReadString(ByVal ProcessName As String, ByVal Address As Integer, Optional ByVal nsize As Integer = 4) As String
        Dim MyP As Process() = Process.GetProcessesByName(ProcessName)
        Dim hProcess As IntPtr = OpenProcess(&H10, 0, MyP(0).Id)

        Dim hAddress As Integer
        Dim vBuffer As String

        hAddress = Address
        vBuffer = GetTextinMemory(hProcess, address, 16)
        CloseHandle(hProcess)
        Return vBuffer
    End Function

    Public Function ReadByteArray(ByVal ProcessName As String, ByRef Address As Integer, Optional ByVal nsize As Integer = 4) As Byte()
        Dim MyP As Process() = Process.GetProcessesByName(ProcessName)
        Dim hProcess As IntPtr = OpenProcess(&H10, 0, MyP(0).Id)

        Dim hAddress As Integer
        Dim vBuffer(nsize - 1) As Byte

        hAddress = Address
        ReadProcessMemory4(hProcess, hAddress, vBuffer, nsize, 0)
        CloseHandle(hProcess)
        Return vBuffer
    End Function
#End Region
#Region "ProcessRunning"
    Public Function IsProcessRunning(ByVal name As String) As Boolean

        For Each clsProcess As Process In Process.GetProcesses()
            If clsProcess.ProcessName.StartsWith(name) Then
                'process found so it's running so return true
                Return True
            End If
        Next
        Return False
    End Function
#End Region
#Region "Undetected ReadWriteMemory" 'é_è
    Public Function uWriteLong(ByVal ProcessName As String, ByVal Address As Integer, ByVal Value As Long, Optional ByVal nsize As Integer = 4)
        Try
            Dim process_name As Process() = Process.GetProcessesByName(ProcessName)
            Dim baseaddr As Long = ReadLong(ProcessName, Address)
            Dim firstadd As Long = ReadLong(ProcessName, Address)
            WriteLong(ProcessName, Address, Value, nsize)
        Catch ex As Exception
            MsgBox(ProcessName & " n'est pas ouvert !", vbCritical, "Erreur")
        End Try
    End Function
#End Region
End Module