Использование native kernel32 функций для получения проекции физической памяти

Code:

unit Read_Mem;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, Grids, ExtCtrls, PhysMemWorks;

type

TForm1 = class(TForm)

gridData: TStringGrid;

Label12: TLabel;

editAddr: TEdit;

btnRead: TButton;

Label2: TLabel;

procedure btnReadClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

{$R WindowsXP.res}

type

XData = array[1..16] of Byte;

YData = array[1..16] of XData;

TPhysPointer =^YData;

procedure TForm1.btnReadClick(Sender: TObject);

var

i, j: longint;

nAddr: int64;//

s1, s2: String;

b: Byte;

ch: Char;

arrayMemory :pbytearray;

PointMemory:pointer;

hmemory:dword;

xhex: integer;

yhex: integer;

ofsetHex: integer;

begin

with gridData do

begin

ColWidths[0] := Canvas.TextWidth(IntToHex(0, 9));

ColWidths[1] := Canvas.TextWidth(Cells[1, 0]);

end;

nAddr := StrToInt('$' + editAddr.Text);

label2.Caption:=inttostr(nAddr div 1024 )+ ' kб';

hmemory:=OpenPhysicalMemory;

PointMemory:=MapViewOfFile(hmemory, FILE_MAP_READ, 0, nAddr, $2000); //размер секции 8 кб

arrayMemory :=PointMemory;

xhex:= nAddr and $0f;

yhex:=(nAddr and $00f0) div 16;

ofsetHex:= ((nAddr and $0f00) div 16);

if yhex = 0 then yhex:=0;

if PointMemory <> nil then

begin

for i:=1 to 16 do

begin

gridData.Cells[0,i] := IntToHex(nAddr,8);

s1 := '';

s2 := '';

for j:=1 to 16 do

begin

b := arrayMemory^[((i+ofsetHex+yhex-1)*16)+(j+xhex-1)];

s1 := s1 + IntToHex(b, 2) + ' ';

if b >= $20 then ch := Char(b) else ch:='.';

s2 := s2 + ch;

end;

gridData.Cells[1,i] := s1;

gridData.Cells[2,i] := s2;

nAddr := nAddr + 16;

end;

with gridData do

begin

ColWidths[2] := Canvas.TextWidth(Cells[2, 1] + ' ');

end;

end else MessageDlg('Этот участок памяти' +^M+' недоступен!!!' , mtWarning, [mbOK], 0);

end;

procedure TForm1.FormCreate(Sender: TObject);

var

i: integer;

begin

with gridData do

begin

Cells[0,0]:=' ADDR';

Cells[1,0]:='';

for i := 0 to 15 do

Cells[1,0] := Cells[1,0] + IntToHex(i, 2) + ' ';

Cells[2,0]:=' ASCII';

end;

end;

end.