Buenas noches, hoy he entrado a este foro buscando una solucion a mi gran problema: Un modulo PounterWrite para el Visual Estudio 2012.
He tratado ya con 3 modulos diferentes hasta ya volverme loco :-(. Investigando he visto que todas las personas o la mayoría usan el Visual Studio 2010 Express o Full, para ver me descargue el Express y aun así no me funciono.
He aqui uno de los modulos que yo use:
'VB.NET Module
'Author : Cless
'How to use Read/Write Pointer
'Example Read
' Me.Text = ReadPointerInteger(Game exe name, &HPointer,&HOffset).ToString()
'
' Me.Text = ReadPointerInteger("gta_sa", &HB71A38,&H540).ToString()
' Or
' Me.Text = ReadPointerInteger("gta_sa", &HB71A38,&H540,&H544).ToString()
'Example Write
' WritePointerInteger(Game exe name,&HPointer,Value,&HOffset)
'
' WritePointerInteger("gta_sa",&HB71A38,1000,&H540)
' Or
' WritePointerInteger("gta_sa",&HB71A38,1000,&H540, &H544)
Module Trainer
Private Declare Function ReadMemoryByte Lib "kernel32" Alias "ReadProcessMemory" (ByVal Handle As Integer, ByVal Address As Integer, ByRef Value As Byte, Optional ByVal Size As Integer = 2, Optional ByRef Bytes As Integer = 0) As Byte
Private Declare Function ReadMemoryInteger Lib "kernel32" Alias "ReadProcessMemory" (ByVal Handle As Integer, ByVal Address As Integer, ByRef Value As Integer, Optional ByVal Size As Integer = 4, Optional ByRef Bytes As Integer = 0) As Integer
Private Declare Function ReadMemoryFloat Lib "kernel32" Alias "ReadProcessMemory" (ByVal Handle As Integer, ByVal Address As Integer, ByRef Value As Single, Optional ByVal Size As Integer = 4, Optional ByRef Bytes As Integer = 0) As Single
Private Declare Function ReadMemoryDouble Lib "kernel32" Alias "ReadProcessMemory" (ByVal Handle As Integer, ByVal Address As Integer, ByRef Value As Double, Optional ByVal Size As Integer = 8, Optional ByRef Bytes As Integer = 0) As Double
Private Declare Function WriteMemoryByte Lib "kernel32" Alias "WriteProcessMemory" (ByVal Handle As Integer, ByVal Address As Integer, ByRef Value As Byte, Optional ByVal Size As Integer = 2, Optional ByRef Bytes As Integer = 0) As Byte
Private Declare Function WriteMemoryInteger Lib "kernel32" Alias "WriteProcessMemory" (ByVal Handle As Integer, ByVal Address As Integer, ByRef Value As Integer, Optional ByVal Size As Integer = 4, Optional ByRef Bytes As Integer = 0) As Integer
Private Declare Function WriteMemoryFloat Lib "kernel32" Alias "WriteProcessMemory" (ByVal Handle As Integer, ByVal Address As Integer, ByRef Value As Single, Optional ByVal Size As Integer = 2, Optional ByRef Bytes As Integer = 0) As Single
Private Declare Function WriteMemoryDouble Lib "kernel32" Alias "WriteProcessMemory" (ByVal Handle As Integer, ByVal Address As Integer, ByRef Value As Double, Optional ByVal Size As Integer = 2, Optional ByRef Bytes As Integer = 0) As Double
Public Function ReadByte(ByVal EXENAME As String, ByVal Address As Integer) As Byte
Dim Value As Byte
If Process.GetProcessesByName(EXENAME).Length <> 0 Then
Dim Handle As Integer = Process.GetProcessesByName(EXENAME)(0).Handle
If Handle <> 0 Then
ReadMemoryByte(Handle, Address, Value)
End If
End If
Return Value
End Function
Public Function ReadInteger(ByVal EXENAME As String, ByVal Address As Integer) As Integer
Dim Value As Integer
If Process.GetProcessesByName(EXENAME).Length <> 0 Then
Dim Handle As Integer = Process.GetProcessesByName(EXENAME)(0).Handle
If Handle <> 0 Then
ReadMemoryInteger(Handle, Address, Value)
End If
End If
Return Value
End Function
Public Function ReadFloat(ByVal EXENAME As String, ByVal Address As Integer) As Single
Dim Value As Single
If Process.GetProcessesByName(EXENAME).Length <> 0 Then
Dim Handle As Integer = Process.GetProcessesByName(EXENAME)(0).Handle
If Handle <> 0 Then
ReadMemoryFloat(Handle, Address, Value)
End If
End If
Return Value
End Function
Public Function ReadDouble(ByVal EXENAME As String, ByVal Address As Integer) As Double
Dim Value As Double
If Process.GetProcessesByName(EXENAME).Length <> 0 Then
Dim Handle As Integer = Process.GetProcessesByName(EXENAME)(0).Handle
If Handle <> 0 Then
ReadMemoryByte(Handle, Address, Value)
End If
End If
Return Value
End Function
Public Function ReadPointerByte(ByVal EXENAME As String, ByVal Pointer As Integer, ByVal ParamArray Offset As Integer()) As Byte
Dim Value As Byte
If Process.GetProcessesByName(EXENAME).Length <> 0 Then
Dim Handle As Integer = Process.GetProcessesByName(EXENAME)(0).Handle
If Handle <> 0 Then
For Each I As Integer In Offset
ReadMemoryInteger(Handle, Pointer, Pointer)
Pointer += I
Next
ReadMemoryByte(Handle, Pointer, Value)
End If
Else
MsgBox("can't find process")
End If
Return Value
End Function
Public Function ReadPointerInteger(ByVal EXENAME As String, ByVal Pointer As Integer, ByVal ParamArray Offset As Integer() ) As Integer
Dim Value As Integer
If Process.GetProcessesByName(EXENAME).Length <> 0 Then
Dim Handle As Integer = Process.GetProcessesByName(EXENAME)(0).Handle
If Handle <> 0 Then
For Each I As Integer In Offset
ReadMemoryInteger(Handle, Pointer, Pointer)
Pointer += I
Next
ReadMemoryInteger(Handle, Pointer, Value)
End If
End If
Return Value
End Function
Public Function ReadPointerFloat(ByVal EXENAME As String, ByVal Pointer As Integer, ByVal ParamArray Offset As Integer()) As Single
Dim Value As Single
If Process.GetProcessesByName(EXENAME).Length <> 0 Then
Dim Handle As Integer = Process.GetProcessesByName(EXENAME)(0).Handle
If Handle <> 0 Then
For Each I As Integer In Offset
ReadMemoryInteger(Handle, Pointer, Pointer)
Pointer += I
Next
ReadMemoryFloat(Handle, Pointer, Value)
End If
End If
Return Value
End Function
Public Function ReadPointerDouble(ByVal EXENAME As String, ByVal Pointer As Integer, ByVal ParamArray Offset As Integer()) As Double
Dim Value As Double
If Process.GetProcessesByName(EXENAME).Length <> 0 Then
Dim Handle As Integer = Process.GetProcessesByName(EXENAME)(0).Handle
If Handle <> 0 Then
For Each I As Integer In Offset
ReadMemoryInteger(Handle, Pointer, Pointer)
Pointer += I
Next
ReadMemoryDouble(Handle, Pointer, Value)
End If
End If
Return Value
End Function
Public Sub WriteByte(ByVal EXENAME As String, ByVal Address As Integer, ByVal Value As Byte)
If Process.GetProcessesByName(EXENAME).Length <> 0 Then
Dim Handle As Integer = Process.GetProcessesByName(EXENAME)(0).Handle
If Handle <> 0 Then
WriteMemoryByte(Handle, Address, Value)
End If
End If
End Sub
Public Sub WriteInteger(ByVal EXENAME As String, ByVal Address As Integer, ByVal Value As Integer)
If Process.GetProcessesByName(EXENAME).Length <> 0 Then
Dim Handle As Integer = Process.GetProcessesByName(EXENAME)(0).Handle
If Handle <> 0 Then
WriteMemoryInteger(Handle, Address, Value)
End If
End If
End Sub
Public Sub WriteFloat(ByVal EXENAME As String, ByVal Address As Integer, ByVal Value As Single)
If Process.GetProcessesByName(EXENAME).Length <> 0 Then
Dim Handle As Integer = Process.GetProcessesByName(EXENAME)(0).Handle
If Handle <> 0 Then
WriteMemoryFloat(Handle, Address, Value)
End If
End If
End Sub
Public Sub WriteDouble(ByVal EXENAME As String, ByVal Address As Integer, ByVal Value As Double)
If Process.GetProcessesByName(EXENAME).Length <> 0 Then
Dim Handle As Integer = Process.GetProcessesByName(EXENAME)(0).Handle
If Handle <> 0 Then
WriteMemoryDouble(Handle, Address, Value)
End If
End If
End Sub
Public Sub WritePointerByte(ByVal EXENAME As String, ByVal Pointer As Integer, ByVal Value As Byte, ByVal ParamArray Offset As Integer())
If Process.GetProcessesByName(EXENAME).Length <> 0 Then
Dim Handle As Integer = Process.GetProcessesByName(EXENAME)(0).Handle
If Handle <> 0 Then
For Each I As Integer In Offset
ReadMemoryInteger(Handle, Pointer, Pointer)
Pointer += I
Next
WriteMemoryByte(Handle, Pointer, Value)
End If
End If
End Sub
Public Sub WritePointerInteger(ByVal EXENAME As String, ByVal Pointer As Integer, ByVal Value As Integer, ByVal ParamArray Offset As Integer())
If Process.GetProcessesByName(EXENAME).Length <> 0 Then
Dim Handle As Integer = Process.GetProcessesByName(EXENAME)(0).Handle
If Handle <> 0 Then
For Each I As Integer In Offset
ReadMemoryInteger(Handle, Pointer, Pointer)
Pointer += I
Next
WriteMemoryInteger(Handle, Pointer, Value)
End If
End If
End Sub
Public Sub WritePointerFloat(ByVal EXENAME As String, ByVal Pointer As Integer, ByVal Value As Single, ByVal ParamArray Offset As Integer())
If Process.GetProcessesByName(EXENAME).Length <> 0 Then
Dim Handle As Integer = Process.GetProcessesByName(EXENAME)(0).Handle
If Handle <> 0 Then
For Each I As Integer In Offset
ReadMemoryInteger(Handle, Pointer, Pointer)
Pointer += I
Next
WriteMemoryFloat(Handle, Pointer, Value)
End If
End If
End Sub
Public Sub WritePointerDouble(ByVal EXENAME As String, ByVal Pointer As Integer, ByVal Value As Double, ByVal ParamArray Offset As Integer())
If Process.GetProcessesByName(EXENAME).Length <> 0 Then
Dim Handle As Integer = Process.GetProcessesByName(EXENAME)(0).Handle
If Handle <> 0 Then
For Each I As Integer In Offset
ReadMemoryInteger(Handle, Pointer, Pointer)
Pointer += I
Next
WriteMemoryDouble(Handle, Pointer, Value)
End If
End If
End Sub
End Module
Y para escribir en la memoria:
WritePointerInteger("proceso",&HBaseaddress,Valor,&HOffset1, &HOffset2, &HOffset3, &HOffset4)
Pero solo he visto en unos pocos vídeos que he encontrado que funciona con el Visual Studio 2010.
¿Ayuda para escribir en pointers de nivel 4?
Lo que hace el offset es que desde un address (usualmente static, con respecto a lo que buscas) genera otros address para llegar al address final, lo cual sería así:
Tienes el static address
luego tienes que leer el valor del [static addres + offset1]
A ese resultado -> ResultadoAddOff1
le tienes que sumar offset2 y leerlo
[ResultadoAddOff1 + offset2] -> ResultadoAddOff2
etc etc, así al final obtendrás el address final con su valor, lo cual podrías hacer un bucle de ReadProcessMemory, pasándole por array la cantidad de offset y obteniendo la longitud del mismo array para el bucle, yo hice uno hace mucho para un juego, pero no recuerdo donde lo tengo :S también había hecho un FindPattern xDDDD, todo es posible ;), espero que ésto te sea de ayuda.
Entonces, tengo que sumar todos los Offsets en orden?
Son 4 así que seria algo como esto:
Base + O1
Base1 + O2
Base2 + O3
Base3 + O4
¿Y entonces con un modulo MemoryWrite escribo en el resultado el valor que quiero?
-----------------------------------------------------------------------------------
Editado:
Seria algo como esto?
WritePointerInteger("proceso",&HBaseaddress + &HOffset1 + &HOffset2 + &HOffset3 + &HOffset4, ,Valor)
--------------------------------------------------------------------------------
Si tienes algún modulo de ejemplo por favor pásamelo.
--------------------------------------------------------------------------------
Editado
Después de mucha búsqueda he encontrado un método como el que tu me has explicado mira:
Para la Form:
'Variables
Dim ProcessName As String = "Emuclient"
Dim WindowClass As String = "S4 Client" 'If you wanna hack another game than AVA you have to replace this string with the window class name of your game
'You can use google to find out how you can get the window class for the game you wanna hack with this trainer
'The easiest way to get the window class is by using WinSpy++ (Spy++)
Dim p As Process = Nothing
Dim RealName As String
Dim Xpos As Integer
Dim Ypos As Integer
Dim NewPoint As New System.Drawing.Point
Dim Panel1MouseDown As Boolean = False 'This variable was made to avoid bugs if the window gets moved while pressing the hotkey for setting it to center screen.
'Function for detecting key presses
Private Declare Function GetKeyPress Lib "user32" Alias "GetAsyncKeyState" (ByVal key As Integer) As Integer
Entonces para escribir:
Try
Dim Adr1 As Int32 = Memory.ReadInt32(p, &HB328B0) 'Address
Adr1 = Memory.ReadInt32(p, Adr1 + &H210) 'Offset1
Adr1 = Memory.ReadInt32(p, Adr1 + &H8) 'Offset2 (Add more offsets if needed)
Adr1 = Memory.ReadInt32(p, Adr1 + &H138) 'Offset1
'ATTENTION: The last offset MUST be added in the writing part (in this example the last offset is &H123)
'Replace the value (999) with what you want to change it to and the method (WriteInt32) with the method for the value type of the value you wanna change.
WriteInt32(p, Adr1 + &H90, 1167867904)
Catch ex As Exception 'If something failed
MessageBox.Show("Writing to memory failed: " & vbCrLf & ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
PD: no me sirve :L, que hago mal?
--------------------------------------------------------------------------------
He intentado hacerlo con el original también y esto es lo que me sale:
Dim Adress As Integer = ReadPointerInteger("SpiderSolitaire", &H942B8)
Adress = ReadPointerInteger("SpiderSolitaire", &H942B8 + &H10)
Adress = ReadPointerInteger("SpiderSolitaire", &H942B8 + &H7C)
Adress = ReadPointerInteger("SpiderSolitaire", &H942B8 + &HC)
Adress = ReadPointerInteger("SpiderSolitaire", &H942B8 + &H40)
WritePointerInteger("SpiderSolitaire", Adress + &H74, 50000)
y no sirve :(, ¿una ayuda?
Es muy raro que yo comparta código de hacks/cheats, pero aquí tienes el módulo completo, son del 2010 o antes, así que no están optimizados:
Option Explicit
Private Type tOffset
HexValue As Variant
DecimValue As Long
HexAddress As Variant
DecimAddress As Long
End Type
Private NumOffsets As Long
Private Offsets() As tOffset
Private ActualOffsetVal As Variant
Private FAddressHex As Variant
Private FAddressDecim As Long
Private FValueHex As Variant
Private FValueDecim As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName 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
Public 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
Public Declare Function WriteProcessMem Lib "kernel32" Alias "WriteProcessMemory" (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
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function Hotkey Lib "user32" Alias "GetAsyncKeyState" (ByVal key As Long) As Integer
Public L(1 To 8) As Long, lR(1 To 8) As Long, lS(1 To 8) As Long
Public v(1 To 8) As Variant
Public OffSet(1 To 8) As Variant
Public Pass As String
Public Function MiseryCalc(ByVal Address As Long, ParamArray TheOffsets() As Variant) As Variant
'On Error GoTo Err:
Dim i As Byte
Dim handle As Long
Dim ProcessID As Long
Dim ProcessHandle As Long
Dim PointerValue As Long
Dim AddressDec As Long
Dim AddressHex As String
'MsgBox UBound(TheOffsets) '0, 1
NumOffsets = UBound(TheOffsets) + 1
'MsgBox NumOffsets
'Exit Sub
ReDim Offsets(NumOffsets)
For i = 1 To NumOffsets
ActualOffsetVal = TheOffsets(i - 1)
'MsgBox ActualOffsetVal
Offsets(i).HexValue = "&H" & ActualOffsetVal
Offsets(i).DecimValue = "&H" & ActualOffsetVal
Next i
'handle = FindWindow(vbNullString, "Argentum Online")
'GetWindowThreadProcessId handle, ProcessID
'ProcessHandle = OpenProcess(&H1F0FFF, True, ProcessID)
ProcessHandle = myHandle
For i = 1 To NumOffsets
If i = 1 Then
ReadProcessMem ProcessHandle, CLng(Address), PointerValue, 4&, 0
Else
ReadProcessMem ProcessHandle, Offsets(i - 1).DecimAddress, PointerValue, 4&, 0
End If
AddressDec = PointerValue + Offsets(i).DecimValue
Offsets(i).DecimAddress = AddressDec
Offsets(i).HexAddress = Hex(AddressDec)
Next i
FAddressDecim = Offsets(NumOffsets).DecimAddress
ReadProcessMem ProcessHandle, FAddressDecim, FValueDecim, 4&, 0
FValueDecim = FValueDecim + 0
FAddressHex = Hex(AddressDec)
FValueHex = Hex(FValueDecim)
MiseryCalc = FAddressDecim
'CloseHandle ProcessHandle
'Exit Function
'Err:
' Exit Function
End Function
Public Function MiseryCalc2(ByVal Address As Long, ParamArray TheOffsets() As Variant) As Variant
'On Error GoTo Err:
Dim i As Byte
Dim handle As Long
Dim ProcessID As Long
Dim ProcessHandle As Long
Dim PointerValue As Long
Dim AddressDec As Long
Dim AddressHex As String
'MsgBox UBound(TheOffsets) '0, 1
NumOffsets = UBound(TheOffsets) + 1
'MsgBox NumOffsets
'Exit Sub
ReDim Offsets(NumOffsets)
For i = 1 To NumOffsets
ActualOffsetVal = TheOffsets(i - 1)
'MsgBox ActualOffsetVal
Offsets(i).HexValue = ActualOffsetVal
Offsets(i).DecimValue = ActualOffsetVal
Next i
'handle = FindWindow(vbNullString, "Argentum Online")
'GetWindowThreadProcessId handle, ProcessID
'ProcessHandle = OpenProcess(&H1F0FFF, True, ProcessID)
ProcessHandle = myHandle
For i = 1 To NumOffsets
If i = 1 Then
ReadProcessMem ProcessHandle, Address, PointerValue, 4&, 0
Else
ReadProcessMem ProcessHandle, Offsets(i - 1).DecimAddress, PointerValue, 4&, 0
End If
AddressDec = PointerValue + Offsets(i).DecimValue
Offsets(i).DecimAddress = AddressDec
Offsets(i).HexAddress = Hex(AddressDec)
Next i
FAddressDecim = Offsets(NumOffsets).DecimAddress
ReadProcessMem ProcessHandle, FAddressDecim, FValueDecim, 4&, 0
FValueDecim = FValueDecim + 0
FAddressHex = Hex(AddressDec)
FValueHex = Hex(FValueDecim)
MiseryCalc2 = FAddressDecim
'CloseHandle ProcessHandle
'Exit Function
'Err:
' Exit Function
End Function
Public Function CalcularBytes(ByVal Address As Long) As String
Dim i As Byte
Dim AddressHex As Variant
Dim NAH As Variant
AddressHex = Hex(Address)
AddressHex = "0000000" & (AddressHex)
NAH = Right(AddressHex, 8)
'jne 12345678
'XX -XX - L2, L1 - L4, L3 - L6, L5 - L8, L7
For i = 1 To 8
v(9 - i) = "&H" & Mid(NAH, i, 1)
Next i
OffSet(1) = &H3
'OffSet(2) = &H6
'OffSet(3) = &HA
'OffSet(4) = &H2
OffSet(5) = &H7
OffSet(6) = &HB
OffSet(7) = &HF
OffSet(8) = &HF
For i = 1 To 8
L(i) = L(i) + v(i) + OffSet(i)
If L(i) > &HF Then
lR(i) = (L(i) - &H10)
If i <> 8 Then
lS(i) = (L(i) - lR(i))
L(i + 1) = L(i + 1) + (lS(i) / &H10)
End If
'//FIX
L(i) = lR(i)
End If
Next i
'XX - XX - L2, L1 - L4, L3 - L6, L5 - L8, L7
'CalcularBytes = "0F - " & _
"85 - " & _
Hex(L(2)) & Hex(L(1)) & " - " & _
Hex(L(4)) & Hex(L(3)) & " - " & _
Hex(L(6)) & Hex(L(5)) & " - " & _
Hex(L(8)) & Hex(L(7))
'0F 85 FC 04 00 00
'0x0 4 F C 85 0F
' 4,3 2,1 85 0F
CalcularBytes = Hex(L(4)) & Hex(L(3)) & Hex(L(2)) & Hex(L(1)) & "850F"
End Function
Public Function CalcularBytes2(ByVal Address As Long) As String
Dim i As Byte
Dim AddressHex As Variant
Dim NAH As Variant
AddressHex = Hex(Address)
AddressHex = "0000000" & (AddressHex)
NAH = Right(AddressHex, 8)
'jne 12345678
'XX -XX - L2, L1 - L4, L3 - L6, L5 - L8, L7
For i = 1 To 8
v(9 - i) = "&H" & Mid(NAH, i, 1)
Next i
OffSet(1) = &H3
'OffSet(2) = &H6
'OffSet(3) = &HA
'OffSet(4) = &H2
OffSet(5) = &H7
OffSet(6) = &HB
OffSet(7) = &HF
OffSet(8) = &HF
For i = 1 To 8
L(i) = L(i) + v(i) + OffSet(i)
If L(i) > &HF Then
lR(i) = (L(i) - &H10)
If i <> 8 Then
lS(i) = (L(i) - lR(i))
L(i + 1) = L(i + 1) + (lS(i) / &H10)
End If
'//FIX
L(i) = lR(i)
End If
Next i
'XX - XX - L2, L1 - L4, L3 - L6, L5 - L8, L7
'CalcularBytes = "0F - " & _
"85 - " & _
Hex(L(2)) & Hex(L(1)) & " - " & _
Hex(L(4)) & Hex(L(3)) & " - " & _
Hex(L(6)) & Hex(L(5)) & " - " & _
Hex(L(8)) & Hex(L(7))
'0F 85 FC 04 00 00
'0x0 4 F C 85 0F
' 4,3 2,1 85 0F
CalcularBytes2 = Hex(L(4)) & Hex(L(3)) & Hex(L(2)) & Hex(L(1)) & "850F"
End Function
Public Function Encrypt(ByVal vVal As Variant, ByVal mlvl As Byte, ByVal Pass As Variant, ByVal EncKa As Byte) As Variant
Dim vValCpy As Variant
Dim FVal As Variant
Dim i As Byte, X As Byte
Dim TheAsc As Long
Dim TheAscX As Long
Dim PassEnc As Long
Dim TheXor As Long
FVal = vVal
PassEnc = PassEncrypt(Pass)
If EncKa = 1 Then
' Form1.List1.AddItem "------------"
' Form1.List1.AddItem "Val Encrypt:"
' Form1.List1.AddItem "------------"
ElseIf EncKa = 2 Then
' Form1.List1.AddItem "------------"
' Form1.List1.AddItem "Pass Encrypt:"
' Form1.List1.AddItem "------------"
End If
For i = 1 To mlvl
DoEvents
vValCpy = FVal
FVal = ""
For X = 1 To Len(vValCpy)
DoEvents
TheAsc = Asc(Mid(vValCpy, X, 1)) + X 'Convierto a ASCII y le sumo la posicion
TheAscX = TheAsc - 2 'Le resto 2
TheXor = TheAscX Xor PassEnc 'Hago un XOR con la Pss
FVal = FVal & Chr(TheXor) 'Lo transformo a CHAR
Next X
'Form1.List1.AddItem FVal
Next i
Encrypt = FVal
End Function
Public Function Decrypt(ByVal vVal As Variant, ByVal mlvl As Byte, ByVal Pass As Variant, ByVal EncKa As Byte) As Variant
Dim vValCpy As Variant
Dim FVal As Variant
Dim i As Byte, X As Byte
Dim TheAsc As Long
Dim TheAscX As Long
Dim PassEnc As Long
Dim TheXor As Long
FVal = vVal
PassEnc = PassEncrypt(Pass)
If EncKa = 1 Then
' Form1.List1.AddItem "------------"
' Form1.List1.AddItem "Val Encrypt:"
' Form1.List1.AddItem "------------"
ElseIf EncKa = 2 Then
' Form1.List1.AddItem "------------"
' Form1.List1.AddItem "Pass Encrypt:"
' Form1.List1.AddItem "------------"
End If
For i = 1 To mlvl
DoEvents
vValCpy = FVal
FVal = ""
For X = 1 To Len(vValCpy)
DoEvents
'TheAsc = Asc(Mid(vValCpy, x, 1)) + x 'Convierto a ASCII y le sumo la posicion
'TheAscX = TheAsc - 2 'Le resto 2
'TheXor = TheAscX Xor PassEnc 'Hago un XOR con la Pss
'FVal = FVal & Chr(TheXor) 'Lo transformo a CHAR
TheAsc = Asc(Mid(vValCpy, X, 1))
TheXor = TheAsc Xor PassEnc
TheAscX = TheXor + 2
TheAscX = TheAscX - X
FVal = FVal & Chr(TheAscX)
Next X
'Form1.List1.AddItem FVal
Next i
Decrypt = FVal
End Function
Public Function PassEncrypt(ByVal Pass As Variant)
Dim vVal As Integer
Dim i As Byte
For i = 1 To Len(Pass)
DoEvents
vVal = vVal + (Asc(Mid(Pass, i, 1)) \ 2)
Next i
vVal = vVal \ 3
PassEncrypt = vVal
End Function
Function FileExist(ByVal File As String, ByVal FileType As VbFileAttribute) As Boolean
FileExist = (Dir$(File, FileType) <> "")
End Function
USO:
MiseryCalc2(ADDRESS, OFFSET1, OFFSET2, OFFSET3, ...)
Ej:
MiseryCalc2(BaseAddress + &HF3034, &H44, &H28)
Cita de: Miseryk en 7 Octubre 2013, 06:01 AM
Es muy raro que yo comparta código de hacks/cheats, pero aquí tienes el módulo completo, son del 2010 o antes, así que no están optimizados:
Option Explicit
Private Type tOffset
HexValue As Variant
DecimValue As Long
HexAddress As Variant
DecimAddress As Long
End Type
Private NumOffsets As Long
Private Offsets() As tOffset
Private ActualOffsetVal As Variant
Private FAddressHex As Variant
Private FAddressDecim As Long
Private FValueHex As Variant
Private FValueDecim As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName 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
Public 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
Public Declare Function WriteProcessMem Lib "kernel32" Alias "WriteProcessMemory" (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
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function Hotkey Lib "user32" Alias "GetAsyncKeyState" (ByVal key As Long) As Integer
Public L(1 To 8) As Long, lR(1 To 8) As Long, lS(1 To 8) As Long
Public v(1 To 8) As Variant
Public OffSet(1 To 8) As Variant
Public Pass As String
Public Function MiseryCalc(ByVal Address As Long, ParamArray TheOffsets() As Variant) As Variant
'On Error GoTo Err:
Dim i As Byte
Dim handle As Long
Dim ProcessID As Long
Dim ProcessHandle As Long
Dim PointerValue As Long
Dim AddressDec As Long
Dim AddressHex As String
'MsgBox UBound(TheOffsets) '0, 1
NumOffsets = UBound(TheOffsets) + 1
'MsgBox NumOffsets
'Exit Sub
ReDim Offsets(NumOffsets)
For i = 1 To NumOffsets
ActualOffsetVal = TheOffsets(i - 1)
'MsgBox ActualOffsetVal
Offsets(i).HexValue = "&H" & ActualOffsetVal
Offsets(i).DecimValue = "&H" & ActualOffsetVal
Next i
'handle = FindWindow(vbNullString, "Argentum Online")
'GetWindowThreadProcessId handle, ProcessID
'ProcessHandle = OpenProcess(&H1F0FFF, True, ProcessID)
ProcessHandle = myHandle
For i = 1 To NumOffsets
If i = 1 Then
ReadProcessMem ProcessHandle, CLng(Address), PointerValue, 4&, 0
Else
ReadProcessMem ProcessHandle, Offsets(i - 1).DecimAddress, PointerValue, 4&, 0
End If
AddressDec = PointerValue + Offsets(i).DecimValue
Offsets(i).DecimAddress = AddressDec
Offsets(i).HexAddress = Hex(AddressDec)
Next i
FAddressDecim = Offsets(NumOffsets).DecimAddress
ReadProcessMem ProcessHandle, FAddressDecim, FValueDecim, 4&, 0
FValueDecim = FValueDecim + 0
FAddressHex = Hex(AddressDec)
FValueHex = Hex(FValueDecim)
MiseryCalc = FAddressDecim
'CloseHandle ProcessHandle
'Exit Function
'Err:
' Exit Function
End Function
Public Function MiseryCalc2(ByVal Address As Long, ParamArray TheOffsets() As Variant) As Variant
'On Error GoTo Err:
Dim i As Byte
Dim handle As Long
Dim ProcessID As Long
Dim ProcessHandle As Long
Dim PointerValue As Long
Dim AddressDec As Long
Dim AddressHex As String
'MsgBox UBound(TheOffsets) '0, 1
NumOffsets = UBound(TheOffsets) + 1
'MsgBox NumOffsets
'Exit Sub
ReDim Offsets(NumOffsets)
For i = 1 To NumOffsets
ActualOffsetVal = TheOffsets(i - 1)
'MsgBox ActualOffsetVal
Offsets(i).HexValue = ActualOffsetVal
Offsets(i).DecimValue = ActualOffsetVal
Next i
'handle = FindWindow(vbNullString, "Argentum Online")
'GetWindowThreadProcessId handle, ProcessID
'ProcessHandle = OpenProcess(&H1F0FFF, True, ProcessID)
ProcessHandle = myHandle
For i = 1 To NumOffsets
If i = 1 Then
ReadProcessMem ProcessHandle, Address, PointerValue, 4&, 0
Else
ReadProcessMem ProcessHandle, Offsets(i - 1).DecimAddress, PointerValue, 4&, 0
End If
AddressDec = PointerValue + Offsets(i).DecimValue
Offsets(i).DecimAddress = AddressDec
Offsets(i).HexAddress = Hex(AddressDec)
Next i
FAddressDecim = Offsets(NumOffsets).DecimAddress
ReadProcessMem ProcessHandle, FAddressDecim, FValueDecim, 4&, 0
FValueDecim = FValueDecim + 0
FAddressHex = Hex(AddressDec)
FValueHex = Hex(FValueDecim)
MiseryCalc2 = FAddressDecim
'CloseHandle ProcessHandle
'Exit Function
'Err:
' Exit Function
End Function
Public Function CalcularBytes(ByVal Address As Long) As String
Dim i As Byte
Dim AddressHex As Variant
Dim NAH As Variant
AddressHex = Hex(Address)
AddressHex = "0000000" & (AddressHex)
NAH = Right(AddressHex, 8)
'jne 12345678
'XX -XX - L2, L1 - L4, L3 - L6, L5 - L8, L7
For i = 1 To 8
v(9 - i) = "&H" & Mid(NAH, i, 1)
Next i
OffSet(1) = &H3
'OffSet(2) = &H6
'OffSet(3) = &HA
'OffSet(4) = &H2
OffSet(5) = &H7
OffSet(6) = &HB
OffSet(7) = &HF
OffSet(8) = &HF
For i = 1 To 8
L(i) = L(i) + v(i) + OffSet(i)
If L(i) > &HF Then
lR(i) = (L(i) - &H10)
If i <> 8 Then
lS(i) = (L(i) - lR(i))
L(i + 1) = L(i + 1) + (lS(i) / &H10)
End If
'//FIX
L(i) = lR(i)
End If
Next i
'XX - XX - L2, L1 - L4, L3 - L6, L5 - L8, L7
'CalcularBytes = "0F - " & _
"85 - " & _
Hex(L(2)) & Hex(L(1)) & " - " & _
Hex(L(4)) & Hex(L(3)) & " - " & _
Hex(L(6)) & Hex(L(5)) & " - " & _
Hex(L(8)) & Hex(L(7))
'0F 85 FC 04 00 00
'0x0 4 F C 85 0F
' 4,3 2,1 85 0F
CalcularBytes = Hex(L(4)) & Hex(L(3)) & Hex(L(2)) & Hex(L(1)) & "850F"
End Function
Public Function CalcularBytes2(ByVal Address As Long) As String
Dim i As Byte
Dim AddressHex As Variant
Dim NAH As Variant
AddressHex = Hex(Address)
AddressHex = "0000000" & (AddressHex)
NAH = Right(AddressHex, 8)
'jne 12345678
'XX -XX - L2, L1 - L4, L3 - L6, L5 - L8, L7
For i = 1 To 8
v(9 - i) = "&H" & Mid(NAH, i, 1)
Next i
OffSet(1) = &H3
'OffSet(2) = &H6
'OffSet(3) = &HA
'OffSet(4) = &H2
OffSet(5) = &H7
OffSet(6) = &HB
OffSet(7) = &HF
OffSet(8) = &HF
For i = 1 To 8
L(i) = L(i) + v(i) + OffSet(i)
If L(i) > &HF Then
lR(i) = (L(i) - &H10)
If i <> 8 Then
lS(i) = (L(i) - lR(i))
L(i + 1) = L(i + 1) + (lS(i) / &H10)
End If
'//FIX
L(i) = lR(i)
End If
Next i
'XX - XX - L2, L1 - L4, L3 - L6, L5 - L8, L7
'CalcularBytes = "0F - " & _
"85 - " & _
Hex(L(2)) & Hex(L(1)) & " - " & _
Hex(L(4)) & Hex(L(3)) & " - " & _
Hex(L(6)) & Hex(L(5)) & " - " & _
Hex(L(8)) & Hex(L(7))
'0F 85 FC 04 00 00
'0x0 4 F C 85 0F
' 4,3 2,1 85 0F
CalcularBytes2 = Hex(L(4)) & Hex(L(3)) & Hex(L(2)) & Hex(L(1)) & "850F"
End Function
Public Function Encrypt(ByVal vVal As Variant, ByVal mlvl As Byte, ByVal Pass As Variant, ByVal EncKa As Byte) As Variant
Dim vValCpy As Variant
Dim FVal As Variant
Dim i As Byte, X As Byte
Dim TheAsc As Long
Dim TheAscX As Long
Dim PassEnc As Long
Dim TheXor As Long
FVal = vVal
PassEnc = PassEncrypt(Pass)
If EncKa = 1 Then
' Form1.List1.AddItem "------------"
' Form1.List1.AddItem "Val Encrypt:"
' Form1.List1.AddItem "------------"
ElseIf EncKa = 2 Then
' Form1.List1.AddItem "------------"
' Form1.List1.AddItem "Pass Encrypt:"
' Form1.List1.AddItem "------------"
End If
For i = 1 To mlvl
DoEvents
vValCpy = FVal
FVal = ""
For X = 1 To Len(vValCpy)
DoEvents
TheAsc = Asc(Mid(vValCpy, X, 1)) + X 'Convierto a ASCII y le sumo la posicion
TheAscX = TheAsc - 2 'Le resto 2
TheXor = TheAscX Xor PassEnc 'Hago un XOR con la Pss
FVal = FVal & Chr(TheXor) 'Lo transformo a CHAR
Next X
'Form1.List1.AddItem FVal
Next i
Encrypt = FVal
End Function
Public Function Decrypt(ByVal vVal As Variant, ByVal mlvl As Byte, ByVal Pass As Variant, ByVal EncKa As Byte) As Variant
Dim vValCpy As Variant
Dim FVal As Variant
Dim i As Byte, X As Byte
Dim TheAsc As Long
Dim TheAscX As Long
Dim PassEnc As Long
Dim TheXor As Long
FVal = vVal
PassEnc = PassEncrypt(Pass)
If EncKa = 1 Then
' Form1.List1.AddItem "------------"
' Form1.List1.AddItem "Val Encrypt:"
' Form1.List1.AddItem "------------"
ElseIf EncKa = 2 Then
' Form1.List1.AddItem "------------"
' Form1.List1.AddItem "Pass Encrypt:"
' Form1.List1.AddItem "------------"
End If
For i = 1 To mlvl
DoEvents
vValCpy = FVal
FVal = ""
For X = 1 To Len(vValCpy)
DoEvents
'TheAsc = Asc(Mid(vValCpy, x, 1)) + x 'Convierto a ASCII y le sumo la posicion
'TheAscX = TheAsc - 2 'Le resto 2
'TheXor = TheAscX Xor PassEnc 'Hago un XOR con la Pss
'FVal = FVal & Chr(TheXor) 'Lo transformo a CHAR
TheAsc = Asc(Mid(vValCpy, X, 1))
TheXor = TheAsc Xor PassEnc
TheAscX = TheXor + 2
TheAscX = TheAscX - X
FVal = FVal & Chr(TheAscX)
Next X
'Form1.List1.AddItem FVal
Next i
Decrypt = FVal
End Function
Public Function PassEncrypt(ByVal Pass As Variant)
Dim vVal As Integer
Dim i As Byte
For i = 1 To Len(Pass)
DoEvents
vVal = vVal + (Asc(Mid(Pass, i, 1)) \ 2)
Next i
vVal = vVal \ 3
PassEncrypt = vVal
End Function
Function FileExist(ByVal File As String, ByVal FileType As VbFileAttribute) As Boolean
FileExist = (Dir$(File, FileType) <> "")
End Function
USO:
MiseryCalc2(ADDRESS, OFFSET1, OFFSET2, OFFSET3, ...)
Ej:
MiseryCalc2(BaseAddress + &HF3034, &H44, &H28)
Donde coloco el proceso y el valor? ._.
Cual VS usaste? el 2008? me han salido más de 40 errores he intento repararlos y a que te refieres con ¿DoEvents?
Cita de: jonnyHS en 7 Octubre 2013, 19:44 PM
Donde coloco el proceso y el valor? ._.
Cual VS usaste? el 2008? me han salido más de 40 errores he intento repararlos y a que te refieres con ¿DoEvents?
El handle del proceso lo meto acá:
ProcessHandle = myHandleDonde myHandle es una variable global que guardé el handle del proceso.
Lo hice en VB6, fijate de pasarlo a VB.NET, debe ser casi lo mismo.
http://msdn.microsoft.com/es-es/library/system.windows.forms.application.doevents.aspx (http://msdn.microsoft.com/es-es/library/system.windows.forms.application.doevents.aspx)
Con respecto al DoEvents:
http://support.microsoft.com/kb/118468/es (http://support.microsoft.com/kb/118468/es)
La función DoEvents entrega la ejecución de la macro, para que el sistema operativo pueda procesar otros eventos. La función DoEvents pasa el control de la aplicación para el sistema operativo. Algunos casos en los que puede resultar útil DoEvents incluyen los siguientes:
Hardware de E/S
Bucles de retardo
Llamadas al sistema operativo
DDE de interbloqueos
Este artículo también analiza los problemas potenciales asociados a la función DoEvents.
PD:
También prodrías hacer ésto:
Public Function MiseryCalc2(ByVal PROCESSHANDLEparam As Long, ByVal Address As Long, ParamArray TheOffsets() As Variant) As Variant
...
ProcessHandle = PROCESSHANDLEparam
...
Cita de: Miseryk en 9 Octubre 2013, 21:03 PM
El handle del proceso lo meto acá:
ProcessHandle = myHandle
Donde myHandle es una variable global que guardé el handle del proceso.
Lo hice en VB6, fijate de pasarlo a VB.NET, debe ser casi lo mismo.
http://msdn.microsoft.com/es-es/library/system.windows.forms.application.doevents.aspx (http://msdn.microsoft.com/es-es/library/system.windows.forms.application.doevents.aspx)
Con respecto al DoEvents:
http://support.microsoft.com/kb/118468/es (http://support.microsoft.com/kb/118468/es)
La función DoEvents entrega la ejecución de la macro, para que el sistema operativo pueda procesar otros eventos. La función DoEvents pasa el control de la aplicación para el sistema operativo. Algunos casos en los que puede resultar útil DoEvents incluyen los siguientes:
Hardware de E/S
Bucles de retardo
Llamadas al sistema operativo
DDE de interbloqueos
Este artículo también analiza los problemas potenciales asociados a la función DoEvents.
PD:
También prodrías hacer ésto:
Public Function MiseryCalc2(ByVal PROCESSHANDLEparam As Long, ByVal Address As Long, ParamArray TheOffsets() As Variant) As Variant
...
ProcessHandle = PROCESSHANDLEparam
...
Sabes algún conversor de VB6 a NET?