Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Varios
Registrarse FAQ Miembros Calendario Guía de estilo Buscar Temas de Hoy Marcar Foros Como Leídos

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 29-12-2017
Milworm99 Milworm99 is offline
Miembro
 
Registrado: Nov 2017
Posts: 31
Poder: 0
Milworm99 Va por buen camino
Error en el siguiente codigo

Hola Gente de la comunidad Club Delphi, estoy que uso este codigo, pero me tira errores de compillacion

Código:
program Project1;

{$APPTYPE CONSOLE}

uses
  Windows, SysUtils, TlHelp32;
var
  m_pID: integer;
  m_hProc: THandle;
  module: TModuleEntry32;
  m_Sign: integer;
const
  procName = 'D3D9Test.exe';
procedure GetPID;
var
  snapshot: THandle;
  pInfo: PROCESSENTRY32;
begin
  snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  pInfo.dwSize := sizeof(PROCESSENTRY32);
  if (Process32First(snapshot, pInfo)) then
  begin
        while (Process32Next(snapshot, pInfo)) do
        begin
          if pInfo.szExeFile = procName then
          begin
                m_pID := pInfo.th32ProcessID;
                CloseHandle(snapshot);
                exit;
          end;
        end;
  end;
  m_pID := 0;
  CloseHandle(snapshot);
  exit;
end;
function GetModuleInfo(const module_name: PChar; main_process: boolean): TModuleEntry32;
var
  snapshot: THandle;
  module: TModuleEntry32;
begin
  snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, m_pID);
  module.dwSize := sizeof(TModuleEntry32);
  if (Module32First(snapshot, module)) then
  begin
        if (main_process) then
        begin
          CloseHandle(snapshot);
          result := module;
        end;
        while (Module32Next(snapshot, module)) do
        begin
          if (StrIComp(PChar(ExtractFileName(module.szModule)), PChar(module_name)) = 0) then
          begin
                CloseHandle(snapshot);
                result := module;
          end;
        end;
  end;
  result := module;
end;
function DataCompare(data: PByte; sign: PByte; mask: PAnsiChar): boolean;
begin
  while mask^ <> #0 do
  begin
        if ((mask^ = 'x') and (data^ <> sign^)) then
        begin
          result := false;
          exit;
        end;
        inc(mask);
        inc(data);
        inc(sign);
  end;
  result := true;
end;
function ScanSignature(base: Dword; size: Dword; sign: PByte; mask: PAnsiChar): integer;
var
  mbi: MEMORY_BASIC_INFORMATION;
  offset: integer;
  buffer: PByte;
  BytesRead: Dword;
  i: integer;
begin
  offset := 0;
  while (offset < size) do
  begin
        VirtualQueryEx(m_hProc, Pointer(base + offset), mbi, sizeof(MEMORY_BASIC_INFORMATION));
        if (mbi.State <> MEM_FREE) then
        begin
          GetMem(buffer, mbi.RegionSize);
          ReadProcessMemory(m_hProc, mbi.BaseAddress, buffer, mbi.RegionSize, BytesRead);
          for i := 0 to mbi.RegionSize do
          begin
                if (DataCompare(buffer + i, sign, mask)) then
                begin
                  FreeMem(buffer);
                  result := integer(mbi.BaseAddress) + i;
                  exit;
                end;
          end;
          FreeMem(buffer);
        end;
        offset := offset + mbi.RegionSize;
  end;
  result := 0;
end;
const
  Sign: array [0 .. 22] of byte = ($68, $00, $00, $00, $00, $68, $00, $00, $00, $00, $68, $00, $00, $00, $00, $FF, $15, $00, $00, $00, $00, $6A, $20);
  Mask = 'x????x????x????xx????xx';
begin
  GetPID();
  if (m_pID <> 0) then
  begin
        module := GetModuleInfo(nil, true);
        m_hProc := OpenProcess(PROCESS_ALL_ACCESS, false, m_pID);
        m_Sign := ScanSignature(integer(module.modBaseAddr), module.modBaseSize, @Sign, Mask);
        writeln(' *************************************************************');
        writeln(' * Signature Scanner for Delphi *');
        writeln(' * Special for Cheat[ON].ru by ArxLex *');
        writeln(' *************************************************************'+#10#13#10#13);
        writeln(' Handle Process: $', inttohex(m_hProc, sizeof(m_hProc)));
        writeln(' Pid: $', inttohex(m_pID, sizeof(m_pID)));
        writeln(' Process Base Address: $', inttohex(integer(module.modBaseAddr), sizeof(module.modBaseAddr)));
        writeln(' Process Base Size: $', inttohex(module.modBaseSize, sizeof(module.modBaseSize)));
        writeln(' Signature Address: $', inttohex(m_Sign, sizeof(m_Sign)));
        readln;
        CloseHandle(m_hProc);
  end;
end.
El error que se me muestra es en:
Código:
if (DataCompare(buffer + i, sign, mask)) then
Alguien que pueda probar el codigo y corregir los errores ?
Responder Con Cita
  #2  
Antiguo 29-12-2017
Avatar de Casimiro Notevi
Casimiro Notevi Casimiro Notevi is offline
Moderador
 
Registrado: Sep 2004
Ubicación: En algún lugar.
Posts: 27.984
Poder: 10
Casimiro Notevi Tiene un aura espectacularCasimiro Notevi Tiene un aura espectacular
buffer: PByte;
i: integer;

Por favor, para otra ocasión procura poner un título descriptivo a tu pregunta, gracias.
Responder Con Cita
  #3  
Antiguo 29-12-2017
Milworm99 Milworm99 is offline
Miembro
 
Registrado: Nov 2017
Posts: 31
Poder: 0
Milworm99 Va por buen camino
No entiendo ?
Código:
buffer: PByte;
i: integer;
Responder Con Cita
Respuesta


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Cómo implementar el siguiente código en una clase eennzzoo C++ Builder 12 03-07-2014 21:10:35
error de missing separator con el siguiente codigo feliz-58 C++ Builder 7 28-03-2013 14:06:05
Que significa el siguiente error: sierraja Firebird e Interbase 11 18-11-2008 21:07:25
Me he atascado en el siguiente código David PHP 3 26-02-2007 00:15:52
Estoy atascado en el siguiente código David OOP 4 01-10-2006 10:45:45


La franja horaria es GMT +2. Ahora son las 00:47:20.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi