Whats tmk. Display your coding.
ok i got the address for inf life Call WriteAFloat("AssaultCube", &H43810B, 909090909090#). but it freezes in game, i can get it to work in tmk but not vb. can someone please help me
Whats tmk. Display your coding.
There are two types of tragedies in life. One is not getting what you want, the other is getting it.
If you wake up at a different time in a different place, could you wake up as a different person?
I dont understand, i put it in and it freezes the game, while it will work if i patch it on tsearch
my code:
Private Sub Form_Load()
setgame ("AssaultCube")
End Sub
Private Sub Command6_Click()
Call WriteALong(&H43810B, 909090909090#)
End Sub
MOdule:
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal Classname As String, ByVal WindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function ReadProcessMem Lib "kernel32" Alias "ReadProcessMemory" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByRef lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public FindGame As Long
Public Sub WriteAByte(Address As Long, Value As Byte)
Dim pId&, pHandle&
If FindGame = 0 Then Exit Sub
GetWindowThreadProcessId FindGame, pId
pHandle = OpenProcess(&H1F0FFF, False, pId)
If pHandle = 0 Then Exit Sub
WriteProcessMemory pHandle, Address, Value, 1, 0&
CloseHandle pHandle
End Sub
Public Function ReadAscii(StartAddress As Long, EndAddress As Long) As String
Dim Address As Long, data As Integer
For Address = StartAddress To EndAddress
data = ReadAByte(Address, 1)
If data <= 0 Then Exit For
ReadAscii = ReadAscii & Chr(data)
Next Address
End Function
Public Sub WriteAscii(StartAddress As Long, WhatToWrite As String)
Dim Go As Long
For Go& = 0 To (Len(WhatToWrite) - 1)
Call WriteAByte((StartAddress + Go), Asc(Mid$(WhatToWrite, Go + 1)))
Next Go&
Call WriteAByte(StartAddress + Len(WhatToWrite), 0)
End Sub
Public Sub SetGame(WindowCaption As String)
FindGame = FindWindow(vbNullString, WindowCaption)
End Sub
Public Sub RawReadWrite(ReadAddress As Long, WriteAddress As Long)
Dim pId&, pHandle&, data&
Dim E As Integer
If FindGame = 0 Then Exit Sub
GetWindowThreadProcessId FindGame, pId
pHandle = OpenProcess(&H1F0FFF, False, pId)
If pHandle = 0 Then Exit Sub
For E = 1 To 4
ReadProcessMem pHandle, ReadAddress, data, 4, 0&
WriteProcessMemory pHandle, WriteAddress, data, 4, 0&
ReadAddress = ReadAddress + 4
WriteAddress = WriteAddress + 4
Next E
End Sub
Public Sub ReadWrite(ReadAddress As Long, WriteAddress As Long, Bytes As Integer)
SetGame ("Delta Force 2, V1.06.15")
Dim E As Integer
Dim P As Long
Dim XP As Long
Dim PX As Long
XP = WriteAddress
PX = ReadAddress
For E = 1 To (Bytes / 4)
P = ReadALong(PX, 0)
Call WriteALong(XP, P)
XP = XP + 4
PX = PX + 4
Next E
End Sub
Public Function WriteALong(Address As Long, Value As Long)
Dim pId&, pHandle&
If FindGame = 0 Then Exit Function
GetWindowThreadProcessId FindGame, pId
pHandle = OpenProcess(&H1F0FFF, False, pId)
If pHandle = 0 Then Exit Function
WriteProcessMemory pHandle, Address, Value, 4, 0&
CloseHandle pHandle
End Function
Public Function ReadALong(Address As Long, ByteBuffer As Long)
Dim pId&, pHandle&
If FindGame = 0 Then Exit Function
GetWindowThreadProcessId FindGame, pId
pHandle = OpenProcess(&H1F0FFF, False, pId)
If pHandle = 0 Then Exit Function
ReadProcessMem pHandle, Address, ByteBuffer, 4, 0&
ReadALong = ByteBuffer
CloseHandle pHandle
End Function
Public Function ReadAByte(Address As Long, ByteBuffer As Byte)
Dim pId&, pHandle&
If FindGame = 0 Then Exit Function
GetWindowThreadProcessId FindGame, pId
pHandle = OpenProcess(&H1F0FFF, False, pId)
If pHandle = 0 Then Exit Function
ReadProcessMem pHandle, Address, ByteBuffer, 1, 0&
ReadAByte = ByteBuffer
CloseHandle pHandle
End Function
Public Function WriteAInt(Address As Long, Value As Integer)
Dim pId&, pHandle&
If FindGame = 0 Then Exit Function
GetWindowThreadProcessId FindGame, pId
pHandle = OpenProcess(&H1F0FFF, False, pId)
If pHandle = 0 Then Exit Function
WriteProcessMemory pHandle, Address, Value, 1, 0&
CloseHandle pHandle
End Function
Public Function ReadAInt(Address As Long, ByteBuffer As Integer)
Dim pId&, pHandle&
If FindGame = 0 Then Exit Function
GetWindowThreadProcessId FindGame, pId
pHandle = OpenProcess(&H1F0FFF, False, pId)
If pHandle = 0 Then Exit Function
ReadProcessMem pHandle, Address, ByteBuffer, 2, 0&
ReadAInt = ByteBuffer
CloseHandle pHandle
End Function
Last edited by excod3; 01-21-2008 at 08:41 PM.
dont use the form load for setting your game Change the game in the code insted from Delta Force to AssaultCube ive made some pwange trainers for it alrdy with unlimited ammo hp etc )))))))))))))