MemStream.pas

   1 unit MemStream;
   2
   3 INTERFACE
   4 uses SysUtils;
   5 type tMemoryStream=object
   6  length: LongWord;
   7  size: LongWord;
   8  base: pointer;
   9  position: LongWord;
  10  procedure Seek(absolute:LongWord);
  11  procedure Skip(cnt:Word);
  12  procedure Read(var buf; cnt:Word);
  13  function  ReadByte:byte;
  14  function  ReadWord(cnt:byte): LongWord;
  15  procedure Trunc;
  16  procedure Append;
  17  function  Tell:LongWord;
  18  procedure Write(var buf; cnt:word);
  19  procedure WriteByte(v:byte);
  20  procedure WriteWord(v:LongWord; cnt:byte);
  21  procedure Init(ibuf:pointer; ilen,isize:LongWord);
  22  function WRBuf:pointer;
  23  function WRBufLen:LongWord;
  24  procedure WREnd(used:LongWord);
  25  function RDBuf:pointer;
  26  function RDBufLen:LongWord;
  27  procedure RDEnd(used:LongWord);
  28  end;
  29
  30 type eInvalidMemStreamAccess=class(Exception)
  31  {no details jet}
  32 end;
  33
  34 IMPLEMENTATION
  35
  36 procedure tMemoryStream.Seek(absolute:LongWord);
  37  begin
  38  if absolute>size then raise eInvalidMemStreamAccess.Create('Seek out of bounds');
  39  position:=absolute;
  40 end;
  41
  42 procedure tMemoryStream.Skip(cnt:Word);
  43  begin
  44  Seek(position+cnt);
  45 end;
  46
  47 procedure tMemoryStream.Read(var buf; cnt:Word);
  48  begin
  49  if (position+cnt)>length then raise eInvalidMemStreamAccess.Create('Read out of bounds');
  50  Move((base+position)^,buf,cnt);
  51  position:=position+cnt;
  52 end;
  53
  54 function  tMemoryStream.ReadByte:byte;
  55  begin Read(result, 1); end;
  56
  57 function  tMemoryStream.ReadWord(cnt:byte): LongWord;
  58  {$IFDEF ENDIAN_LITTLE}
  59  var tm:packed array [0..3] of byte;
  60  var i:byte;
  61  begin
  62  FillChar(tm,4,0);
  63  if (position+cnt)>length then raise eInvalidMemStreamAccess.Create('Read out of bounds');
  64  for i:=cnt-1 downto 0 do begin
  65   tm[i]:=byte((base+position)^);
  66   inc(position);
  67  end;
  68  {$ELSE}
  69  begin
  70  Read(tm[4-cnt],cnt);
  71  {$ENDIF}
  72  ReadWord:=LongWord(pointer(@tm)^);
  73 end;
  74
  75 procedure tMemoryStream.Trunc;
  76  begin length:=position; end;
  77 procedure tMemoryStream.Append;
  78  begin position:=length; end;
  79 function tMemoryStream.Tell:LongWord;
  80  begin Tell:=position; end;
  81
  82 procedure tMemoryStream.Write(var buf; cnt:word);
  83  begin
  84  if (position+cnt)>size then raise eInvalidMemStreamAccess.Create('Write out of bounds');
  85  Move(buf,(base+position)^,cnt);
  86  position:=position+cnt;
  87  if position>length then length:=position;
  88 end;
  89 procedure tMemoryStream.WriteByte(v:byte);
  90  begin Write(v,1); end;
  91
  92 procedure tMemoryStream.WriteWord(v:LongWord; cnt:byte);
  93  var tm:packed array [0..3] of byte absolute v;
  94  var i:byte;
  95  begin
  96  {$IFDEF ENDIAN_LITTLE}
  97  if (position+cnt)>size then raise eInvalidMemStreamAccess.Create('Write out of bounds');
  98  for i:=cnt-1 downto 0 do begin
  99   byte((base+position)^):=tm[i];
 100   inc(position);
 101  end;
 102  if position>length then length:=position;
 103  {$ELSE}
 104  Write(tm[4-cnt],cnt);
 105  {$ENDIF}
 106 end;
 107
 108 procedure tMemoryStream.Init(ibuf:pointer; ilen,isize:LongWord);
 109  begin
 110  base:=ibuf;
 111  length:=ilen;
 112  size:=isize;
 113  seek(0);
 114 end;
 115
 116 function tMemoryStream.WRBuf:pointer;
 117  begin result:=base+position end;
 118 function tMemoryStream.WRBufLen:LongWord;
 119  begin result:=size-position end;
 120 procedure tMemoryStream.WREnd(used:LongWord);
 121  begin RDEnd(used); if position>length then length:=position end;
 122 function tMemoryStream.RDBuf:pointer;
 123  begin result:=base+position end;
 124 function tMemoryStream.RDBufLen:LongWord;
 125  begin result:=length-position end;
 126 procedure tMemoryStream.RDEnd(used:LongWord);
 127  begin skip(used) end;
 128
 129 END.
 130