D3D9 Remote Hook VB.NET

    Private PROCESS_ALL_ACCESS As UInt32 = &H1F0FFF

    Sub Main()
        Dim processID As Int32 = Process.GetProcessesByName("csgo")(0).Id
        Dim processHandle As IntPtr = OpenProcess(PROCESS_ALL_ACCESS, False, processID)


        Dim d3d9Module As IntPtr = GetModuleBaseAddress("csgo", "d3d9.dll")

        Dim sb_vTableBytes As Byte() = {&HC7, &H6, &H0, &H0, &H0, &H0, &H89, &H86, &H0, &H0, &H0, &H0, &H89, &H86}
        Dim pDeviceScan As IntPtr = Scan(processHandle, sb_vTableBytes, "xx????xx????xx", d3d9Module, &HFFFFFF)
        Dim vTableAddr As IntPtr = readDword(processHandle, pDeviceScan + &H2)
        Dim ESAddr As Int32 = readDword(processHandle, vTableAddr + &HA8)

        Dim rectBytes As Byte() = {&H5, &H0, &H0, &H0, &H5, &H0, &H0, &H0, &H64, &H0, &H0, &H0, &H64, &H0, &H0, &H0, &H0, &H0, &H0, &H0, &H75, &H98, &H0, &H0}

        Dim rectX As Int32 = 10
        Dim rectY As Int32 = 40
        Dim rectW As Int32 = 100
        Dim rectH As Int32 = 150

        Array.Copy(BitConverter.GetBytes(rectX), 0, rectBytes, 0, 4)
        Array.Copy(BitConverter.GetBytes(rectY), 0, rectBytes, 4, 4)
        Array.Copy(BitConverter.GetBytes(rectW), 0, rectBytes, 8, 4)
        Array.Copy(BitConverter.GetBytes(rectH), 0, rectBytes, 12, 4)

        Dim c_alpha As Byte = 255
        Dim c_red As Byte = 0
        Dim c_green As Byte = 255
        Dim c_blue As Byte = 255

        Dim colorBytes As Byte() = {c_alpha, c_red, c_green, c_blue}

        Dim rectAlloc As IntPtr = VirtualAllocEx(processHandle, 0, rectBytes.Length, &H1000, &H40)
        writeBytes(processHandle, rectAlloc, rectBytes, rectBytes.Length)

        Dim esRetAddr As IntPtr = VirtualAllocEx(processHandle, 0, 4, &H1000, &H40)
        writeDword(processHandle, esRetAddr, ESAddr + &H5)

        Dim ab_rectBytes As Byte() = BitConverter.GetBytes(rectAlloc.ToInt32)
        Dim ab_esRetBytes As Byte() = BitConverter.GetBytes(esRetAddr.ToInt32)

        Dim detourBytes As Byte() = {&H8B, &HFF, &H55, &H8B, &HEC, &H60, &H36, &H8B, &H75,
                                      &H8, &H89, &H75, &H8, &H8B, &HF4, &H6A, &H0, &H51, &HF,
                                      &H57, &HC0, &HF3, &HF, &H11, &H4, &H24, &H68, colorBytes(0), colorBytes(1),
                                      colorBytes(2), colorBytes(3), &H6A, &H1, &H68, ab_rectBytes(0), ab_rectBytes(1), ab_rectBytes(2), ab_rectBytes(3),
                                      &H6A, &H1, &H8B, &H45, &H8, &H8B, &H8, &H8B, &H55, &H8, &H52, &H8B, &H81, &HAC, &H0, &H0, &H0,
                                      &HFF, &HD0, &H3B, &HF4, &H61, &HFF, &H25, ab_esRetBytes(0), ab_esRetBytes(1), ab_esRetBytes(2), ab_esRetBytes(3)}
        Dim detourFuncAlloc As IntPtr = VirtualAllocEx(processHandle, 0, detourBytes.Length, &H1000, &H40)
        writeBytes(processHandle, detourFuncAlloc, detourBytes, detourBytes.Length)

        Dim jmpOffset As Int32 = detourFuncAlloc - ESAddr - 5
        Dim ab_jmpOffset As Byte() = BitConverter.GetBytes(jmpOffset)
        Dim jmpBytes As Byte() = {&HE9, ab_jmpOffset(0), ab_jmpOffset(1), ab_jmpOffset(2), ab_jmpOffset(3)}

        writeBytes(processHandle, ESAddr, jmpBytes, jmpBytes.Length)

        Console.ReadLine()

    End Sub

Imports System.Runtime.InteropServices
Imports System.Diagnostics

Module Memory

