paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-15 14:19:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ initial attempt at writing a TRawByteStringCollection

Browse Source 
git-svn-id: branches/unicodekvm@48629 -
This commit is contained in:
nickysn 2021-02-10 20:44:38 +00:00
parent 7da5856dbd
commit 0aaa75ba62
1 changed files with 96 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

96
packages/rtl-extra/src/inc/objects.pp
View File

@ -315,6 +315,7 @@ TYPE
FUNCTION GetPos: Longint; Virtual;
FUNCTION GetSize: Longint; Virtual;
FUNCTION ReadStr: PString;
FUNCTION ReadRawByteString: RawByteString;
FUNCTION ReadUnicodeString: UnicodeString;
PROCEDURE Open (OpenMode: Word); Virtual;
PROCEDURE Close; Virtual;
@ -324,6 +325,7 @@ TYPE
PROCEDURE Put (P: PObject);
PROCEDURE StrWrite (P: PChar);
PROCEDURE WriteStr (P: PString);
PROCEDURE WriteRawByteString (Const S: RawByteString);
PROCEDURE WriteUnicodeString (Const S: UnicodeString);
PROCEDURE Seek (Pos: LongInt); Virtual;
PROCEDURE Error (Code, Info: Integer); Virtual;
@ -490,6 +492,18 @@ TYPE
END;
PStringCollection = ^TStringCollection;
{---------------------------------------------------------------------------}
{ TRawByteStringCollection OBJECT - RAW BYTE STRING COLLECTION OBJECT }
{---------------------------------------------------------------------------}
TYPE
TRawByteStringCollection = OBJECT (TSortedCollection)
FUNCTION GetItem (Var S: TStream): Pointer; Virtual;
FUNCTION Compare (Key1, Key2: Pointer): Sw_Integer; Virtual;
PROCEDURE FreeItem (Item: Pointer); Virtual;
PROCEDURE PutItem (Var S: TStream; Item: Pointer); Virtual;
END;
PRawByteStringCollection = ^TRawByteStringCollection;
{---------------------------------------------------------------------------}
{ TStrCollection OBJECT - STRING COLLECTION OBJECT }
{---------------------------------------------------------------------------}
@ -1227,6 +1241,21 @@ BEGIN
End Else ReadStr := Nil;
END;
{--TStream------------------------------------------------------------------}
{ ReadRawByteString }
{---------------------------------------------------------------------------}
FUNCTION TStream.ReadRawByteString: RawByteString;
VAR CP: TSystemCodePage; L: LongInt;
BEGIN
Read(CP, SizeOf(CP));
Read(L, SizeOf(L));
If (L <= 0) Then ReadRawByteString := '' Else Begin
SetLength(ReadRawByteString, L);
SetCodePage(ReadRawByteString, CP, False);
Read(ReadRawByteString[1], L);
End;
END;
{--TStream------------------------------------------------------------------}
{ ReadUnicodeString }
{---------------------------------------------------------------------------}
@ -1357,6 +1386,20 @@ BEGIN
Else Write(Empty, 1); { Write empty string }
END;
{--TStream------------------------------------------------------------------}
{ WriteRawByteString }
{---------------------------------------------------------------------------}
PROCEDURE TStream.WriteRawByteString (Const S: RawByteString);
VAR CP: TSystemCodePage; L: LongInt;
BEGIN
CP := StringCodePage(S);
L := Length(S);
Write(CP, SizeOf(CP));
Write(L, SizeOf(L));
if L > 0 then
Write((@S[1])^, L);
END;
{--TStream------------------------------------------------------------------}
{ WriteUnicodeString }
{---------------------------------------------------------------------------}
@ -2521,6 +2564,59 @@ BEGIN
S.WriteStr(Item); { Write string }
END;
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ TRawByteStringCollection OBJECT METHODS }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{--TRawByteStringCollection-------------------------------------------------}
{ GetItem -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
{---------------------------------------------------------------------------}
FUNCTION TRawByteStringCollection.GetItem (Var S: TStream): Pointer;
BEGIN
GetItem := nil;
RawByteString(GetItem) := S.ReadRawByteString; { Get new item }
END;
{--TRawByteStringCollection-------------------------------------------------}
{ Compare -> Platforms DOS/DPMI/WIN/OS2 - Checked 21Aug97 LdB }
{---------------------------------------------------------------------------}
FUNCTION TRawByteStringCollection.Compare (Key1, Key2: Pointer): Sw_Integer;
VAR I, J: Sw_Integer; P1, P2: RawByteString;
BEGIN
P1 := RawByteString(Key1); { String 1 pointer }
P2 := RawByteString(Key2); { String 2 pointer }
If (Length(P1)<Length(P2)) Then J := Length(P1)
Else J := Length(P2); { Shortest length }
I := 1; { First character }
While (I<J) AND (P1[I]=P2[I]) Do Inc(I); { Scan till fail }
If (I=J) Then Begin { Possible match }
{ * REMARK * - Bug fix 21 August 1997 }
If (P1[I]<P2[I]) Then Compare := -1 Else { String1 < String2 }
If (P1[I]>P2[I]) Then Compare := 1 Else { String1 > String2 }
If (Length(P1)>Length(P2)) Then Compare := 1 { String1 > String2 }
Else If (Length(P1)<Length(P2)) Then { String1 < String2 }
Compare := -1 Else Compare := 0; { String1 = String2 }
{ * REMARK END * - Leon de Boer }
End Else If (P1[I]<P2[I]) Then Compare := -1 { String1 < String2 }
Else Compare := 1; { String1 > String2 }
END;
{--TRawByteStringCollection-------------------------------------------------}
{ FreeItem -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TRawByteStringCollection.FreeItem (Item: Pointer);
BEGIN
RawByteString(Item):=''; { Dispose item }
END;
{--TRawByteStringCollection-------------------------------------------------}
{ PutItem -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TRawByteStringCollection.PutItem (Var S: TStream; Item: Pointer);
BEGIN
S.WriteRawByteString(RawByteString(Item)); { Write string }
END;
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ TStrCollection OBJECT METHODS }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}