paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-28 11:31:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

rtl: TBinaryObjectWriter.Version

Browse Source
This commit is contained in:
mattias 2023-01-07 10:10:21 +01:00
parent b641c564c6
commit b0f5d5a4e1
2 changed files with 31 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -85,6 +85,7 @@ const
Const
FilerSignature : Array[1..4] of char = 'TPF0';
FilerSignature1 : Array[1..4] of char = 'TPF1';
type
{ Text alignment types }
@ -1645,12 +1646,21 @@ type
{ TBinaryObjectWriter }
TBinaryObjectWriter = class(TAbstractObjectWriter)
public
type
TBOWVersion = (
bowVersion0,
bowVersion1
);
const
UnitnameSeparator = '/';
protected
FStream: TStream;
FBuffer: Pointer;
FBufSize: Integer;
FBufPos: Integer;
FBufEnd: Integer;
FVersion: TBOWVersion;
procedure WriteWord(w : word); {$ifdef CLASSESINLINE}inline;{$endif CLASSESINLINE}
procedure WriteDWord(lw : longword); {$ifdef CLASSESINLINE}inline;{$endif CLASSESINLINE}
procedure WriteQWord(qw : qword); {$ifdef CLASSESINLINE}inline;{$endif CLASSESINLINE}
@ -1686,11 +1696,13 @@ type
procedure WriteUInt64(Value: QWord); override;
procedure WriteMethodName(const Name: String); override;
procedure WriteSet(Value: LongInt; SetType: Pointer); override;
procedure WriteStr(const Value: String);
procedure WriteStr(const Value: String); // write shortstring
procedure WriteString(const Value: String); override;
procedure WriteWideString(const Value: WideString); override;
procedure WriteUnicodeString(const Value: UnicodeString); override;
procedure WriteVariant(const VarValue: Variant);override;
property Version: TBOWVersion read FVersion write FVersion;
end;
TTextObjectWriter = class(TAbstractObjectWriter)
@ -1756,12 +1768,12 @@ type
procedure WriteIdent(const Ident: string);
procedure WriteInteger(Value: Longint); overload;
procedure WriteInteger(Value: Int64); overload;
procedure WriteSet(Value: LongInt; SetType: Pointer);
procedure WriteSet(Value: Longint; SetType: Pointer);
procedure WriteListBegin;
procedure WriteListEnd;
Procedure WriteSignature;
procedure WriteRootComponent(ARoot: TComponent);
procedure WriteString(const Value: string);
procedure WriteString(const Value: String);
procedure WriteWideString(const Value: WideString);
procedure WriteUnicodeString(const Value: UnicodeString);
procedure WriteVariant(const VarValue: Variant);

26
rtl/objpas/classes/writer.inc
View File

@ -121,7 +121,10 @@ end;
procedure TBinaryObjectWriter.WriteSignature;
begin
Write(FilerSignature, SizeOf(FilerSignature));
if Version=bowVersion1 then
Write(FilerSignature1, SizeOf(FilerSignature1))
else
Write(FilerSignature, SizeOf(FilerSignature));
end;
procedure TBinaryObjectWriter.BeginComponent(Component: TComponent;
@ -139,7 +142,10 @@ begin
WriteInteger(ChildPos);
end;
WriteStr(Component.ClassName);
if Version=bowVersion0 then
WriteStr(Component.ClassName)
else
WriteString(Component.UnitName+UnitnameSeparator+Component.ClassName);
WriteStr(Component.Name);
end;
@ -374,7 +380,7 @@ begin
end;
end;
procedure TBinaryObjectWriter.WriteVariant(const VarValue: variant);
procedure TBinaryObjectWriter.WriteVariant(const VarValue: Variant);
begin
{ The variant manager will handle varbyref and vararray transparently for us
}
@ -434,7 +440,7 @@ begin
FBufPos := 0;
end;
procedure TBinaryObjectWriter.Write(const Buffer; Count: LongInt);
procedure TBinaryObjectWriter.Write(const Buffer; Count: Longint);
var
CopyNow: LongInt;
SourceBuf: PChar;
@ -535,8 +541,8 @@ begin
FAncestors.AddObject(Component.Name,TPosComponent.Create(FAncestors.Count,Component));
end;
procedure TWriter.DefineProperty(const Name: String;
ReadData: TReaderProc; AWriteData: TWriterProc; HasData: Boolean);
procedure TWriter.DefineProperty(const Name: string; ReadData: TReaderProc;
AWriteData: TWriterProc; HasData: Boolean);
begin
if HasData and Assigned(AWriteData) then
begin
@ -547,8 +553,8 @@ begin
end;
end;
procedure TWriter.DefineBinaryProperty(const Name: String;
ReadData, AWriteData: TStreamProc; HasData: Boolean);
procedure TWriter.DefineBinaryProperty(const Name: string; ReadData,
AWriteData: TStreamProc; HasData: Boolean);
begin
if HasData and Assigned(AWriteData) then
begin
@ -807,7 +813,7 @@ begin
Driver.WriteIdent(Ident);
end;
procedure TWriter.WriteInteger(Value: LongInt);
procedure TWriter.WriteInteger(Value: Longint);
begin
Driver.WriteInteger(Value);
end;
@ -817,7 +823,7 @@ begin
Driver.WriteInteger(Value);
end;
procedure TWriter.WriteSet(Value: LongInt; SetType: Pointer);
procedure TWriter.WriteSet(Value: Longint; SetType: Pointer);
begin
Driver.WriteSet(Value,SetType);