unit _CommonMemoryUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Dialogs;

type
TCommMemNT = class(TObject)
private
  FMemPtr:pointer;
  FhProcess:THandle;
  FdwProcessId:DWORD;
  FSize:integer;
protected
  procedure Open(AllocSize:integer);
  procedure Close;
public
  constructor Create(hTarget:HWND;AllocSize:integer);
  destructor Destroy;override;
  procedure ZeroClear;
  procedure Write(offset:integer;Source:pointer;Length:DWORD);
  procedure Read(offset:integer;Destination:pointer;Length:DWORD);
  procedure ReOpen(ReAllocSize:integer);
  property MemPtr:pointer read FMemPtr;
  property Size:integer read FSize;
  property hProcess:THandle read FhProcess;
  property dwProcessID:DWORD read FdwProcessID;
end;


implementation


{ TCommMemNT }

constructor TCommMemNT.Create(hTarget: HWND; AllocSize: integer);
begin
  GetWindowThreadProcessId(hTarget,@FdwProcessId);
  FhProcess := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or
                          PROCESS_VM_WRITE,false,FdwProcessId);
  Open(AllocSize);
  FSize := AllocSize;
end;

destructor TCommMemNT.Destroy;
begin
  Close;
  CloseHandle(FhProcess);
  inherited;
end;

procedure TCommMemNT.Open(AllocSize: integer);
begin
  FMemPtr := VirtualAllocEx(FhProcess,nil,AllocSize,
                           MEM_RESERVE or MEM_COMMIT,PAGE_READWRITE);
end;

procedure TCommMemNT.Close;
begin
  VirtualFreeEx(FhProcess,FMemPtr,0,MEM_RELEASE);
end;

procedure TCommMemNT.ReOpen(ReAllocSize: integer);
var
  ptr:pointer;
begin
  GetMem(ptr,FSize);
  Read(0,ptr,FSize);
  Close;
  Open(ReAllocSize);
  if FSize <= ReAllocSize then
    Write(0,ptr,FSize)
  else
    Write(0,ptr,ReAllocSize);
  FreeMem(ptr);
  FSize := ReAllocSize;
end;

procedure TCommMemNT.Read(offset: integer; Destination: pointer;
                                                      Length: DWORD);
var
  numRead:DWORD;
begin
  if (offset+Length)>FSize then begin
    ShowMessage('読み込み範囲がサイズを超えています');
    exit;
  end;

  ReadProcessMemory(FhProcess,pointer(integer(FMemPtr)+offset),Destination,
                                                              Length,numRead);
end;

procedure TCommMemNT.Write(offset: integer; Source: pointer;
                                                    Length: DWORD);
var
  numWrite:DWORD;
begin
  if (offset+Length)>FSize then begin
    ShowMessage('書き込み範囲がサイズを超えています');
    exit;
  end;

  WriteProcessMemory(FhProcess,pointer(integer(FMemPtr)+offset),Source,
                                                           Length,numWrite);
end;

procedure TCommMemNT.ZeroClear;
var
  ptr:pointer;
begin
  GetMem(ptr,FSize);
  ZeroMemory(ptr,FSize);
  Write(0,ptr,FSize);
  FreeMem(ptr);
end;

end.

