source: branches/ByteArray/Devices/IntMemory.pas

unit IntMemory;

interface

uses
  Classes, SysUtils, Int, Channel, Device;

type

  { TMemory }

  TMemory = class(TChannelDevice)
  private
    FSize: TInt;
    FData: PByte;
    function GetSize: TInt;
    procedure SetSize(AValue: TInt);
    procedure CheckGrow(Address: Integer);
  public
    Position: TInt;
    Grow: Boolean;
    procedure Assign(Source: TMemory);
    function Read(Address: TInt; ASize: TIntSize): TInt;
    function ReadPos(ASize: Byte): TInt;
    procedure Write(Address: TInt; ASize: TIntSize; Value: TInt);
    procedure WritePos(ASize: Byte; Value: TInt);
    procedure WriteStringPos(Value: string);
    procedure WriteMemoryPos(Memory: TMemory);
    procedure SetChannel(Channel: TChannel); override;
    procedure SaveToFile(FileName: string);
    procedure LoadFromFile(FileName: string);
    procedure FillZero;
    procedure Clear;
    function ToString: string; override;
    property Size: TInt read FSize write SetSize;
    constructor Create;
    destructor Destroy; override;
  end;


implementation

resourcestring
  SOutOfRange = 'Address out of range.';

{ TMemory }

function TMemory.GetSize: TInt;
begin
  Result := MemSize(FData);
end;

procedure TMemory.SetSize(AValue: TInt);
begin
  FSize := AValue;
  FData := ReAllocMem(FData, AValue);
end;

procedure TMemory.CheckGrow(Address: Integer);
begin
  if Grow and (Size < Address) then Size := Address;
end;

procedure TMemory.Assign(Source: TMemory);
begin
  Size := Source.Size;
  if FSize > 0 then
    Move(Source.FData[0], FData[0], FSize);
  Position := Source.Position;
end;

function TMemory.Read(Address: TInt; ASize: TIntSize): TInt;
begin
  if Address + ASize > FSize then raise Exception.Create(SOutOfRange);
  case ASize of
    1: Result := PByte(FData + Integer(Address))^;
    2: Result := PWord(FData + Integer(Address))^;
    4: Result := PDWord(FData + Integer(Address))^;
    8: Result := PQWord(FData + Integer(Address))^;
  end;
end;

function TMemory.ReadPos(ASize: Byte): TInt;
begin
  Result := Read(Position, ASize);
  Inc(Position, ASize);
end;

procedure TMemory.Write(Address: TInt; ASize: TIntSize; Value: TInt);
begin
  if Address + ASize > FSize then raise Exception.Create(SOutOfRange);
  case ASize of
    1: PByte(FData + Integer(Address))^ := Value;
    2: PWord(FData + Integer(Address))^ := Value;
    4: PDWord(FData + Integer(Address))^ := Value;
    8: PQWord(FData + Integer(Address))^ := Value;
  end;
end;

procedure TMemory.WritePos(ASize: Byte; Value: TInt);
begin
  CheckGrow(Position + ASize);
  Write(Position, ASize, Value);
  Inc(Position, ASize);
end;

procedure TMemory.WriteStringPos(Value: string);
var
  I: Integer;
begin
  CheckGrow(Position + Length(Value));
  if Length(Value) > 0 then begin
    if Position + Length(Value) > FSize then Size := Position + Length(Value);
    for I := 0 to Length(Value) - 1 do
      Write(Position + I, 1, Ord(Value[I + 1]));
    Inc(Position, Length(Value));
  end;
end;

procedure TMemory.WriteMemoryPos(Memory: TMemory);
begin
  CheckGrow(Position + Memory.Size);
  if Memory.Size > 0 then begin
    if Position + Memory.Size > FSize then Size := Position + Memory.Size;
    Move(Memory.FData[0], FData[Position], Memory.Size);
    Inc(Position, Memory.Size);
  end;
end;

procedure TMemory.SetChannel(Channel: TChannel);
begin
  Channel.Read := Read;
  Channel.Write := Write;
  Channel.GetSize := GetSize;
end;

procedure TMemory.FillZero;
begin
  FillChar(FData^, FSize, 0);
end;

procedure TMemory.Clear;
begin
  Size := 0;
  Position := 0;
end;

function TMemory.ToString: string;
var
  I: Integer;
begin
  Result := '';
  for I := 0 to FSize - 1 do
    Result := Result + ', ' + IntToStr(FData[I]);
  Delete(Result, 1, 2);
end;

constructor TMemory.Create;
begin
  FSize := 0;
end;

destructor TMemory.Destroy;
begin
  Size := 0;
  inherited;
end;

procedure TMemory.SaveToFile(FileName: string);
var
  F: TFileStream;
begin
  if FileExists(FileName) then
    F := TFileStream.Create(FileName, fmOpenWrite)
    else F := TFileStream.Create(FileName, fmCreate);
  try
    if FSize > 0 then F.Write(FData[0], FSize);
  finally
    F.Free;
  end;
end;

procedure TMemory.LoadFromFile(FileName: string);
var
  F: TFileStream;
begin
  F := TFileStream.Create(FileName, fmOpenRead);
  try
    if FSize < F.Size then Size := F.Size;
    F.Read(FData[0], FSize);
  finally
    F.Free;
  end;
end;

end.