' API <DllImport("kernel32.dll")> _ Private Function OpenProcess(ByVal dwDesiredAccess As UInteger, <MarshalAs(UnmanagedType.Bool)> ByVal bInheritHandle As Boolean, ByVal dwProcessId As Integer) As IntPtr End Function
<DllImport("kernel32.dll", SetLastError:=True)> _ Private Function WriteProcessMemory(ByVal hProcess As IntPtr, ByVal lpBaseAddress As IntPtr, ByVal lpBuffer As Byte(), ByVal nSize As IntPtr, <Out()> ByRef lpNumberOfBytesWritten As IntPtr) As Boolean End Function
<DllImport("kernel32.dll", SetLastError:=True)> _ Private Function ReadProcessMemory(ByVal hProcess As IntPtr, ByVal lpBaseAddress As IntPtr, <Out()> ByVal lpBuffer() As Byte, ByVal dwSize As IntPtr, ByRef lpNumberOfBytesRead As IntPtr) As Boolean End Function
<DllImport("kernel32.dll", SetLastError:=True)> Private Function CloseHandle(ByVal hObject As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean End Function
Private Const PROCESS_VM_WRITE As UInteger = &H20 Private Const PROCESS_VM_READ As UInteger = &H10 Private Const PROCESS_VM_OPERATION As UInteger = &H8 Private TargetProcess As String = "S4Client" Private ProcessHandle As IntPtr = IntPtr.Zero Private LastKnownPID As Integer = -1
' Function Process Id Exists: pID as Integer Private Function ProcessIDExists(ByVal pID As Integer) As Boolean For Each p As Process In Process.GetProcessesByName(TargetProcess) If p.Id = pID Then Return True Next Return False End Function
' Function Set Process Name: ProcessName as String Public Sub SetProcessName(ByVal processName As String) TargetProcess = processName If ProcessHandle <> IntPtr.Zero Then CloseHandle(ProcessHandle) LastKnownPID = -1 ProcessHandle = IntPtr.Zero End Sub
' Function Get Current Process Name, as String Public Function GetCurrentProcessName() As String Return TargetProcess End Function
' Function Update Process Handle, as Boolean Public Function UpdateProcessHandle() As Boolean If LastKnownPID = -1 OrElse Not ProcessIDExists(LastKnownPID) Then If ProcessHandle <> IntPtr.Zero Then CloseHandle(ProcessHandle) Dim p() As Process = Process.GetProcessesByName(TargetProcess) If p.Length = 0 Then Return False LastKnownPID = p(0).Id ProcessHandle = OpenProcess(PROCESS_VM_READ Or PROCESS_VM_WRITE Or PROCESS_VM_OPERATION, False, p(0).Id) If ProcessHandle = IntPtr.Zero Then Return False End If Return True End Function
' Function Read Memory: Address as Object Public Function ReadMemory(Of T)(ByVal address As Object) As T Return ReadMemory(Of T)(CLng(address)) End Function
' Function Read Memory: Address as Integer Public Function ReadMemory(Of T)(ByVal address As Integer) As T Return ReadMemory(Of T)(New IntPtr(address), 0, False) End Function
' Function Read Memory: Address as Long Public Function ReadMemory(Of T)(ByVal address As Long) As T Return ReadMemory(Of T)(New IntPtr(address), 0, False) End Function
' Function Read Memory: Address as IntPtr Public Function ReadMemory(Of T)(ByVal address As IntPtr) As T Return ReadMemory(Of T)(address, 0, False) End Function
' Function Read Memory: Address as IntPtr, Length as Integer Public Function ReadMemory(ByVal address As IntPtr, ByVal length As Integer) As Byte() Return ReadMemory(Of Byte())(address, length, False) End Function
' Function Read Memory: Address as Integer, Length as Integer Public Function ReadMemory(ByVal address As Integer, ByVal length As Integer) As Byte() Return ReadMemory(Of Byte())(New IntPtr(address), length, False) End Function
' Function Read Memory: Address as Long, Length as Integer Public Function ReadMemory(ByVal address As Long, ByVal length As Integer) As Byte() Return ReadMemory(Of Byte())(New IntPtr(address), length, False) End Function
' Function Read Memory: Address as IntPtr, Length as Integer, UnicodeString as Boolean Public Function ReadMemory(Of T)(ByVal address As IntPtr, ByVal length As Integer, ByVal unicodeString As Boolean) As T Dim buffer() As Byte If GetType(T) Is GetType(String) Then If unicodeString Then buffer = New Byte(length * 2 - 1) {} Else buffer = New Byte(length - 1) {} ElseIf GetType(T) Is GetType(Byte()) Then buffer = New Byte(length - 1) {} Else buffer = New Byte(Marshal.SizeOf(GetType(T)) - 1) {} End If If Not UpdateProcessHandle() Then Return Nothing Dim success As Boolean = ReadProcessMemory(ProcessHandle, address, buffer, New IntPtr(buffer.Length), IntPtr.Zero) If Not success Then Return Nothing If GetType(T) Is GetType(Byte()) Then Return CType(CType(buffer, Object), T) If GetType(T) Is GetType(String) Then If unicodeString Then Return CType(CType(Encoding.Unicode.GetString(buffer), Object), T) Return CType(CType(Encoding.ASCII.GetString(buffer), Object), T) End If Dim gcHandle As GCHandle = gcHandle.Alloc(buffer, GCHandleType.Pinned) Dim returnObject As T = CType(Marshal.PtrToStructure(gcHandle.AddrOfPinnedObject, GetType(T)), T) gcHandle.Free() Return returnObject End Function
' Function Get Object Bytes Private Function GetObjectBytes(ByVal value As Object) As Byte() If value.GetType() Is GetType(Byte()) Then Return CType(value, Byte()) Dim buffer(Marshal.SizeOf(value) - 1) As Byte Dim ptr As IntPtr = Marshal.AllocHGlobal(buffer.Length) Marshal.StructureToPtr(value, ptr, True) Marshal.Copy(ptr, buffer, 0, buffer.Length) Marshal.FreeHGlobal(ptr) Return buffer End Function
' Function Write Memory: Addres as Object, Value as T Public Function WriteMemory(Of T)(ByVal address As Object, ByVal value As T) As Boolean Return WriteMemory(CLng(address), value) End Function
' Function Write Memory: Address as Object, Value as Object Public Function WriteMemory(Of T)(ByVal address As Object, ByVal value As Object) As Boolean Return WriteMemory(CLng(address), CType(value, T)) End Function
' Function Write Memory: Address as Integer, Value as T Public Function WriteMemory(Of T)(ByVal address As Integer, ByVal value As T) As Boolean Return WriteMemory(New IntPtr(address), value) End Function
' Function Write Memory: Address as Integer, Value as Object Public Function WriteMemory(Of T)(ByVal address As Integer, ByVal value As Object) As Boolean Return WriteMemory(address, CType(value, T)) End Function
' Function Write Memory: Address as Long, Value as T Public Function WriteMemory(Of T)(ByVal address As Long, ByVal value As T) As Boolean Return WriteMemory(New IntPtr(address), value) End Function
' Function Write Memory: Address as Long, Value as Object Public Function WriteMemory(Of T)(ByVal address As Long, ByVal value As Object) As Boolean Return WriteMemory(address, CType(value, T)) End Function
' Function Write Memory: Address as IntPtr, Value as T Public Function WriteMemory(Of T)(ByVal address As IntPtr, ByVal value As T) As Boolean Return WriteMemory(address, value, False) End Function
' Function Write Memory: Address as IntPtr, Value as Object Public Function WriteMemory(Of T)(ByVal address As IntPtr, ByVal value As Object) As Boolean Return WriteMemory(address, CType(value, T), False) End Function
' Function Write Memory: Address as Object, Value as T, Unicode as Boolean Public Function WriteMemory(Of T)(ByVal address As Object, ByVal value As T, ByVal unicode As Boolean) As Boolean Return WriteMemory(CLng(address), value, unicode) End Function
' Function Write Memory: Address as Integer, Value as T, Unicode as Boolean Public Function WriteMemory(Of T)(ByVal address As Integer, ByVal value As T, ByVal unicode As Boolean) As Boolean Return WriteMemory(New IntPtr(address), value, unicode) End Function
' Function Write Memory: Address as Long, Value as T, Unicode as Boolean Public Function WriteMemory(Of T)(ByVal address As Long, ByVal value As T, ByVal unicode As Boolean) As Boolean Return WriteMemory(New IntPtr(address), value, unicode) End Function
' Function Write Memory: Address as IntPtr, Value as T, Unicode as Boolean Public Function WriteMemory(Of T)(ByVal address As IntPtr, ByVal value As T, ByVal unicode As Boolean) As Boolean If Not UpdateProcessHandle() Then Return False Dim buffer() As Byte If TypeOf value Is String Then If unicode Then buffer = Encoding.Unicode.GetBytes(value.ToString()) Else buffer = Encoding.ASCII.GetBytes(value.ToString()) Else buffer = GetObjectBytes(value) End If Dim result As Boolean = WriteProcessMemory(ProcessHandle, address, buffer, New IntPtr(buffer.Length), IntPtr.Zero) Return result End Function End Module
Versuch 1
PHP Code:
Private Sub GodMode_CheckedChanged(sender As Object, e As EventArgs) Handles GodMode.CheckedChanged If UpdateProcessHandle() Then WriteMemory(Of Long)(&H3Bxxxxx, 791xxxxx) End If End Sub
Nix passiert
Verscuh 2
PHP Code:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click If UpdateProcessHandle() Then WriteMemory(Of Long)(&H53xxxx, 234856xxxx) End If End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click WriteMemory(Of Long)(&H53xxxx, 234856xxxx) End Sub
wiederum nichts...
Versuch 3
PHP Code:
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick If UpdateProcessHandle() Then ' Check if the game is running ' Do stuff here, like writing/reading memory or telling a user in a Label the game is open. Dim LongValue As Long = ReadMemory(Of Single)(&H3BAxxxx) ReadMemory(Of Long)(&H53xxxx) End If
If GodMode.Checked Then WriteMemory(Of Long)(&H53xxxx, 234856xxxx) End If End Sub
passiert auch nix ...
Meine Frage:
PHP Code:
WriteMemory(Of Long)
Ist das Falsch? (The Long declaration)
Thx for upcomming Help
=================================
Edit;
PHP Code:
Public Class Form1
Private TargetProcess As String = "S4Client"
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick If UpdateProcessHandle() Then ' Check if the game is running RemoveProtection("S4Client", &H5367E4, 2147483647) ' Do stuff here, like writing/reading memory or telling a user in a Label the game is open. Dim LongValue As Long = ReadMemory(Of Single)(&H3BA8E07) ReadMemory(Of Long)(&H5367E4) End If End Sub
Private Sub Label1_TextChanged(sender As Object, e As EventArgs) Handles detectProcess.TextChanged detectProcess.Text = "S4Client.exe -" & UpdateProcessHandle() ' Changing The Color if the Process was Found If UpdateProcessHandle() = False Then detectProcess.ForeColor = Color.Red ElseIf UpdateProcessHandle() = True Then detectProcess.ForeColor = Color.Green End If End Sub
Private Sub Label1_Click_1(sender As Object, e As EventArgs) Handles Label1.TextChanged Label1.Text = ReadMemory(Of Long)(&H5367E4) End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click If UpdateProcessHandle() Then RemoveProtection("S4Client", &H5367E4, 2147483647) ReadMemory(Of Long)(&H5367E4) WriteMemory(Of Long)(&H5367E4, 2348565979) End If End Sub End Class
Nun wird der Prozess erkannt, und Label1 gibt nun den genannten Wert aus.
Jedoch Gibt's nun einen error beim Klicken des Button1
Sub 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 Sub
Gibt einen Error aus mit:
Quote:
Ein Ausnahmefehler des Typs "System.OverflowException" ist in WindowsApplication2.exe aufgetreten.
Zusätzliche Informationen: Die arithmetische Operation hat einen Überlauf verursacht.
Hinweis zur Fehlerbehebung:
Dividieren Sie nicht durch 0