Browse Source

rtl: TBinaryObjectWriter.Version

mattias 2 years ago
parent
commit
b0f5d5a4e1
2 changed files with 31 additions and 13 deletions
  1. 15 3
      rtl/objpas/classes/classesh.inc
  2. 16 10
      rtl/objpas/classes/writer.inc

+ 15 - 3
rtl/objpas/classes/classesh.inc

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

+ 16 - 10
rtl/objpas/classes/writer.inc

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