{$mode objfpc} {$h+} unit streamex; Interface uses Classes; type { TBidirBinaryObjectReader } TBidirBinaryObjectReader = class(TBinaryObjectReader) protected function GetPosition: Longint; procedure SetPosition(const AValue: Longint); public property Position: Longint read GetPosition write SetPosition; end; { TBidirBinaryObjectWriter } TBidirBinaryObjectWriter = class(TBinaryObjectWriter) protected function GetPosition: Longint; procedure SetPosition(const AValue: Longint); public property Position: Longint read GetPosition write SetPosition; end; { TDelphiReader } TDelphiReader = class(TReader) protected function GetPosition: LongInt; procedure SetPosition(const AValue: LongInt); function CreateDriver(Stream: TStream; BufSize: Integer): TAbstractObjectReader; override; public function GetDriver: TBidirBinaryObjectReader; function ReadStr: string; procedure Read(var Buf; Count: LongInt); override; property Position: LongInt read GetPosition write SetPosition; end; { TDelphiWriter } TDelphiWriter = class(TWriter) protected function GetPosition: Longint; procedure SetPosition(const AValue: LongInt); function CreateDriver(Stream: TStream; BufSize: Integer): TAbstractObjectWriter; override; public function GetDriver: TBidirBinaryObjectWriter; procedure FlushBuffer; procedure Write(const Buf; Count: LongInt); override; procedure WriteStr(const Value: string); procedure WriteValue(Value: TValueType); property Position: LongInt read GetPosition write SetPosition; end; TStreamHelper = class helper for TStream function ReadWordLE :word; function ReadDWordLE:dword; function ReadQWordLE:qword; procedure WriteWordLE (w:word); procedure WriteDWordLE(dw:dword); procedure WriteQWordLE(dq:qword); function ReadWordBE :word; function ReadDWordBE:dword; function ReadQWordBE:qword; procedure WriteWordBE (w:word); procedure WriteDWordBE(dw:dword); procedure WriteQWordBE(dq:qword); {$ifndef FPC} function ReadByte : Byte; function ReadWord : Word; function ReadDWord : DWord; function ReadQWord : QWord; procedure WriteByte (b : Byte); procedure WriteWord (b : word); procedure WriteDWord (b : DWord); procedure WriteQWord (b : QWord); {$endif} end; Implementation { TBidirBinaryObjectReader } function TBidirBinaryObjectReader.GetPosition: Longint; begin Result := FStream.Position - (FBufEnd - FBufPos); end; procedure TBidirBinaryObjectReader.SetPosition(const AValue: Longint); begin FStream.Position := AValue; FBufPos := 0; FBufEnd := 0; end; { TBidirBinaryObjectWriter } function TBidirBinaryObjectWriter.GetPosition: Longint; begin Result := FStream.Position - (FBufEnd - FBufPos); end; procedure TBidirBinaryObjectWriter.SetPosition(const AValue: Longint); begin FStream.Position := AValue; FBufPos := 0; FBufEnd := 0; end; { TDelphiReader } function TDelphiReader.GetDriver: TBidirBinaryObjectReader; begin Result := (Driver as TBidirBinaryObjectReader); end; function TDelphiReader.GetPosition: LongInt; begin Result := GetDriver.Position; end; procedure TDelphiReader.SetPosition(const AValue: LongInt); begin GetDriver.Position := AValue; end; function TDelphiReader.CreateDriver(Stream: TStream; BufSize: Integer): TAbstractObjectReader; begin Result := TBidirBinaryObjectReader.Create(Stream, BufSize); end; function TDelphiReader.ReadStr: string; begin Result := GetDriver.ReadStr; end; procedure TDelphiReader.Read(var Buf; Count: LongInt); begin GetDriver.Read(Buf, Count); end; { TDelphiWriter } function TDelphiWriter.GetDriver: TBidirBinaryObjectWriter; begin Result := (Driver as TBidirBinaryObjectWriter); end; function TDelphiWriter.GetPosition: LongInt; begin Result := GetDriver.Position; end; procedure TDelphiWriter.SetPosition(const AValue: LongInt); begin GetDriver.Position := AValue; end; function TDelphiWriter.CreateDriver(Stream: TStream; BufSize: Integer): TAbstractObjectWriter; begin Result := TBidirBinaryObjectWriter.Create(Stream, BufSize); end; procedure TDelphiWriter.FlushBuffer; begin GetDriver.FlushBuffer(); end; procedure TDelphiWriter.Write(const Buf; Count: Longint); begin GetDriver.Write(Buf, Count); end; procedure TDelphiWriter.WriteStr(const Value: string); begin GetDriver.WriteStr(Value); end; procedure TDelphiWriter.WriteValue(Value: TValueType); begin GetDriver.WriteValue(Value); end; function TStreamHelper.readwordLE:word; begin result:=LEtoN(readword); end; function TStreamHelper.readdwordLE:dword; begin result:=LEtoN(readdword); end; function TStreamHelper.readqwordLE:qword; begin result:=LEtoN(readqword); end; function TStreamHelper.readwordBE:word; begin result:=BEtoN(readword); end; function TStreamHelper.readdwordBE:dword; begin result:=BEtoN(readdword); end; function TStreamHelper.readqwordBE:qword; begin result:=BEtoN(readqword); end; procedure TStreamHelper.WriteWordBE(w:word); begin WriteWord(NtoBE(w)); end; procedure TStreamHelper.WriteDWordBE(dw:dword); begin WriteDWord(NtoBE(dw)); end; procedure TStreamHelper.WriteQWordBE(dq:qword); begin WriteQWord(NtoBE(dq)); end; procedure TStreamHelper.WriteWordLE(w:word); begin WriteWord(NtoLE(w)); end; procedure TStreamHelper.WriteDWordLE(dw:dword); begin WriteDWord(NtoLE(dw)); end; procedure TStreamHelper.WriteQWordLE(dq:qword); begin WriteQWord(NtoLE(dq)); end; {$ifndef FPC} // there can only be one helper per class, and I use these in Delphi for FPC compatibility. function TStreamHelper.ReadByte: Byte; begin self.Read(result,sizeof(result)); end; function TStreamHelper.ReadDWord: DWord; begin self.Read(result,sizeof(result)); end; function TStreamHelper.ReadWord: Word; begin self.Read(result,sizeof(result)); end; procedure TStreamHelper.WriteByte(b: Byte); begin self.Write(b,sizeof(b)); end; procedure TStreamHelper.WriteDWord(b: DWord); begin self.Write(b,sizeof(b)); end; procedure TStreamHelper.WriteWord(b: Word); begin self.Write(b,sizeof(b)); end; {$endif} end.