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

* Add TestStreamFormat

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-02-14 18:18:21 +01:00
parent 7506277dc1
commit 186f93a8c9
2 changed files with 23 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
rtl/objpas/classes/classes.inc
View File

@ -2727,7 +2727,29 @@ begin
Output.FixupResourceHeader(FixupInfo); // Insert real resource data size Output.FixupResourceHeader(FixupInfo); // Insert real resource data size
end; end;
function TestStreamFormat(const Stream: TStream): TStreamOriginalFormat;
const
StartChars = [#9, #10, #13, #11, 'o', 'O','i','I',' '];
var
aPos: Int64;
Sig: Packed Array[0..3] of byte;
IntSig : Longint absolute sig;
begin
Result:=sofUnknown;
aPos:=Stream.Position;
IntSig:=0;
Stream.Read(Sig,SizeOf(Sig));
Stream.Seek(aPos,soBeginning);
if (Sig[0]=$FF) or (IntSig=LongInt(FilerSignature)) or (IntSig=LongInt(FilerSignature1)) or (IntSig=0) then
Result:=sofBinary
else if (AnsiChar(Sig[0]) in StartChars) then
Result:=sofText
else if (Sig[1]=$BF) and (Sig[2]=$BB) and (Sig[3]=$EF) then
Result:=sofUTF8Text;
end;
{ Utility routines } { Utility routines }

1
rtl/objpas/classes/classesh.inc
View File

@ -2883,6 +2883,7 @@ procedure ObjectTextToBinary(Input, Output: TStream);
procedure ObjectResourceToText(Input, Output: TStream); procedure ObjectResourceToText(Input, Output: TStream);
procedure ObjectTextToResource(Input, Output: TStream); procedure ObjectTextToResource(Input, Output: TStream);
function TestStreamFormat(const Stream: TStream): TStreamOriginalFormat;
{ Utility routines } { Utility routines }