#Region "Structures"
    Structure MODULEENTRY32
        Dim U32Size As UInteger
        Dim Th32ModuleId As UInteger
        Dim Th32ProcessId As UInteger
        Dim GlblcntUsage As UInteger
        Dim ProccntUsage As UInteger
        Dim ModBaseAddr As IntPtr
        Dim ModBaseSize As UInteger
        Dim HModule As IntPtr
        <Runtime.InteropServices.MarshalAs(Runtime.InteropServices.UnmanagedType.ByValTStr, SizeConst:=256)> Dim SzModule As String
        <Runtime.InteropServices.MarshalAs(Runtime.InteropServices.UnmanagedType.ByValTStr, SizeConst:=260)> Dim SzeExePath As String
    End Structure
#End Region

#Region "External Functions"
    Public Declare Function CloseHandle Lib "kernel32" (ByVal pHandle As IntPtr) As Boolean
    Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Integer, ByVal bInheritHandle As Boolean, ByVal dwProcessId As UInteger) As IntPtr
    Public Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As IntPtr, ByVal lpBaseAddress As IntPtr, <Out()> ByVal lpBuffer As Byte(), ByVal nSize As UInteger, ByRef lpNumberOfBytesRead As UInteger) As Boolean
    Public Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As IntPtr, ByVal lpBaseAddress As IntPtr, ByVal lpBuffer As Byte(), ByVal nSize As UInteger, ByRef lpNumberOfBytesWritten As UInteger) As Boolean
    Public Declare Function VirtualProtectEx Lib "kernel32" (ByVal hProcess As IntPtr, ByVal lpAddress As UInt32, ByVal dwSize As UInteger, ByVal flNewProtect As UInteger, ByRef lpflOldProtect As UInteger) As Boolean

    Public Declare Function Module32Next Lib "kernel32" (ByVal hSnapshot As IntPtr, ByRef lpme As MODULEENTRY32) As Boolean
    Public Declare Function Module32First Lib "kernel32" (ByVal hSnapshot As IntPtr, ByRef lpme As MODULEENTRY32) As Boolean
    Public Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As UInteger, ByVal u32ProcessId As UInteger) As IntPtr

    Public Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As IntPtr, ByVal lpAddress As UInt32, ByVal dwSize As UInteger, ByVal flAllocationType As UInteger, ByVal flProtect As UInteger) As IntPtr

    Public Declare Function Toolhelp32ReadProcessMemory Lib "kernel32" (ByVal th32ProcessID As Integer, ByVal lpBaseAddress As IntPtr, <Out()> ByVal lpBuffer As Byte(), ByVal nSize As Integer, ByRef lpNumberOfBytesRead As Integer) As Boolean


    <DllImport("kernel32.dll", SetLastError:=True, CharSet:=CharSet.Ansi, ExactSpelling:=True)>
    Public Function GetProcAddress(ByVal hModule As IntPtr, ByVal procName As String) As UInt32
    End Function

    <DllImport("kernel32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
    Public Function GetModuleHandle(ByVal lpModuleName As String) As UInt32
    End Function
#End Region

#Region "Memory Reading"

    Private Const BUFFER_SIZE As Integer = 16384

    Public Function readBytes(ByVal hProcess As Integer, ByVal lpBaseAddress As UInt32, ByVal nSize As UInteger) As Byte()
        Dim Buffer(CInt(nSize - 1)) As Byte
        ReadProcessMemory(hProcess, lpBaseAddress, Buffer, nSize, Nothing)
        Return Buffer
    End Function

    Public Function readDword(ByVal hProcess As Integer, ByVal lpBaseAddress As UInt32) As Int32
        Return BitConverter.ToInt32(readBytes(hProcess, lpBaseAddress, 4), 0)
    End Function

    Public Function readFloat(ByVal hProcess As Integer, ByVal lpBaseAddress As UInt32) As Single
        Return BitConverter.ToSingle(readBytes(hProcess, lpBaseAddress, 4), 0)
    End Function

    Public Function readWord(ByVal hProcess As Integer, ByVal lpBaseAddress As UInt32) As Int16
        Return BitConverter.ToInt16(readBytes(hProcess, lpBaseAddress, 2), 0)
    End Function

    Public Function readByte(ByVal hProcess As Integer, ByVal lpBaseAddress As UInt32) As Byte
        Return readBytes(hProcess, lpBaseAddress, 1)(0)
    End Function

    Public Function Scan(ByVal processHandle As Int32, ByVal pattern As Byte(), ByVal mask As String, ByVal startAddress As IntPtr, ByVal length As Integer) As IntPtr
        If processHandle = IntPtr.Zero Then Throw New ArgumentNullException("processHandle")
        If pattern Is Nothing Then Throw New ArgumentNullException("pattern")
        If length <= 0 Then Throw New ArgumentOutOfRangeException("length")
        If pattern.Length <> mask.Length Then Throw New ArgumentException("Both 'pattern' and 'mask' must be of equal length.")

        Dim results = Scan_impl(processHandle, pattern, mask, startAddress, length, True)
        Return If(results.Count = 1, results(0), IntPtr.Zero)
    End Function

    Public Function ScanAll(ByVal processHandle As Int32, ByVal pattern As Byte(), ByVal mask As String, ByVal startAddress As IntPtr, ByVal length As Integer) As List(Of IntPtr)
        If processHandle = IntPtr.Zero Then Throw New ArgumentNullException("processHandle")
        If pattern Is Nothing Then Throw New ArgumentNullException("pattern")
        If length <= 0 Then Throw New ArgumentOutOfRangeException("length")
        If pattern.Length <> mask.Length Then Throw New ArgumentException("Both 'pattern' and 'mask' must be of equal length.")

        Dim results = Scan_impl(processHandle, pattern, mask, startAddress, length, False)
        Return results
    End Function

    Private Function Scan_impl(ByVal processHandle As Int32, ByVal pattern As Byte(), ByVal mask As String, ByVal startAddress As IntPtr, ByVal length As Integer, Optional ByVal shortCircuit As Boolean = True) As List(Of IntPtr)
        Dim blockSize As Integer = Math.Min(length, BUFFER_SIZE)
        Dim iterator As Integer = 0
        Dim read As UIntPtr = UIntPtr.Zero
        Dim buffer(blockSize - 1) As Byte
        Dim cmask = mask.ToCharArray()
        Dim results As New List(Of IntPtr)

        While iterator < length
            If Not ReadProcessMemory(processHandle, New IntPtr(startAddress.ToInt64() + iterator), buffer, CType(Math.Min(blockSize, length - iterator), UIntPtr), read) Then
                Throw New InvalidOperationException("Unable to read memory from the target process. Please ensure the process handle is valid and has correct read permissions.")
            End If

            Dim location = Scan_search(buffer, pattern, cmask, read.ToUInt32(), shortCircuit)
            If location.Count > 0 Then
                results.AddRange(location.Select(Function(i) New IntPtr(iterator + startAddress.ToInt32() + i)))
                If shortCircuit Then Return results
            End If

            iterator += read.ToUInt32()
        End While

        Return results
    End Function

    Private Function Scan_search(ByVal haystack As Byte(), ByVal pattern As Byte(), ByVal mask As Char(), ByVal length As Integer, Optional ByVal shortCircuit As Boolean = True) As List(Of Integer)
        Dim results As New List(Of Integer)

        For i As Integer = 0 To (length - pattern.Length - 1)
            For j As Integer = 0 To (pattern.Length - 1)
                If mask(j) = "?"c OrElse (haystack(i + j) = pattern(j)) Then
                    If j = (pattern.Length - 1) Then
                        results.Add(i)
                        If shortCircuit Then Return results
                    End If
                Else
                    Exit For ' no point iterating i * j times, can exit this loop as soon as a mismatch is identified
                End If
            Next j
        Next i

        Return results
    End Function

    Public Function ReadPointerFromMemory(ByVal hProcess As Integer, ByVal BaseAddress As Integer, ByVal PointerOffset As Integer, ByVal BytesToRead As Integer) As Integer
        Dim BytesAtAddress As Byte() = New Byte(BytesToRead - 1) {}
        Dim BytesRead As Integer
        Dim MemoryBase As Integer
        Dim ReturnVal As Integer
        ReadProcessMemory(hProcess, CType(BaseAddress, IntPtr), BytesAtAddress, BytesToRead, BytesRead)
        MemoryBase = BitConverter.ToInt32(BytesAtAddress, 0)
        MemoryBase += PointerOffset
        ReadProcessMemory(hProcess, CType(MemoryBase, IntPtr), BytesAtAddress, BytesToRead, BytesRead)
        ReturnVal = BitConverter.ToInt32(BytesAtAddress, 0)
        Return ReturnVal
    End Function

    Public Function RemoteGetProcAddressManual(ByVal hProcess As Integer, ByVal ModuleAddress As UInteger, ByVal Export As String) As UInteger

        Dim PEHeaderOffset As UInteger = BitConverter.ToUInt32(readBytes(hProcess, CType(ModuleAddress + &H3C, IntPtr), 4), 0)
        Dim ExportRVA As UInteger = BitConverter.ToUInt32(readBytes(hProcess, CType(ModuleAddress + PEHeaderOffset + &H78, IntPtr), 4), 0)
        Dim IExportDir() As Byte = readBytes(hProcess, CType(ModuleAddress + ExportRVA, IntPtr), 40)
        Dim NamesCnt As Integer = BitConverter.ToInt32(IExportDir, 24)
        Dim Names As UInteger = BitConverter.ToUInt32(IExportDir, 32) + ModuleAddress
        Dim FuncAddress As UInteger = BitConverter.ToUInt32(IExportDir, 28) + ModuleAddress
        Dim Ordinals As UInteger = BitConverter.ToUInt32(IExportDir, 36) + ModuleAddress

        Dim tpAddress, ApiAddress, Ord As UInteger
        Dim ApiString As String = Nothing
        Dim Ptr As IntPtr = Runtime.InteropServices.Marshal.AllocHGlobal(64)

        For i = 1 To NamesCnt
            tpAddress = BitConverter.ToUInt32(readBytes(hProcess, CType(Names + ((i - 1) * 4), IntPtr), 4), 0)
            Runtime.InteropServices.Marshal.Copy(readBytes(hProcess, CType(ModuleAddress + tpAddress, IntPtr), 64), 0, Ptr, 64)
            ApiString = Runtime.InteropServices.Marshal.PtrToStringAnsi(Ptr)
            Ord = BitConverter.ToInt16(readBytes(hProcess, CType(Ordinals + ((i - 1) * 2), IntPtr), 2), 0)
            ApiAddress = BitConverter.ToUInt32(readBytes(hProcess, CType(FuncAddress + (Ord * 4), IntPtr), 4), 0) + ModuleAddress

            If String.Compare(ApiString, Export, True) = 0 Then
                Runtime.InteropServices.Marshal.FreeHGlobal(Ptr)
                Return ApiAddress
            End If

        Next

        Runtime.InteropServices.Marshal.FreeHGlobal(Ptr)
        Return Nothing

    End Function

    Public Function GetModuleBaseAddress(ByVal strProcess As String, ByVal strModule As String) As IntPtr
        Dim hSnapshot As IntPtr = CreateToolhelp32Snapshot(&H18, CUInt(Diagnostics.Process.GetProcessesByName(strProcess)(0).Id))
        If hSnapshot = Nothing Then Return Nothing
        Dim me32Modules As New MODULEENTRY32
        me32Modules.U32Size = CUInt(Runtime.InteropServices.Marshal.SizeOf(me32Modules))
        If Module32First(hSnapshot, me32Modules) Then
            Do

                If Not me32Modules.ModBaseAddr.ToInt64 > &H7FFFFFFF Then
                    If String.Compare(strModule, me32Modules.SzModule, True) = 0 Then Return me32Modules.ModBaseAddr
                Else
                End If
            Loop While (Module32Next(hSnapshot, me32Modules))
        End If
        Return Nothing
    End Function

    Public Function GetModuleBaseAddress1(ByVal strProcess As String, ByVal strModule As String) As IntPtr
        Dim p As Process = Process.GetProcessesByName(strProcess)(0)
        For Each moz As System.Diagnostics.ProcessModule In p.Modules
            If (moz.ModuleName.ToLower = strModule.ToLower) Then

                Return moz.BaseAddress
            End If
        Next
        Return Nothing
    End Function
#End Region

#Region "Memory Writing"

    Public Sub writeBytes(ByVal hProcess As IntPtr, ByVal lpBaseAddress As IntPtr, ByVal writeBytes As Byte(), ByVal nSize As UInt32)
        WriteProcessMemory(hProcess, lpBaseAddress, writeBytes, nSize, vbNull)
    End Sub

    Public Sub writeDword(ByVal hProcess As IntPtr, ByVal lpBaseAddress As IntPtr, ByVal dwordToWrite As Int32)
        Dim bytesToWrite As Byte() = BitConverter.GetBytes(dwordToWrite)
        writeBytes(hProcess, lpBaseAddress, bytesToWrite, 4)
    End Sub

    Public Sub writeFloat(ByVal hProcess As IntPtr, ByVal lpBaseAddress As IntPtr, ByVal floatToWrite As Single)
        Dim bytesToWrite As Byte() = BitConverter.GetBytes(floatToWrite)
        writeBytes(hProcess, lpBaseAddress, bytesToWrite, 4)
    End Sub

    Public Sub writeWord(ByVal hProcess As IntPtr, ByVal lpBaseAddress As IntPtr, ByVal wordToWrite As Int16)
        Dim bytesToWrite As Byte() = BitConverter.GetBytes(wordToWrite)
        writeBytes(hProcess, lpBaseAddress, bytesToWrite, 2)
    End Sub

    Public Sub writeByte(ByVal hProcess As IntPtr, ByVal lpBaseAddress As IntPtr, ByVal byteToWrite As Byte)
        Dim bytesToWrite As Byte() = {byteToWrite}
        writeBytes(hProcess, lpBaseAddress, bytesToWrite, 1)
    End Sub

#End Region

End Module