Source Code Nether's Visual Basic Memory Class

Hexui Undetected CSGO Cheats Sinkicheat PUBG Cheat

Nether

The Angel Of Verdun
Meme Tier VIP
Dank Tier Donator
Dec 11, 2013
293
3,738
16
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

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
 

Attachments

Last edited by a moderator:
Attention! Before you post:

Read the How to Ask Questions Guide
99% of questions are answered in the Beginner's Guide, do it before asking a question.

No Hack Requests. Post in the correct section.  Search the forum first. Read the rules.

How to make a good post:

  • Fill out the form correctly
  • Tell us the game name & coding language
  • Post everything we need to know to help you
  • Ask specific questions, be descriptive
  • Post errors, line numbers & screenshots
  • Post code snippets using code tags
  • If it's a large project, zip it up and attach it

If you do not comply, your post may be deleted.  We want to help, please make a good post and we will do our best to help you.

Community Mods