Making Jump To Codecave for X6 bit process, How to make It Work correct.

Imports System.ComponentModel
 Module Module1
 #Region "Declarations"
     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
     Declare Function VirtualProtectEx Lib "kernel32.dll" (ByVal hProcess As IntPtr, ByVal lpAddress As IntPtr, ByVal dwSize As IntPtr, ByVal newProtect As Integer, ByRef oldProtect As Integer) As Boolean

     Public Declare Function CloseHandle Lib "KERNEL32" _
    (ByVal hObject As Int32) _
    As Boolean

     Public Declare Function GetAsyncKeyState Lib "USER32" _
     (ByVal vKey As Int32) _
     As Int16

     Public Declare Function IsDebuggerPresent Lib "KERNEL32" () As Boolean

     Public Declare Function OpenProcess Lib "KERNEL32" _
     (ByVal DesiredAccess As Int32, _
      ByVal InheritHandle As Boolean, _
      ByVal ProcessId As Int32) _
     As Int32

     Private Declare Function WriteProcessMemory Lib "kernel32" _
     (ByVal Handle As Integer, _
      ByVal address As Long, _
      ByRef Value As Int32, _
      ByVal Size As Integer, _
      ByRef lpNumberOfBytesWritten As Long) _
     As Long

     Private Declare Function ReadProcessMemory Lib "kernel32" _
     (ByVal Handle As Int32, _
      ByVal address As Int32, _
      ByRef Value As Int32, _
      Optional ByVal Size As Int32 = 4, _
      Optional ByVal lpNumberOfBytesWritten As Int64 = 0) _
     As Integer

     'PROCESS ACCESS RIGHTS.
     Public PROCESS_TERMINATE As Int32 = 1
     Public PROCESS_CREATE_THREAD As Int32 = 2
     Public PROCESS_VM_OPERATION As Int32 = 8
     Public PROCESS_VM_READ As Int32 = 16
     Public PROCESS_VM_WRITE As Int32 = 32
     Public PROCESS_DUP_HANDLE As Int32 = 64
     Public PROCESS_CREATE_PROCESS As Int32 = 128
     Public PROCESS_SET_QUOTA As Int32 = 256
     Public PROCESS_SET_INFORMATION As Int32 = 512
     Public PROCESS_QUERY_INFORMATION As Int32 = 1024
     Public PROCESS_SUSPEND_RESUME As Int32 = 2048
     Public PROCESS_ALL_ACCESS As Int32 = 4091

     'ALLOCATION TYPES.
     Public MEM_COMMIT As Int32 = 4096
     Public MEM_RESERVE As Int32 = 8192
     Public MEM_RESET As Int32 = 524288
     Public MEM_TOP_DOWN As Int32 = 1048576
     Public MEM_PHYSICAL As Int32 = 4194304

     'MEMORY PROTECTION TYPES.
     Public PAGE_NOACCESS As Int32 = 1
     Public PAGE_READONLY As Int32 = 2
     Public PAGE_READWRITE As Int32 = 4
     Public PAGE_WRITECOPY As Int32 = 8
     Public PAGE_EXECUTE As Int32 = 16
     Public PAGE_EXECUTE_READ As Int32 = 32
     Public PAGE_EXECUTE_READWRITE As Int32 = 64
     Public PAGE_EXECUTE_WRITECOPY As Int32 = 128

     Private Const ACCESS_RIGHTS_ALL = &H1F0FFF
     Private process_id As Int32 = 0
     Public pHandle As Integer = 0
     Dim FlagValue As Integer
     Public Function GetProcessId(ByVal game_name As String) As Boolean 'Checks to see if the game is running (returns True or False) and sets th pHandle *REQUIRED TO USE*
         For Each p As Process In Process.GetProcessesByName(game_name)
             process_id = p.Id
             pHandle = OpenProcess(56, False, process_id)
             Return True
         Next
         Return False
     End Function
 #End Region
 #Region "Memory Allocations"
     Public Function AllocMem() As Integer 'Allocates memory in the process and returns the starting address of the allocated area
         Dim pBlob As IntPtr = VirtualAllocEx(pHandle, New IntPtr(), New IntPtr(2048), MEM_COMMIT, PAGE_EXECUTE_READWRITE)
         If pBlob = IntPtr.Zero Then
             Return 0
             MsgBox("The trainer couldn't implant the cheats. Please restart the trainer.", MsgBoxStyle.Critical, "Error")

         Else : Return pBlob
         End If
     End Function
     Sub RemoveProtection(ByVal AddressOfStart As Integer) 'Changes the protection of the page with the specified starting address to PAGE_EXECUTE_READWRITE
         Dim oldProtect As Integer
         If Not VirtualProtectEx(pHandle, New IntPtr(AddressOfStart), New IntPtr(2048), PAGE_EXECUTE_READWRITE, oldProtect) Then Throw New Win32Exception
     End Sub
 #End Region
 #Region "Write"
     Public Sub WriteByte(ByVal address As Int64, ByVal Value As Byte) 'Writes a single byte value
         WriteProcessMemory(pHandle, address, Value, 1, 0)
     End Sub
     Public Sub WriteInt32(ByVal address As IntPtr, ByVal Value As Int32) 'Writes a 4 bytes value
         WriteProcessMemory(pHandle, address, Value, 4, 0)
     End Sub
     Public Sub WriteASM(ByVal address As Int64, ByVal Value As Byte()) 'Writes assembly using bytes
         For i As Long = LBound(Value) To UBound(Value)
             WriteByte(address + i, Value(i))
         Next
     End Sub
     Public Function WritePointer(ByVal Pointer As Long, ByVal Buffer As Int32, ByVal OffSet() As Int32) 'Writes to a pointer
         For Each I As Integer In OffSet
             ReadProcessMemory(pHandle, Pointer, Pointer)
             Pointer += I
         Next
         WriteProcessMemory(pHandle, Pointer, Buffer, 4, 0)
         Return 0
     End Function
     Public Function WriteAddPointer(ByVal Pointer As Int32, ByVal Buffer As Int32, ByVal OffSet() As Int32) 'Adds a value to a pointer
         For Each I As Integer In OffSet
             ReadProcessMemory(pHandle, Pointer, Pointer)
             Pointer += I
         Next
         WriteProcessMemory(pHandle, Pointer, ReadInt32(Pointer) + Buffer, 4, 0)
         Return 0
     End Function
     ' 8 Bytes in den Przess schreiben
     Public Sub Write_Float(ByVal address As Int32, ByVal value As Int64)
         Dim process_handle As Int32
         process_handle = OpenProcess(ACCESS_RIGHTS_ALL, False, process_id)
         If process_handle <> 0 Then
             WriteProcessMemory(process_handle, address, value, 8, 0)
         End If
         CloseHandle(process_handle)
     End Sub
     ' Für die CodeInjection
     Public Sub autopatcher(ByVal address As Int32, ByVal value As Byte())
         Dim i As Byte
         For i = LBound(value) To UBound(value)
             WriteByte(address + i, value(i))
         Next
     End Sub
 #End Region



     Public Function AllocJump(ByVal source As Int32, ByVal destination As Int32, Optional ByVal Nops As Integer = 0) As Boolean 'Creates a jump from the specified address to a destination address
         WriteByte(source, &HE9)
         WriteInt32(source + 1, destination - source - 5)
         If Nops = 0 Then
             Return 0
         End If
         For i As Int32 = 1 To Nops
             WriteByte(source + 4 + i, &H90)
         Next
         Return 0
     End Function

Public Class Form1


     Private Const ProcName = "Outlast"
     Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
         GetProcessId(ProcName)
         'WriteASM(&H140446285, New Byte() {&H90, &H90, &H90, &H90, &H90})
         Dim pBlob As UInt64 = VirtualAllocEx(pHandle, New IntPtr(), New IntPtr(2048), MEM_COMMIT, PAGE_EXECUTE_READWRITE)
         TextBox1.Text = Hex(pBlob)' i use this to see the address in hex only
         Dim caveAddr = pBlob

         AllocJump(&H13CF0006, caveAddr)  'This Works fine 

     End Sub


 End Class

AllocJump(ByVal source As Int32, ByVal destination As Int32,

 Private Sub WriteX64JMP(ByVal WindowName As String, ByRef Address As Long, ByVal JMP As Long)
        Dim XprocX As String

        Dim hWnd As Long, hProcess As Long, pid As Long
        hWnd = FindWindowA(vbNullString, Game.Text)
        XprocX = Game.Text
        If hWnd = 0 Then
            Exit Sub
        End If
        If GetWindowThreadProcessId(hWnd, pid) = 0 Then
            Exit Sub
        End If
        hProcess = OpenProcess(4091, False, pid)
        If hProcess = 0 Then
            Exit Sub
        End If

        JMP = JMP - Address - 14
        WriteMemory(Of Integer)(Address, 255)
        Call WriteMemoryASM((XprocX), Address + 1, "250000")
        WriteMemory(Of Integer)(Address + 6, X64JMP)
        Call WriteMemoryASM((XprocX), Address + 10, "00000000")


        Address = Address + 14
        Call CloseHandle(hProcess)
    End Sub

Private Sub CommandX1_Click() '
    Dim pid As Long, hProcess As Long, hWin As Long
    Dim lpMem As Long, Ret As Long, lLenMBI As Long
    Dim lWritten As Long, CalcAddress As Long, lPos As Long
    Dim sReplaceString As String
    Dim si As SYSTEM_INFO
    Dim dwProcId    As Long
    Dim Pos1 As Variant
    Dim i As Integer
    
   '/**************************************************/
   hWin = FindWindowA(vbNullString, "Untitled - Notepad")
   Call GetWindowThreadProcessId(hWin, pid)
    
    hWin = hProcess '
    hProcess = OpenProcess(PROCESS_READ_WRITE_QUERY, False, pid)
    lLenMBI = Len(mbi)
    
    'Determine applications memory addresses range
    Call GetSystemInfo(si)
    
    lpMem = Int(&H20000000 / si.dwPageSize) * si.dwPageSize   'si.lpMinimumApplicationAddress
    
      'Scan memory
      Do While lpMem < Int("&H4FFFFFFF" / si.dwPageSize) * si.dwPageSize
        mbi.RegionSize = 0
        Ret = VirtualQueryEx(hProcess, ByVal lpMem, mbi, lLenMBI)
        If Ret = lLenMBI Then
              If (mbi.lType = MEM_PRIVATE) And (mbi.State = MEM_COMMIT) = True Then ' this block is In use by this process
          
   'My Array Of Bytes To Scan For
   '============================='
   Pos1 = ByteArray(&HCC, &HCC)

   Dim Array2str As String
   Array2str = StrConv(Pos1, vbUnicode)

  
  Dim Sbuffer As String
  Sbuffer = String(mbi.RegionSize, 0)

'Read region into string
 On Error GoTo Finished
                           
'Check if region contain search string
   ReadProcessMemory hProcess, ByVal mbi.BaseAddress, ByVal Sbuffer, mbi.RegionSize, lWritten
                                                  
        Dim MemPos As Long
       MemPos = InStr(1, Sbuffer, Array2str, vbTextCompare)
    If MemPos Then

        ArrayX(1).Text = Hex(mbi.BaseAddress + MemPos - 1)
                   

               If FinalAddress.Text = "0" Then
                    
                          
                      GoTo Finished
                      Exit Sub
                      End If
                           End If
                         End If
                      End If
                   End If
                End If
            End If
            

            On Error GoTo Finished
            lpMem = mbi.BaseAddress + mbi.RegionSize
            On Error GoTo Finished
        Else
            Exit Do
        End If
    Loop
    
    GoTo Finished
Finished:

   CloseHandle hProcess

PrivateSub Button8_Click(sender AsObject, e AsEventArgs) Handles Button8.Click


        
Dim hWnd AsLong

        
Dim Pid AsLong

        
Dim mbi AsMEMORY_BASIC_INFORMATION

        
Dim si AsSYSTEM_INFO

        
Dim hProcess AsIntPtr

        
Dim lpmem AsInteger

        
Dim lLenMBI AsLong

        
Dim lPos AsLong

        
Dim lWritten AsInteger

        


        
'/Titlte Name Of The Process Here!

        hWnd = FindWindowA(vbNullString, 
"Unitled - Notepad")

        
Call GetWindowThreadProcessId(hWnd, Pid)

        hProcess = OpenProcess(PROCESS_ALL_ACCESS, 
False, Pid)

        lLenMBI = Len(mbi)


        
Call GetSystemInfo(si)


        
'/Search Base

        lpmem = Int(&H400000)


        
' Scan memory To

        
DoWhile lpmem < Int(&H5FFFFFFF / si.dwPageSize) * si.dwPageSize


            mbi.RegionSize = 0


            
Dim ret AsUIntPtr = VirtualQueryEx(hProcess, lpmem, mbi, lLenMBI)


            
If ret = Len(mbi) Then


                
If mbi.RegionSize > 0 Then


                    
' If (mbi.State = MEM_COMMIT) = True Then 'This block is In use by this process


　

                    
Dim lBuffer() AsByte


　

                    
'/The Byte Array To Search For

                    
Dim bData() AsByte = NewByte() {&HCC, &HCC}


　

　

                    
Dim MyArray AsString

                    
'/Converting the array to a string

                    MyArray = System.Text.
Encoding.Unicode.GetString(bData)


　

                    
ReDim lBuffer(0 To Int(mbi.RegionSize / 4))

                    ReadProcessMemory(hProcess, mbi.BaseAddress, VarPtr(lBuffer(1)), mbi.RegionSize, lWritten)


　

                    
Dim MBuff AsString

                    MBuff = System.Text.
Encoding.Unicode.GetString(lBuffer)


　

                    lPos = InStr(1, MBuff, MyArray, vbTextCompare)

                    
If lPos > 0 Then


                        ListBox1.Items.Add(lPos)


                        
Exit Sub

                    
EndIf

                
EndIf


                lpmem = mbi.BaseAddress + mbi.RegionSize

            
Else

                
Exit Do

            
EndIf

        
Loop

    
EndSub

mov rax, address
jmp rax