mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-28 06:59:13 +02:00
rtl: add TBytesStream class for compatibility with delphi (TStringStream is a descendant of TBytesStream) + test
git-svn-id: trunk@19389 -
This commit is contained in:
parent
85f7914906
commit
7817f5017d
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -10671,6 +10671,7 @@ tests/test/units/character/ttoupper.pp svneol=native#text/pascal
|
|||||||
tests/test/units/character/ttoupper2.pp svneol=native#text/pascal
|
tests/test/units/character/ttoupper2.pp svneol=native#text/pascal
|
||||||
tests/test/units/character/ttoupper3.pp svneol=native#text/pascal
|
tests/test/units/character/ttoupper3.pp svneol=native#text/pascal
|
||||||
tests/test/units/character/tutf32convert.pp svneol=native#text/pascal
|
tests/test/units/character/tutf32convert.pp svneol=native#text/pascal
|
||||||
|
tests/test/units/classes/tbytesstreamtest.pp svneol=native#text/pascal
|
||||||
tests/test/units/classes/tmakeobjinst.pp svneol=native#text/plain
|
tests/test/units/classes/tmakeobjinst.pp svneol=native#text/plain
|
||||||
tests/test/units/classes/tsetstream.pp svneol=native#text/plain
|
tests/test/units/classes/tsetstream.pp svneol=native#text/plain
|
||||||
tests/test/units/classes/tvclcomobject.pp svneol=native#text/plain
|
tests/test/units/classes/tvclcomobject.pp svneol=native#text/plain
|
||||||
|
@ -918,6 +918,18 @@ type
|
|||||||
function Write(const Buffer; Count: LongInt): LongInt; override;
|
function Write(const Buffer; Count: LongInt): LongInt; override;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{ TBytesStream }
|
||||||
|
|
||||||
|
TBytesStream = class(TMemoryStream)
|
||||||
|
private
|
||||||
|
FBytes: TBytes;
|
||||||
|
protected
|
||||||
|
function Realloc(var NewCapacity: Longint): Pointer; override;
|
||||||
|
public
|
||||||
|
constructor Create(const ABytes: TBytes); overload;
|
||||||
|
property Bytes: TBytes read FBytes;
|
||||||
|
end;
|
||||||
|
|
||||||
{ TStringStream }
|
{ TStringStream }
|
||||||
|
|
||||||
TStringStream = class(TStream)
|
TStringStream = class(TStream)
|
||||||
|
@ -755,6 +755,39 @@ begin
|
|||||||
Result:=Count;
|
Result:=Count;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{****************************************************************************}
|
||||||
|
{* TBytesStream *}
|
||||||
|
{****************************************************************************}
|
||||||
|
|
||||||
|
constructor TBytesStream.Create(const ABytes: TBytes);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FBytes:=ABytes;
|
||||||
|
SetPointer(Pointer(FBytes),Length(FBytes));
|
||||||
|
FCapacity:=Length(FBytes);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBytesStream.Realloc(var NewCapacity: Longint): Pointer;
|
||||||
|
begin
|
||||||
|
// adapt TMemoryStream code to use with dynamic array
|
||||||
|
if NewCapacity<0 Then
|
||||||
|
NewCapacity:=0
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if (NewCapacity>Capacity) and (NewCapacity < (5*Capacity) div 4) then
|
||||||
|
NewCapacity := (5*Capacity) div 4;
|
||||||
|
NewCapacity := (NewCapacity + (TMSGrow-1)) and not (TMSGROW-1);
|
||||||
|
end;
|
||||||
|
if NewCapacity=Capacity then
|
||||||
|
Result:=Pointer(FBytes)
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
SetLength(FBytes,Newcapacity);
|
||||||
|
Result:=Pointer(FBytes);
|
||||||
|
if (Result=nil) and (Newcapacity>0) then
|
||||||
|
raise EStreamError.Create(SMemoryStreamError);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
{****************************************************************************}
|
{****************************************************************************}
|
||||||
{* TStringStream *}
|
{* TStringStream *}
|
||||||
|
38
tests/test/units/classes/tbytesstreamtest.pp
Normal file
38
tests/test/units/classes/tbytesstreamtest.pp
Normal file
@ -0,0 +1,38 @@
|
|||||||
|
program tbytesstreamtest;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
{$apptype console}
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils, Classes;
|
||||||
|
|
||||||
|
var
|
||||||
|
BS: TBytesStream;
|
||||||
|
MS: TMemoryStream;
|
||||||
|
B: TBytes;
|
||||||
|
begin
|
||||||
|
B := TBytes.Create(1, 2, 3);
|
||||||
|
BS := TBytesStream.Create(B);
|
||||||
|
WriteLn(BS.Size);
|
||||||
|
|
||||||
|
// save it to regular memory stream
|
||||||
|
MS := TMemoryStream.Create;
|
||||||
|
try
|
||||||
|
BS.SaveToStream(MS);
|
||||||
|
finally
|
||||||
|
BS.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// now restore and compare
|
||||||
|
BS := TBytesStream.Create;
|
||||||
|
try
|
||||||
|
MS.Position := 0;
|
||||||
|
BS.LoadFromStream(MS);
|
||||||
|
B := BS.Bytes;
|
||||||
|
if (Length(B) < 3) or (B[0] <> 1) or (B[1] <> 2) or (B[2] <> 3) then
|
||||||
|
halt(1);
|
||||||
|
finally
|
||||||
|
BS.Free;
|
||||||
|
end;
|
||||||
|
MS.Free;
|
||||||
|
end.
|
Loading…
Reference in New Issue
Block a user