#pas
unit hiProcMemory;

interface

uses
  Kol, Share, tlhelp32, Windows, Debug;

type
  THIProcMemory = class(TDebug)
  private
    fCurrentProc    : DWORD;
    fProcessID      : DWORD;

    function GetProcessId(pName: PChar): dword;
  public
    _prop_Name      : string;
    _prop_Offset    : Integer;
    _prop_Data      : Integer;
    _prop_DataType  : Byte;

    _data_Name      : THI_Event;
    _data_Offset    : THI_Event;
    _data_Data      : THI_Event;

    _event_onRead   : THI_Event;

    procedure _work_DoOpenProcess(var _Data: TData; Index: Word);
    procedure _work_DoRead(var _Data: TData; Index: Word);
    procedure _work_DoWrite(var _Data: TData; Index: Word);
    procedure _work_DoProcessInfo(var _Data: TData; Index: Word);

    constructor Create;
    destructor Destroy; override;
    procedure _var_ProcessId(var _Data: TData; Index: Word);
  end;

const
  DataTypeSize: array[0..2] of Byte = ($01, $02, $04);

implementation

//------------------------------------------------------------------------------

constructor THIProcMemory.Create;
begin
  inherited;

end;

//------------------------------------------------------------------------------

destructor THIProcMemory.Destroy;
begin
  CloseHandle(fCurrentProc);
  inherited Destroy;
end;

//------------------------------------------------------------------------------

function THIProcMemory.GetProcessId(pName: PChar): dword;
var
  Snap    : DWORD;
  Process : TPROCESSENTRY32;
begin
  Result := 0;
  Snap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);

  if Snap <> INVALID_HANDLE_VALUE then
  begin
    Process.dwSize := SizeOf(TPROCESSENTRY32);
    if Process32First(Snap, Process) then
    repeat
      if lstrcmpi(Process.szExeFile, pName) = 0 then
      begin
        Result := Process.th32ProcessID;
        CloseHandle(Snap);
        Exit;
      end;
    until not Process32Next(Snap, Process);

    Result := 0;
    CloseHandle(Snap);
  end;
end;

//------------------------------------------------------------------------------

procedure THIProcMemory._work_DoOpenProcess;
begin
  fProcessID := GetProcessId(PChar(ReadString(_Data, _data_Name, _prop_Name)));
  fCurrentProc := OpenProcess(PROCESS_ALL_ACCESS, false, fProcessID);
end;

//------------------------------------------------------------------------------

procedure THIProcMemory._work_DoRead;
var
  Bytes: DWORD;
  Buffer: Pointer;
begin
  GetMem(Buffer, DataTypeSize[_prop_DataType]);

  if ReadProcessMemory(fCurrentProc,
                       Ptr(ReadInteger(_Data, _data_Offset, _prop_Offset)),
                       Buffer,
                       DataTypeSize[_prop_DataType],
                       Bytes) then
  begin
    case _prop_DataType of
      0: _hi_OnEvent(_event_onRead, BYTE(Buffer^));
      1: _hi_OnEvent(_event_onRead, WORD(Buffer^));
      2: _hi_OnEvent(_event_onRead, DWORD(Buffer^));
    end;
  end;
  FreeMem(Buffer);
end;

//------------------------------------------------------------------------------

procedure THIProcMemory._work_DoWrite;
var
  Bytes: DWORD;
  Buffer: Pointer;
  protect:dword;
begin
  GetMem(Buffer, DataTypeSize[_prop_DataType]);
  VirtualProtect(ptr(ReadInteger(_Data, _data_Offset, _prop_Offset)),sizeof(Buffer),PAGE_EXECUTE_READWRITE,@protect);

  case _prop_DataType of
    0: BYTE(Buffer^) := ReadInteger(_Data, _data_Data, _prop_Data);
    1: WORD(Buffer^) := ReadInteger(_Data, _data_Data, _prop_Data);
    2: DWORD(Buffer^) := ReadInteger(_Data, _data_Data, _prop_Data);
  end;

  WriteProcessMemory(fCurrentProc,
                     Ptr(ReadInteger(_Data, _data_Offset, _prop_Offset)),
                     Buffer,
                     DataTypeSize[_prop_DataType],
                     Bytes);
  VirtualProtect(ptr(ReadInteger(_Data, _data_Offset, _prop_Offset)),sizeof(Buffer),protect,@protect);
  FreeMem(Buffer);
end;

//------------------------------------------------------------------------------
// Процедура пока не реализованна :(
//------------------------------------------------------------------------------
procedure THIProcMemory._work_DoProcessInfo;
var
  sInfo: _SYSTEM_INFO;
  mInfo: _MEMORY_BASIC_INFORMATION;
begin
  GetSystemInfo(sInfo);
  VirtualQueryEx(fCurrentProc, nil, mInfo, SizeOf(mInfo));
end;

//------------------------------------------------------------------------------

procedure THIProcMemory._var_ProcessId;
begin
  _Data.data_type := data_int;
  _Data.idata := fProcessID;
end;

//------------------------------------------------------------------------------

end.