Hey Guys,
Since some people are looking to make trainers in VB i thought i would release my old source, this has been publicly released else where under an old name but putting here i think would help some people
Trainer.vb
Since some people are looking to make trainers in VB i thought i would release my old source, this has been publicly released else where under an old name but putting here i think would help some people
Trainer.vb
C#:
Imports System.Runtime.InteropServices
Imports System.Globalization
Imports System.Text.RegularExpressions
Imports System.Text
Public Class ProcMem
#Region " API "
<DllImport("kernel32.dll")> _
Public Shared Function ReadProcessMemory(ByVal hProcess As IntPtr, ByVal lpBaseAddress As Integer, ByVal buffer As Byte(), ByVal size As Integer, ByVal lpNumberOfBytesRead As Integer) As Boolean
End Function
<DllImport("kernel32.dll")> _
Public Shared Function WriteProcessMemory(ByVal hProcess As IntPtr, ByVal lpBaseAddress As Integer, ByVal buffer As Byte(), ByVal size As Integer, ByVal lpNumberOfBytesWritten As Integer) As Boolean
End Function
<DllImport("kernel32.dll", SetLastError:=True)> _
Public Shared Function VirtualAllocEx(ByVal hProcess As IntPtr, ByVal lpAddress As IntPtr, ByVal dwSize As Integer, ByVal flAllocationType As UInt32, ByVal flProtect As UInt32) As IntPtr
End Function
<DllImport("user32.dll")> _
Public Shared Function GetKeyState(ByVal nVirtKey As Keys) As Short
End Function
<DllImport("user32.dll", CharSet:=CharSet.Auto)> _
Public Shared Function PostMessage(ByVal hhwnd As IntPtr, ByVal msg As UInt32, ByVal wparam As IntPtr, ByVal lparam As IntPtr) As Boolean
End Function
<DllImport("kernel32", CharSet:=CharSet.Auto, SetLastError:=True)> _
Public Shared 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, ExactSpelling:=True)> _
Private Shared Function VirtualFreeEx(ByVal hProcess As IntPtr, ByVal lpAddress As IntPtr, ByVal dwSize As Byte, ByVal dwFreeType As UInt32) As Boolean
End Function
#End Region
#Region " Get Process "
Public Sub GetProcess(ByVal ProcessName As String)
If ProcessName <> String.Empty Then
PName = ProcessName
MakeTimer(New EventHandler(AddressOf ProcTimer), 100)
End If
End Sub
Private Sub ProcTimer(ByVal sender As Object, ByVal e As EventArgs)
If (Not ProcActive) Then
Proc = Process.GetProcessesByName(PName)
ProcActive = Proc.Length <> 0
End If
Try
ProcActive = Not Proc(0).HasExited
iHandle = Proc(0).MainWindowHandle
Catch obj1 As Exception
iHandle = IntPtr.Zero
ProcActive = False
End Try
End Sub
Private Sub MakeTimer(ByVal iTimed As EventHandler, ByVal iIntervals As Integer)
Dim timer As New Timer
timer.Interval = iIntervals
timer.Start()
AddHandler timer.Tick, New EventHandler(AddressOf iTimed.Invoke)
End Sub
#End Region
#Region " Storage "
Private Proc As Process()
Private iHandle As IntPtr
Public iActive As Boolean
Protected PName As String
Public ProcActive As Boolean
Private CodeCave As New List(Of IntPtr)
Private OldScan As New List(Of String)
#End Region
#Region " Read Memory "
Public Function rBytes(ByVal _A As Integer, ByVal _S As Integer) As Byte()
Dim buff As Byte() = New Byte(_S - 1) {}
If ProcActive Then
ReadProcessMemory(Proc(0).Handle, _A, buff, _S, 0)
End If
Return buff
End Function
Public Function Read(ByVal _Address As Integer, ByVal MemType As Object) As Object
If (_Address <> -1) Then
Select Case Array.IndexOf(Of Object)(New Object() {GetType(Byte), GetType(Integer), GetType(UInt32), GetType(Single), GetType(Double)}, MemType)
Case 0
Return rBytes(_Address, 1)(0)
Case 1
Return BitConverter.ToInt32(rBytes(_Address, 4), 0)
Case 2
Return BitConverter.ToUInt32(rBytes(_Address, 4), 0)
Case 3
Return BitConverter.ToSingle(rBytes(_Address, 4), 0)
Case 4
Return BitConverter.ToDouble(rBytes(_Address, 8), 0)
Case -1
Return -1
End Select
End If
Return -1
End Function
Public Function Read(ByVal _Address As String, ByVal MemType As Object) As Object
Return Read(Pointer(_Address), MemType)
End Function
Public Function ReadString(ByVal _Address As Integer, ByVal _Length As Integer, ByVal UnicodeType As Boolean) As String
If (_Address <> -1) Then
Return CutString(Encoding.ASCII.GetString(rBytes(_Address, _Length)))
End If
Return String.Empty
End Function
Public Function ReadF(ByVal _Address As Integer) As Integer
Return BitConverter.ToSingle(rBytes(_Address, 4), 0)
End Function
Public Function ReadI(ByVal _Address As Integer) As Integer
Return BitConverter.ToInt32(rBytes(_Address, 4), 0)
End Function
#End Region
#Region " Write Memory "
Private Function wBytes(ByVal _A As Integer, ByVal _B As Byte()) As Boolean
If ProcActive Then
Return IIf(ProcActive, WriteProcessMemory(Proc(0).Handle, _A, _B, _B.Length, 0), False)
End If
Return True
End Function
Public Sub WriteString(ByVal _Address As IntPtr, ByVal pBytes As String)
wBytes(_Address, System.Text.Encoding.ASCII.GetBytes((pBytes & ChrW(0))))
End Sub
Public Sub Write(ByVal _Address As Integer, ByVal Value As String, ByVal MemType As Object)
WriteMem(_Address, Value, MemType)
End Sub
Public Sub Write(ByVal _Address As String, ByVal Value As Integer, ByVal MemType As Object)
WriteMem(Pointer(_Address), Value, MemType)
End Sub
Public Sub Write(ByVal _Address As String, ByVal Value As Object, ByVal MemType As Object)
WriteMem(Pointer(_Address), Value, MemType)
End Sub
Public Function Write(ByVal _Address As String, ByVal _Hack As String, ByVal _Default As String, ByVal MemType As Object) As Boolean
Return Write(Pointer(_Address), _Hack, _Default, MemType)
End Function
Public Function Write(ByVal _Address As Integer, ByVal _Hack As String, ByVal _Default As String, ByVal MemType As Object) As Boolean
Dim B As Boolean = Integrity(_Address, _Default, MemType)
Dim Val As String = IIf(B, _Hack, _Default)
WriteMem(_Address, Val, MemType)
Return B
End Function
Public Sub WriteU(ByVal _Address As IntPtr, ByVal pBytes As UInteger)
wBytes(_Address, BitConverter.GetBytes(pBytes))
End Sub
Public Sub writeF(ByVal _Address As Integer, ByVal pBytes As Single)
wBytes(_Address, BitConverter.GetBytes(pBytes))
End Sub
Public Sub Write(ByVal _Address As IntPtr, ByVal pBytes As Integer)
wBytes(_Address, BitConverter.GetBytes(pBytes))
End Sub
Private Sub WriteMem(ByVal _Address As Integer, ByVal _Hack As String, ByVal MemType As Object)
If (_Address <> -1 And _Hack <> String.Empty) Then
Select Case Array.IndexOf(Of Object)(New Object() {GetType(Byte), GetType(Integer), GetType(UInt32), GetType(Single), GetType(Double)}, MemType)
Case 0
wBytes(_Address, BitConverter.GetBytes(Byte.Parse(_Hack)))
Exit Select
Case 1
wBytes(_Address, BitConverter.GetBytes(Integer.Parse(_Hack)))
Exit Select
Case 2
wBytes(_Address, BitConverter.GetBytes(UInt32.Parse(_Hack)))
Exit Select
Case 3
wBytes(_Address, BitConverter.GetBytes(Single.Parse(_Hack)))
Exit Select
Case 4
wBytes(_Address, BitConverter.GetBytes(Double.Parse(_Hack)))
Exit Select
End Select
End If
End Sub
#End Region
#Region " Allocate Memory "
Private Function Allocate() As Integer
If ProcActive Then
Dim iCave As IntPtr = VirtualAllocEx(Proc(0).Handle, IntPtr.Zero, &H200, &H1000, &H40)
If (iCave <> IntPtr.Zero) Then
CodeCave.Add(iCave)
Return iCave.ToInt32
End If
End If
Return -1
End Function
#End Region
#Region " Deallocate Memory "
Public Function DeAllocate(ByVal Addy As Integer, ByVal DefaultBytes As String, ByVal MA As Boolean) As Boolean
If (ProcActive And Addy <> -1 And DefaultBytes <> String.Empty AndAlso Addy <> -1) Then
Dim Index As Integer = -1
For i As Integer = 0 To CodeCave.Count - 1
If (Convert.ToBase64String(rBytes(Addy + 1, 4)) = Convert.ToBase64String(BitConverter.GetBytes((CodeCave.Item(i).ToInt32 + IIf(MA, 8, 0)) - Addy - 5))) Then
Index = i
End If
Next
If (Index <> -1) Then
Dim tmp As IntPtr = CodeCave.Item(Index)
If (tmp <> IntPtr.Zero AndAlso wBytes(Addy, HX2Bts(DefaultBytes))) Then
VirtualFreeEx(Proc(0).Handle, tmp, 0, &H8000)
CodeCave.RemoveAt(Index)
Return True
End If
End If
End If
Return False
End Function
#End Region
#Region " Aob Scan Function "
Public Function AobScan(ByVal Base_Address As Integer, ByVal _Range As Integer, ByVal Signature As String) As Integer
If (ProcActive And Base_Address <> -1 And Signature <> String.Empty) Then
Dim New_String As String = Regex.Replace(Signature.Replace("??", "3F"), "[^a-fA-F0-9]", "")
Dim tmp As Integer = RetOldScan(New_String)
If tmp >= Base_Address And tmp <= (Base_Address + _Range) Then
Return tmp
End If
Dim SearchFor As Byte() = New Byte((New_String.Length / 2) - 1) {}
For i As Integer = 0 To SearchFor.Length - 1
SearchFor(i) = Byte.Parse(New_String.Substring((i * 2), 2), NumberStyles.HexNumber)
Next i
Dim SearchIn As Byte() = New Byte(_Range - 1) {}
ReadProcessMemory(Proc(0).Handle, Base_Address, SearchIn, _Range, 0)
Dim Z As Integer = 0, iIndex As Integer = 0
Dim iEnd As Integer = If((SearchFor.Length < &H20), SearchFor.Length, &H20)
Dim sBytes As Integer() = New Integer(&H100 - 1) {}
For j As Integer = 0 To iEnd - 1
If (SearchFor(j) = &H3F) Then
Z = (Z Or (CInt(1) << ((iEnd - j) - 1)))
End If
Next j
If (Z <> 0) Then
For k As Integer = 0 To sBytes.Length - 1
sBytes(k) = Z
Next k
End If
Z = 1
Dim index As Integer = (iEnd - 1)
Do While (index >= 0)
sBytes(SearchFor(index)) = (sBytes(SearchFor(index)) Or Z)
index -= 1
Z = (Z << 1)
Loop
Do While (iIndex <= (SearchIn.Length - SearchFor.Length))
Z = (SearchFor.Length - 1)
Dim length As Integer = SearchFor.Length
Dim m As Integer = -1
Do While (m <> 0)
m = (m And sBytes(SearchIn((iIndex + Z))))
If (m <> 0) Then
If (Z = 0) Then
OldScan.Add((Base_Address + iIndex).ToString("X") + " " + New_String)
Return (Base_Address + iIndex)
End If
length = Z
End If
Z -= 1
m = (m << 1)
Loop
iIndex += length
Loop
End If
Return -1
End Function
Public Function AobScan(ByVal Base_Address As String, ByVal _Range As Integer, ByVal Signature As String) As Integer
Return AobScan(Pointer(Base_Address), _Range, Signature)
End Function
#End Region
#Region " Patch/Inject "
Public Function Patch(ByVal _Address As Integer, ByVal Patched_Bts As String, ByVal Default_Bts As String) As Boolean
Dim B As Boolean = False
If (ProcActive And Patched_Bts <> String.Empty And Default_Bts <> String.Empty And _Address <> -1) Then
B = Integrity(_Address, Default_Bts)
Dim pBytes As Byte() = IIf(B, HX2Bts(Patched_Bts), HX2Bts(Default_Bts))
wBytes(_Address, pBytes)
End If
Return B
End Function
Public Function Patch(ByVal _Address As String, ByVal Patched_Bts As String, ByVal Default_Bts As String) As Boolean
Return Patch(Pointer(_Address), Patched_Bts, Default_Bts)
End Function
Public Function Inject(ByVal _Address As Integer, ByVal Inject_Bts As String, ByVal Default_Bts As String, ByVal _Jump As Boolean) As Integer
Default_Bts = DoubleSpace(Default_Bts, "")
If (Default_Bts.Length / 2) < 5 Then
MessageBox.Show("The Default bytes can't be less than 5. You'l need to use the next instruction atleast 5 bytes away")
Return -1
End If
If (ProcActive And Inject_Bts <> String.Empty And _Address <> -1) Then
Inject_Bts = DoubleSpace(Inject_Bts, "")
If Integrity(_Address, Default_Bts) Then
Dim Cave As Integer = Allocate()
If (Cave <> -1) Then
Inject(_Address, Inject_Bts, Default_Bts, _Jump, Cave)
Return Cave
End If
ElseIf Not DeAllocate(_Address, Default_Bts, False) Then
Dim Cave As Integer = Allocate()
If (Cave <> -1) Then
Inject(_Address, Inject_Bts, Default_Bts, _Jump, Cave)
Return Cave
End If
End If
End If
Return -1
End Function
Public Function Inject(ByVal _Address As String, ByVal Inject_Bts As String, ByVal Default_Bts As String, ByVal _Jump As Boolean) As Integer
Return Inject(Pointer(_Address), Inject_Bts, Default_Bts, _Jump)
End Function
Private Sub Inject(ByVal Addy As Integer, ByVal Inject_Bts As String, ByVal Default_Bts As String, ByVal _Jump As Boolean, ByVal Cave As Integer)
If Not _Jump Then
wBytes(Cave, HX2Bts(Inject_Bts + "C3"))
wBytes(Addy, HX2Bts(JmpCall(Cave, Addy, (Default_Bts.Length / 2), False)))
Else
wBytes(Cave, HX2Bts(Inject_Bts + JumpBack(Cave + (Inject_Bts.Length / 2), Addy + (Default_Bts.Length / 2))))
wBytes(Addy, HX2Bts(JmpCall(Cave, Addy, (Default_Bts.Length / 2), True)))
End If
End Sub
Public Function Accessed(ByVal _Address As Integer, ByVal Default_Bts As String, ByVal Register As String, ByVal _Jump As Boolean) As Integer
Default_Bts = DoubleSpace(Default_Bts, "")
If (Default_Bts.Length / 2) < 5 Then
MessageBox.Show("The Default bytes can't be less than 5. You'l need to use the next instruction atleast 5 bytes away")
Return -1
End If
If (ProcActive And _Address <> -1 And Register.IndexOf("ecx", StringComparison.OrdinalIgnoreCase) = -1) Then
If Integrity(_Address, Default_Bts) Then
Dim _Len As Integer = IIf(_Jump, &H3A, &H36)
Dim Cave As Integer = Allocate()
If (Cave <> -1) Then
Dim Opcode As String = ConOp(Cave, "ecx", 0) + ConOp(Cave + 4, "ecx", 1) + ConOp(Cave + _Len, Register, 2) + "83f978740583c104eb05b900000000" + ConOp(Cave + 4, "ecx", 0) + ConOp(Cave, "ecx", 1)
Dim Inj As Byte() = HX2Bts(Opcode + IIf(_Jump, JumpBack(Cave + 8 + (Opcode.Length / 2), _Address + (Default_Bts.Length / 2)), "C3"))
wBytes(Cave + 8, Inj)
wBytes(_Address, HX2Bts(JmpCall(Cave + 8, _Address, (Default_Bts.Length / 2), _Jump)))
Return (Cave + _Len)
End If
Else
DeAllocate(_Address, Default_Bts, True)
End If
End If
Return -1
End Function
Public Function Accessed(ByVal _Address As String, ByVal Default_Bts As String, ByVal Register As String, ByVal _Jump As Boolean) As Integer
Return Accessed(Pointer(_Address), Default_Bts, Register, _Jump)
End Function
#End Region
#Region " Pointers/Module "
Public Function _Module(ByVal _Address As String) As Integer
If (ProcActive And _Address <> String.Empty) Then
If (_Address.IndexOf("+", StringComparison.Ordinal) = -1) Then
Return Integer.Parse(_Address, NumberStyles.HexNumber)
End If
Dim tmp As String() = _Address.Split(New Char() {"+"c})
For Each M As ProcessModule In Proc(0).Modules
If (M.ModuleName.ToLower = tmp(0).ToLower) Then
Return (M.BaseAddress.ToInt32 + Integer.Parse(tmp(1), NumberStyles.HexNumber))
End If
Next
End If
Return -1
End Function
Public Function Pointer(ByVal Address_Offsets As String) As Integer
Address_Offsets = RemoveChar(DoubleSpace(Address_Offsets, " "))
Dim tmp As String() = Address_Offsets.Split(New Char() {" "c})
Dim _Addy As Integer = _Module(tmp(0))
If (tmp.Length = 1) Then
Return _Addy
End If
_Addy = BitConverter.ToInt32(rBytes(_Addy, 4), 0)
Dim i As Integer
For i = 1 To tmp.Length - 1
Dim Off As Integer = Integer.Parse(tmp(i), NumberStyles.HexNumber)
_Addy = IIf(i <> (tmp.Length - 1), BitConverter.ToInt32(rBytes(_Addy + Off, 4), 0), _Addy + Off)
Next i
Return _Addy
End Function
#End Region
End Class
C#:
Imports System.Runtime.InteropServices
Imports System.Text.RegularExpressions
Imports System.Globalization
Imports System.Text
Public Class Trainer
Dim Mem As ProcMem = New ProcMem
Private Sub Trainer_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Mem.GetProcess("BlackOps")
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Mem.Write("BlackOps.exe+180FE40", 1337, GetType(Integer))
Mem.WriteString(&HC18E80, "I Wrote Text To An Address")
Mem.Patch("406DEA", "90909090909090909090", "F783FC0400000000000C")
Mem.Write("BDF31C 18", "1008981770", GetType(Integer)) 'Use Of Pointer
Mem.Inject("5C8B39", "C7 86 84 01 00 00 00 00 00 00", "89BE84010000", True)
Dim Addy As Integer = Mem.Get_Addy(&H8BFFA45, 55, "8B 55 66 32") 'get address works as aob scanner
mem.Write(Addy, 133.37, GetType(Float))
Dim bConsole As Byte() = Mem.rBytes(Mem.AobScan("BlackOps.exe+0", &H500000, "F705????????500100007415") + 2, 4)
iConsole = Mem.Convert_Opcode(bConsole)
Mem.RemoveProtection("BlackOps", &HA3FDD8, 512)'Remove Protection + Size At An Address Like Jump_Height
Dim Address As Integer = Mem._Module("client.dll+A6BE2C")
Mem.Write(Address, 5, GetType(integer))
End Sub
End Class
Last edited by a moderator:
