rtl: added overload GetClass(UnitName,ClassName), implemented UnregisterClass, overload TStream.WriteComponent(Instance,WriteUnitName)

rtl/objpas/classes/classesh.inc

@@ -958,6 +958,7 @@ type
     function WriteMaxSizeData(Const Buffer; aSize,aCount : NativeInt) : NativeInt;
     Procedure WriteExactSizeData(Const Buffer; aSize,aCount : NativeInt);
   public
+    const DefaultWriteUnitname : Boolean = false;
     function Read(var Buffer; Count: Longint): Longint; virtual; overload;
     function Read(var Buffer: TBytes; Count: Longint): Longint; overload;
     function Read( Buffer : TBytes; aOffset, Count: Longint): Longint; overload;
@@ -1114,10 +1115,14 @@ type
     function CopyFrom(Source: TStream; Count: Int64): Int64;
     function ReadComponent(Instance: TComponent): TComponent;
     function ReadComponentRes(Instance: TComponent): TComponent;
-    procedure WriteComponent(Instance: TComponent);
-    procedure WriteComponentRes(const ResName: string; Instance: TComponent);
-    procedure WriteDescendent(Instance, Ancestor: TComponent);
-    procedure WriteDescendentRes(const ResName: string; Instance, Ancestor: TComponent);
+    procedure WriteComponent(Instance: TComponent); overload;
+    procedure WriteComponent(Instance: TComponent; aWriteUnitname: boolean); overload;
+    procedure WriteComponentRes(const ResName: string; Instance: TComponent); overload;
+    procedure WriteComponentRes(const ResName: string; Instance: TComponent; aWriteUnitname: boolean); overload;
+    procedure WriteDescendent(Instance, Ancestor: TComponent); overload;
+    procedure WriteDescendent(Instance, Ancestor: TComponent; aWriteUnitname: boolean); overload;
+    procedure WriteDescendentRes(const ResName: string; Instance, Ancestor: TComponent); overload;
+    procedure WriteDescendentRes(const ResName: string; Instance, Ancestor: TComponent; aWriteUnitname: boolean); overload;
     procedure WriteResourceHeader(const ResName: string; {!!!:out} var FixupInfo: Longint);
     procedure FixupResourceHeader(FixupInfo: Longint);
     procedure ReadResHeader;
@@ -1396,6 +1401,8 @@ type
     procedure BeginRootComponent; virtual; abstract;
     procedure BeginComponent(var Flags: TFilerFlags; var AChildPos: Integer;
       var CompClassName, CompName: String); virtual; abstract;
+    procedure BeginComponent(var Flags: TFilerFlags; var AChildPos: Integer;
+      var CompUnitName, CompClassName, CompName: String); virtual;
     function BeginProperty: String; virtual; abstract;
 
     //Please don't use read, better use ReadBinary whenever possible
@@ -1426,12 +1433,23 @@ type
   { TBinaryObjectReader }
 
   TBinaryObjectReader = class(TAbstractObjectReader)
+  public
+    {$ScopedEnums on}
+    type
+      TBOVersion = (
+        boVersion0,
+        boVersion1
+        );
+    {$ScopedEnums off}
+    const
+      UnitnameSeparator = '/';
   protected
     FStream: TStream;
     FBuffer: Pointer;
     FBufSize: Integer;
     FBufPos: Integer;
     FBufEnd: Integer;
+    FVersion: TBOVersion;
 
     function ReadWord : word; {$ifdef CLASSESINLINE}inline;{$endif CLASSESINLINE}
     function ReadDWord : longword; {$ifdef CLASSESINLINE}inline;{$endif CLASSESINLINE}
@@ -1448,7 +1466,7 @@ type
     function ReadValue: TValueType; override;
     procedure BeginRootComponent; override;
     procedure BeginComponent(var Flags: TFilerFlags; var AChildPos: Integer;
-      var CompClassName, CompName: String); override;
+      var CompUnitName, CompClassName, CompName: String); override;
     function BeginProperty: String; override;
 
     //Please don't use read, better use ReadBinary whenever possible
@@ -1473,6 +1491,7 @@ type
     function ReadUnicodeString: UnicodeString;override;
     procedure SkipComponent(SkipComponentInfos: Boolean); override;
     procedure SkipValue; override;
+    property Version: TBOVersion read FVersion;
   end;
 
 
@@ -1493,6 +1512,8 @@ type
     var PropName: string; IsPath: boolean; var Handled, Skip: Boolean) of object;
   TFindComponentClassEvent = procedure(Reader: TReader; const ClassName: string;
     var ComponentClass: TComponentClass) of object;
+  TFindComponentClassExEvent = procedure(Reader: TReader; const anUnitname, ClassName: string;
+    var ComponentClass: TComponentClass) of object;
   TCreateComponentEvent = procedure(Reader: TReader;
     ComponentClass: TComponentClass; var Component: TComponent) of object;
 
@@ -1506,6 +1527,7 @@ type
   TReader = class(TFiler)
   private
     FDriver: TAbstractObjectReader;
+    FOnFindComponentClassEx: TFindComponentClassExEvent;
     FOwner: TComponent;
     FParent: TComponent;
     FFixups: TObject;
@@ -1524,7 +1546,7 @@ type
     FCanHandleExcepts: Boolean;
     FOnReadStringProperty:TReadWriteStringPropertyEvent;
     procedure DoFixupReferences;
-    function FindComponentClass(const AName, AClassName: string): TComponentClass;
+    function FindComponentClass(const AName, anUnitName, AClassName: string): TComponentClass;
     procedure Lock;
     procedure Unlock;
   protected
@@ -1597,6 +1619,7 @@ type
     property OnAncestorNotFound: TAncestorNotFoundEvent read FOnAncestorNotFound write FOnAncestorNotFound;
     property OnCreateComponent: TCreateComponentEvent read FOnCreateComponent write FOnCreateComponent;
     property OnFindComponentClass: TFindComponentClassEvent read FOnFindComponentClass write FOnFindComponentClass;
+    property OnFindComponentClassEx: TFindComponentClassExEvent read FOnFindComponentClassEx write FOnFindComponentClassEx;
     property OnReadStringProperty: TReadWriteStringPropertyEvent read FOnReadStringProperty write FOnReadStringProperty;
   end;
 
@@ -1646,21 +1669,13 @@ 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;
+    FVersion: TBinaryObjectReader.TBOVersion;
     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}
@@ -1702,7 +1717,7 @@ type
     procedure WriteUnicodeString(const Value: UnicodeString); override;
     procedure WriteVariant(const VarValue: Variant);override;
 
-    property Version: TBOWVersion read FVersion write FVersion;
+    property Version: TBinaryObjectReader.TBOVersion read FVersion write FVersion;
   end;
 
   TTextObjectWriter = class(TAbstractObjectWriter)
@@ -2412,10 +2427,12 @@ procedure RegisterClass(AClass: TPersistentClass);
 procedure RegisterClasses(AClasses: array of TPersistentClass);
 procedure RegisterClassAlias(AClass: TPersistentClass; const Alias: string);
 procedure UnRegisterClass(AClass: TPersistentClass);
-procedure UnRegisterClasses(AClasses: array of TPersistentClass);
+procedure UnRegisterClasses(const AClasses: array of TPersistentClass);
 procedure UnRegisterModuleClasses(Module: HMODULE);
-function FindClass(const AClassName: string): TPersistentClass;
-function GetClass(const AClassName: string): TPersistentClass;
+function FindClass(const AClassName: string): TPersistentClass; overload;
+function FindClass(const anUnitname, aClassName: string): TPersistentClass; overload;
+function GetClass(const aClassName: string): TPersistentClass; overload;
+function GetClass(const anUnitname, aClassName: string): TPersistentClass; overload;
 procedure StartClassGroup(AClass: TPersistentClass);
 procedure GroupDescendentsWith(AClass, AClassGroup: TPersistentClass);
 function ActivateClassGroup(AClass: TPersistentClass): TPersistentClass;

rtl/objpas/classes/cregist.inc

@@ -16,27 +16,24 @@
 { Class registration routines }
 
 procedure RegisterClass(AClass: TPersistentClass);
-var
-aClassname : String;
 begin
   //Classlist is created during initialization.
   with Classlist.Locklist do
-     try
+    try
       while Indexof(AClass) = -1 do
-         begin
-           aClassname := AClass.ClassName;
-           if GetClass(aClassName) <> nil then  //class alread registered!
-                 Begin
-                 //raise an error
-                 exit;
-                 end;
+        begin
+          if GetClass(AClass.Unitname,AClass.ClassName) <> nil then  //class alread registered!
+            Begin
+            //raise an error
+            exit;
+            end;
           Add(AClass);
           if AClass = TPersistent then break;
           AClass := TPersistentClass(AClass.ClassParent);
-         end;
-     finally
-       ClassList.UnlockList;
-     end;
+        end;
+    finally
+      ClassList.UnlockList;
+    end;
 end;
 
 
@@ -61,22 +58,38 @@ procedure RegisterClassAlias(AClass: TPersistentClass; const Alias: string);
 
 procedure RegisterClasses(AClasses: array of TPersistentClass);
 var
-I : Integer;
+  I : Integer;
 begin
-for I := low(aClasses) to high(aClasses) do
-       RegisterClass(aClasses[I]);
+  for I := low(aClasses) to high(aClasses) do
+    RegisterClass(aClasses[I]);
 end;
 
 
 procedure UnRegisterClass(AClass: TPersistentClass);
 
+var
+  i: Integer;
 begin
+  with ClassList.LockList do
+    try
+      Remove(AClass);
+      if Assigned(ClassAliasList) then
+        for i:=ClassAliasList.Count-1 downto 0 do
+          if TPersistentClass(ClassAliasList.Objects[i])=AClass then
+            ClassAliasList.Delete(i);
+    finally
+      ClassList.UnlockList;
+    end;
 end;
 
 
-procedure UnRegisterClasses(AClasses: array of TPersistentClass);
+procedure UnRegisterClasses(const AClasses: array of TPersistentClass);
 
+var
+  i: Integer;
 begin
+  for i:=Low(AClasses) to high(AClasses) do
+    UnRegisterClass(AClasses[i]);
 end;
 
 
@@ -84,43 +97,60 @@ procedure UnRegisterModuleClasses(Module: HMODULE);
 begin
 end;
 
-
 function FindClass(const AClassName: string): TPersistentClass;
 
 begin
-  Result := GetClass(AClassName);
-  if not Assigned(Result) then
-    raise EClassNotFound.CreateFmt(SClassNotFound, [AClassName]);
+  Result := FindClass('',AClassName);
 end;
 
+function FindClass(const anUnitname, aClassName: string): TPersistentClass;
+begin
+  Result := GetClass(anUnitname,aClassName);
+  if not Assigned(Result) then
+    if anUnitname<>'' then
+      raise EClassNotFound.CreateFmt(SClassNotFound, [anUnitname+'/'+AClassName])
+    else
+      raise EClassNotFound.CreateFmt(SClassNotFound, [AClassName]);
+end;
 
 function GetClass(const AClassName: string): TPersistentClass;
+begin
+  Result:=GetClass('',AClassName);
+end;
+
+function GetClass(const anUnitname, aClassName: string): TPersistentClass;
 var
-I : Integer;
+  I : Integer;
 begin
   with ClassList.LockList do
    try
-    for I := 0 to Count-1 do
+     for I := 0 to Count-1 do
        begin
-        Result := TPersistentClass(Items[I]);
-        if Result.ClassNameIs(AClassName) then Exit;
+         Result := TPersistentClass(Items[I]);
+         if not Result.ClassNameIs(AClassName) then
+           continue;
+         if (anUnitname='') or SameText(anUnitname,Result.UnitName) then
+           exit;
        end;
-    if Assigned(ClassAliasList) then
+     if Assigned(ClassAliasList) then
        begin
-       I := ClassAliasList.Indexof(AClassName);
+       I:=-1;
+       if anUnitname<>'' then
+         I := ClassAliasList.Indexof(anUnitname+'/'+AClassName);
+       if I<0 then
+         I := ClassAliasList.Indexof(AClassName);
        if I >= 0 then  //found
-          Begin
-          Result := TPersistentClass(ClassAliasList.Objects[i]);
-          exit;
-          end;
+         Begin
+         Result := TPersistentClass(ClassAliasList.Objects[i]);
+         exit;
+         end;
        end;
-       Result := nil;
+     Result := nil;
    finally
      ClassList.Unlocklist;
    end;
 end;
 
-
 procedure StartClassGroup(AClass: TPersistentClass);
 begin
 end;

rtl/objpas/classes/reader.inc

@@ -61,6 +61,13 @@ end;
 {$ENDIF}
 {$endif}
 
+procedure TAbstractObjectReader.BeginComponent(var Flags: TFilerFlags; var AChildPos: Integer;
+  var CompUnitName, CompClassName, CompName: String);
+begin
+  CompUnitName:='';
+  BeginComponent(Flags,AChildPos,CompClassName, CompName);
+end;
+
 function TBinaryObjectReader.ReadWord : word; {$ifdef CLASSESINLINE}inline;{$endif CLASSESINLINE}
 begin
   Read(Result,2);
@@ -151,10 +158,11 @@ begin
 end;
 
 procedure TBinaryObjectReader.BeginComponent(var Flags: TFilerFlags;
-  var AChildPos: Integer; var CompClassName, CompName: String);
+  var AChildPos: Integer; var CompUnitName, CompClassName, CompName: String);
 var
   Prefix: Byte;
   ValueType: TValueType;
+  p: SizeInt;
 begin
   { Every component can start with a special prefix: }
   Flags := [];
@@ -178,7 +186,20 @@ begin
     end;
   end;
 
-  CompClassName := ReadStr;
+  CompUnitName:='';
+  if Version = TBOVersion.boVersion1 then
+  begin
+    ValueType := ReadValue;
+    CompClassName := ReadString(ValueType);
+    p:=Pos(UnitnameSeparator,CompClassName);
+    if p>0 then
+    begin
+      CompUnitName:=copy(CompClassName,1,p-1);
+      System.Delete(CompClassName,1,p);
+    end;
+  end
+  else
+    CompClassName := ReadStr;
   CompName := ReadStr;
 end;
 
@@ -315,7 +336,11 @@ var
   Signature: LongInt;
 begin
   Read(Signature, 4);
-  if Signature <> LongInt(unaligned(FilerSignature)) then
+  if Signature = LongInt(unaligned(FilerSignature1)) then
+    FVersion:=TBOVersion.boVersion1
+  else if Signature = LongInt(unaligned(FilerSignature)) then
+    FVersion:=TBOVersion.boVersion0
+  else
     raise EReadError.Create(SInvalidImage);
 end;
 
@@ -392,11 +417,14 @@ procedure TBinaryObjectReader.SkipComponent(SkipComponentInfos: Boolean);
 var
   Flags: TFilerFlags;
   Dummy: Integer;
-  CompClassName, CompName: String;
+  CompUnitName, CompClassName, CompName: String;
 begin
   if SkipComponentInfos then
+  begin
     { Skip prefix, component class name and component object name }
-    BeginComponent(Flags, Dummy, CompClassName, CompName);
+    BeginComponent(Flags, Dummy, CompUnitName, CompClassName, CompName);
+    if (CompUnitName='') or (CompClassName='') or (CompName='') then ;
+  end;
 
   { Skip properties }
   while NextValue <> vaNull do
@@ -661,7 +689,7 @@ begin
     FDriver.ReadValue;
 end;
 
-procedure TReader.DefineProperty(const Name: String; AReadData: TReaderProc;
+procedure TReader.DefineProperty(const Name: string; AReadData: TReaderProc;
   WriteData: TWriterProc; HasData: Boolean);
 begin
   if Assigned(AReadData) and (UpperCase(Name) = UpperCase(FPropName)) then
@@ -671,8 +699,8 @@ begin
   end;
 end;
 
-procedure TReader.DefineBinaryProperty(const Name: String;
-  AReadData, WriteData: TStreamProc; HasData: Boolean);
+procedure TReader.DefineBinaryProperty(const Name: string; AReadData,
+  WriteData: TStreamProc; HasData: Boolean);
 var
   MemBuffer: TMemoryStream;
 begin
@@ -710,14 +738,15 @@ begin
   FLoaded := nil;
 end;
 
-function TReader.Error(const Message: String): Boolean;
+function TReader.Error(const Message: string): Boolean;
 begin
   Result := False;
   if Assigned(FOnError) then
     FOnError(Self, Message, Result);
 end;
 
-function TReader.FindMethod(ARoot: TComponent; const AMethodName: String): CodePointer;
+function TReader.FindMethod(ARoot: TComponent; const AMethodName: string
+  ): CodePointer;
 var
   ErrorResult: Boolean;
 begin
@@ -902,14 +931,14 @@ var
   end;
 
 var
-  CompClassName, Name: String;
+  CompUnitName, CompClassName, Name: String;
   n, ChildPos: Integer;
   SavedParent, SavedLookupRoot: TComponent;
   ComponentClass: TComponentClass;
   C, NewComponent: TComponent;
   SubComponents: TList;
 begin
-  FDriver.BeginComponent(Flags, ChildPos, CompClassName, Name);
+  FDriver.BeginComponent(Flags, ChildPos, CompUnitName, CompClassName, Name);
   SavedParent := Parent;
   SavedLookupRoot := FLookupRoot;
   SubComponents := nil;
@@ -930,7 +959,7 @@ begin
           begin
             if Assigned(FOnAncestorNotFound) then
               FOnAncestorNotFound(Self, Name,
-                FindComponentClass(Name,CompClassName), Result);
+                FindComponentClass(Name,CompUnitName,CompClassName), Result);
             if not Assigned(Result) then
               raise EReadError.CreateFmt(SAncestorNotFound, [Name]);
           end;
@@ -941,7 +970,7 @@ begin
         end else
         begin
           Result := nil;
-          ComponentClass := FindComponentClass(Name,CompClassName);
+          ComponentClass := FindComponentClass(Name,CompUnitName,CompClassName);
           if Assigned(FOnCreateComponent) then
             FOnCreateComponent(Self, ComponentClass, Result);
           if not Assigned(Result) then
@@ -1112,7 +1141,7 @@ begin
 end;
 {$endif}
 
-function TReader.ReadIdent: String;
+function TReader.ReadIdent: string;
 var
   ValueType: TValueType;
 begin
@@ -1124,7 +1153,7 @@ begin
 end;
 
 
-function TReader.ReadInteger: LongInt;
+function TReader.ReadInteger: Longint;
 begin
   case FDriver.ReadValue of
     vaInt8:
@@ -1169,7 +1198,7 @@ begin
   CheckValue(vaNull);
 end;
 
-function TReader.ReadVariant: variant;
+function TReader.ReadVariant: Variant;
 var
   nv: TValueType;
 begin
@@ -1177,7 +1206,7 @@ begin
   if not Assigned(VarClearProc) then
     raise EReadError.Create(SErrNoVariantSupport);
 
-  FillChar(Result,sizeof(Result),0);
+  Result:=default(variant);
 
   nv:=NextValue;
   case nv of
@@ -1470,18 +1499,18 @@ function TReader.ReadRootComponent(ARoot: TComponent): TComponent;
 var
   Dummy, i: Integer;
   Flags: TFilerFlags;
-  CompClassName, CompName, ResultName: String;
+  CompUnitName, CompClassName, CompName, ResultName: String;
 begin
   FDriver.BeginRootComponent;
   Result := nil;
   {!!!: GlobalNameSpace.BeginWrite;  // Loading from stream adds to name space
   try}
     try
-      FDriver.BeginComponent(Flags, Dummy, CompClassName, CompName);
+      FDriver.BeginComponent(Flags, Dummy, CompUnitName, CompClassName, CompName);
       if not Assigned(ARoot) then
       begin
         { Read the class name and the object name and create a new object: }
-        Result := TComponentClass(FindClass(CompClassName)).Create(nil);
+        Result := TComponentClass(FindClass(CompUnitName,CompClassName)).Create(nil);
         Result.Name := CompName;
       end else
       begin
@@ -1572,7 +1601,7 @@ begin
 end;
 
 
-function TReader.ReadString: String;
+function TReader.ReadString: string;
 var
   StringType: TValueType;
 begin
@@ -1725,7 +1754,8 @@ begin
   end;
 end;
 
-function TReader.FindComponentClass(const AName, AClassName: String): TComponentClass;
+function TReader.FindComponentClass(const AName, anUnitName, AClassName: string
+  ): TComponentClass;
 
 var
   PersistentClass: TPersistentClass;
@@ -1783,7 +1813,10 @@ var
           PersistenClass := ClassTable^.Entries[i]^;
           if PersistenClass.ClassNameIs(ShortClassName)
               and PersistenClass.InheritsFrom(TComponent) then
-            exit(TComponentClass(PersistenClass));
+            begin
+            if (anUnitName='') or SameText(PersistenClass.UnitName,anUnitName) then
+              exit(TComponentClass(PersistenClass));
+            end;
         end;
       end;
       // Try again with the parent class type
@@ -1801,8 +1834,14 @@ begin
   if (Result=nil) and assigned(LookupRoot) and (LookupRoot<>Root) then
     FindInFieldTable(LookupRoot);
 
+  if (Result=nil) and assigned(OnFindComponentClassEx) then
+    OnFindComponentClassEx(Self, anUnitName, AClassName, Result);
+
   if (Result=nil) then begin
-    PersistentClass := GetClass(AClassName);
+    if anUnitName<>'' then
+      PersistentClass := GetClass(anUnitName,AClassName)
+    else
+      PersistentClass := GetClass(AClassName);
     if PersistentClass.InheritsFrom(TComponent) then
       Result := TComponentClass(PersistentClass);
   end;
@@ -1811,7 +1850,10 @@ begin
     OnFindComponentClass(Self, AClassName, Result);
 
   if (Result=nil) or (not Result.InheritsFrom(TComponent)) then
-    raise EClassNotFound.CreateFmt(SNoFieldOfClassIn, [AClassName, Root.ClassName]);
+    if anUnitName<>'' then
+      raise EClassNotFound.CreateFmt(SNoFieldOfClassIn, [anUnitName+'/'+AClassName, Root.ClassName])
+    else
+      raise EClassNotFound.CreateFmt(SNoFieldOfClassIn, [AClassName, Root.ClassName]);
 end;
 
 

rtl/objpas/classes/streams.inc

@@ -219,7 +219,7 @@ end;
       Discard(Offset);
    end;
 
- function TStream.Seek(const Offset: Int64; Origin: TSeekorigin): Int64;
+  function TStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
 
     begin
       // Backwards compatibility that calls the longint Seek
@@ -244,7 +244,8 @@ end;
    Result:=Read(Buffer,sizeOf(Buffer));
  end;
 
-function TStream.ReadMaxSizeData(Var Buffer; aSize,aCount : NativeInt) : NativeInt;
+function TStream.ReadMaxSizeData(var Buffer; aSize, aCount: NativeInt
+  ): NativeInt;
 
 Var
   CP : Int64;
@@ -260,7 +261,8 @@ begin
     end
 end;
 
-function TStream.WriteMaxSizeData(Const Buffer; aSize,aCount : NativeInt) : NativeInt;
+function TStream.WriteMaxSizeData(const Buffer; aSize, aCount: NativeInt
+  ): NativeInt;
 Var
   CP : Int64;
 
@@ -1031,6 +1033,12 @@ end;
 
     end;
 
+  procedure TStream.WriteComponent(Instance: TComponent; aWriteUnitname: boolean
+    );
+    begin
+      WriteDescendent(Instance, nil, aWriteUnitname);
+    end;
+
   procedure TStream.WriteComponentRes(const ResName: string; Instance: TComponent);
 
     begin
@@ -1039,16 +1047,33 @@ end;
 
     end;
 
+  procedure TStream.WriteComponentRes(const ResName: string;
+    Instance: TComponent; aWriteUnitname: boolean);
+
+  begin
+    WriteDescendentRes(ResName, Instance, nil, aWriteUnitname);
+  end;
+
   procedure TStream.WriteDescendent(Instance, Ancestor: TComponent);
 
+    begin
+      WriteDescendent(Instance,Ancestor,DefaultWriteUnitname);
+    end;
+
+  procedure TStream.WriteDescendent(Instance, Ancestor: TComponent;
+    aWriteUnitname: boolean);
+
     var
-       Driver : TAbstractObjectWriter;
+       Driver : TBinaryObjectWriter;
        Writer : TWriter;
 
     begin
-
        Driver := TBinaryObjectWriter.Create(Self, 4096);
        Try
+         if aWriteUnitname then
+           Driver.Version:=TBinaryObjectReader.TBOVersion.boVersion1
+         else
+           Driver.Version:=TBinaryObjectReader.TBOVersion.boVersion0;
          Writer := TWriter.Create(Driver);
          Try
            Writer.WriteDescendent(Instance, Ancestor);
@@ -1058,11 +1083,17 @@ end;
        Finally
          Driver.Free;
        end;
-
     end;
 
   procedure TStream.WriteDescendentRes(const ResName: string; Instance, Ancestor: TComponent);
 
+    begin
+      WriteDescendentRes(ResName,Instance,Ancestor,DefaultWriteUnitname);
+    end;
+
+  procedure TStream.WriteDescendentRes(const ResName: string; Instance,
+    Ancestor: TComponent; aWriteUnitname: boolean);
+
     var
       FixupInfo: Longint;
 
@@ -1071,7 +1102,7 @@ end;
       { Write a resource header }
       WriteResourceHeader(ResName, FixupInfo);
       { Write the instance itself }
-      WriteDescendent(Instance, Ancestor);
+      WriteDescendent(Instance, Ancestor,aWriteUnitname);
       { Insert the correct resource size into the resource header }
       FixupResourceHeader(FixupInfo);
 
@@ -1187,7 +1218,7 @@ end;
 
     end;
 
-  Function TStream.ReadAnsiString : String;
+    function TStream.ReadAnsiString: String;
 
   Var
     TheSize : Longint;
@@ -1205,7 +1236,7 @@ end;
      end;
    end;
 
-  Procedure TStream.WriteAnsiString (const S : String);
+    procedure TStream.WriteAnsiString(const S: String);
 
   Var L : Longint;
 

rtl/objpas/classes/writer.inc

@@ -121,7 +121,7 @@ end;
 procedure TBinaryObjectWriter.WriteSignature;
 
 begin
-  if Version=bowVersion1 then
+  if Version=TBinaryObjectReader.TBOVersion.boVersion1 then
     Write(FilerSignature1, SizeOf(FilerSignature1))
   else
     Write(FilerSignature, SizeOf(FilerSignature));
@@ -142,10 +142,10 @@ begin
       WriteInteger(ChildPos);
   end;
 
-  if Version=bowVersion0 then
-    WriteStr(Component.ClassName)
+  if Version=TBinaryObjectReader.TBOVersion.boVersion1 then
+    WriteString(Component.UnitName+TBinaryObjectReader.UnitnameSeparator+Component.ClassName)
   else
-    WriteString(Component.UnitName+UnitnameSeparator+Component.ClassName);
+    WriteStr(Component.ClassName);
   WriteStr(Component.Name);
 end;