* Implemented streaming. Note: The writer driver interface is stable, but

  the reader interface is not final yet!

fcl/inc/classes.inc

@@ -39,16 +39,6 @@
 { TBits implementation }
 {$i bits.inc}
 
-{ TReader implementation }
-{ $i reader.inc}
-
-{ TWriter implementations }
-{$i writer.inc}
-{$i twriter.inc}
-
-{ TFiler implementation }
-{$i filer.inc}
-
 { All streams implementations: }
 { Tstreams THandleStream TFileStream TResourcseStreams TStringStream }
 { TCustomMemoryStream TMemoryStream }
@@ -138,44 +128,200 @@ end;
 
 { Object filing routines }
 
-procedure RegisterIntegerConsts(IntegerType: Pointer; IdentToInt: TIdentToInt;
-  IntToIdent: TIntToIdent);
+var
+  IntConstList: TThreadList;
+
+
+// !!!: INSERTION START, only slightly modified until now
+
+type
+  TIntConst = class
+    IntegerType: PTypeInfo;
+    IdentToIntFn: TIdentToInt;
+    IntToIdentFn: TIntToIdent;
+    constructor Create(AIntegerType: PTypeInfo; AIdentToInt: TIdentToInt;
+      AIntToIdent: TIntToIdent);
+  end;
 
+constructor TIntConst.Create(AIntegerType: PTypeInfo; AIdentToInt: TIdentToInt;
+  AIntToIdent: TIntToIdent);
 begin
+  IntegerType := AIntegerType;
+  IdentToIntFn := AIdentToInt;
+  IntToIdentFn := AIntToIdent;
 end;
 
+procedure RegisterIntegerConsts(IntegerType: Pointer; IdentToIntFn: TIdentToInt;
+  IntToIdentFn: TIntToIdent);
+begin
+  IntConstList.Add(TIntConst.Create(IntegerType, IdentToIntFn, IntToIdentFn));
+end;
 
-function IdentToInt(const Ident: string; var Int: Longint; const Map: array of TIdentMapEntry): Boolean;
+function FindIntToIdent(AIntegerType: Pointer): TIntToIdent;
+var
+  I: Integer;
+begin
+  Result := nil;
+  with IntConstList.LockList do
+  try
+    for I := 0 to Count - 1 do
+      with TIntConst(Items[I]) do
+        if AIntegerType = IntegerType then
+        begin
+          Result := IntToIdentFn;
+          Exit;
+        end;
+  finally
+    IntConstList.UnlockList;
+  end;
+end;
 
+function FindIdentToInt(AIntegerType: Pointer): TIdentToInt;
+var
+  I: Integer;
 begin
-  IdentToInt:=false;
+  Result := nil;
+  with IntConstList.LockList do
+  try
+    for I := 0 to Count - 1 do
+      with TIntConst(Items[I]) do
+        if AIntegerType = IntegerType then
+        begin
+          Result := IdentToIntFn;
+          Exit;
+        end;
+  finally
+    IntConstList.UnlockList;
+  end;
 end;
 
+function IdentToInt(const Ident: string; var Int: Longint; const Map: array of TIdentMapEntry): Boolean;
+var
+  I: Integer;
+begin
+  for I := Low(Map) to High(Map) do
+    if UpperCase(Map[I].Name) = UpperCase(Ident) then
+    begin
+      Result := True;
+      Int := Map[I].Value;
+      Exit;
+    end;
+  Result := False;
+end;
 
 function IntToIdent(Int: Longint; var Ident: string; const Map: array of TIdentMapEntry): Boolean;
+var
+  I: Integer;
+begin
+  for I := Low(Map) to High(Map) do
+    if Map[I].Value = Int then
+    begin
+      Result := True;
+      Ident := Map[I].Name;
+      Exit;
+    end;
+  Result := False;
+end;
+
+// !!!: INSERTION END
+
+
+// !!!: INSERTION START
+
+{ TPropFixup }
+
+type
+  TPropFixup = class
+    FInstance: TPersistent;
+    FInstanceRoot: TComponent;
+    FPropInfo: PPropInfo;
+    FRootName: string;
+    FName: string;
+    constructor Create(Instance: TPersistent; InstanceRoot: TComponent;
+      PropInfo: PPropInfo; const RootName, Name: string);
+    function MakeGlobalReference: Boolean;
+  end;
+
+var
+  GlobalFixupList: TThreadList;
 
+constructor TPropFixup.Create(Instance: TPersistent; InstanceRoot: TComponent;
+  PropInfo: PPropInfo; const RootName, Name: string);
 begin
-  IntToIdent:=false;
+  FInstance := Instance;
+  FInstanceRoot := InstanceRoot;
+  FPropInfo := PropInfo;
+  FRootName := RootName;
+  FName := Name;
 end;
 
+function TPropFixup.MakeGlobalReference: Boolean;
+var
+  S: PChar;
+  P: PChar;
+begin
+  Result := False;
+  S := PChar(Pointer(FName));
+  P := S;
+  while not (P^ in ['.', #0]) do Inc(P);
+  if P^ = #0 then Exit;
+  SetString(FRootName, S, P - S);
+  Delete(FName, 1, P - S + 1);
+  Result := True;
+end;
+
+// !!!: INSERTION END
+
 
 function InitInheritedComponent(Instance: TComponent; RootAncestor: TClass): Boolean;
 
+  function DoInitClass(ClassType: TClass): Boolean;
+  begin
+    Result := False;
+    if (ClassType <> TComponent) and (ClassType <> RootAncestor) then
+    begin
+      { Init the parent class first }
+      Result := DoInitClass(ClassType.ClassParent);
+
+      { !!!: Too Win32-specific in VCL:
+      Result := InternalReadComponentRes(ClassType.ClassName, FindResourceHInstance(
+        FindClassHInstance(ClassType)), Instance) or Result;}
+      Result := False;
+    end;
+  end;
+
 begin
-  InitInheritedComponent:=false;
+  {!!!: GlobalNameSpace.BeginWrite;
+  try}
+    if (Instance.ComponentState * [csLoading, csInline]) = [] then
+    begin
+      BeginGlobalLoading;
+      try
+        Result := DoInitClass(Instance.ClassType);
+        NotifyGlobalLoading;
+      finally
+        EndGlobalLoading;
+      end;
+    end else
+      Result := DoInitClass(Instance.ClassType);
+  {finally
+    GlobalNameSpace.EndWrite;
+  end;}
 end;
 
 
 function InitComponentRes(const ResName: string; Instance: TComponent): Boolean;
 
 begin
-  InitComponentRes:=false;
+  { !!!: Too Win32-specific in VCL }
+  InitComponentRes:=False;
 end;
 
 
 function ReadComponentRes(const ResName: string; Instance: TComponent): TComponent;
 
 begin
+  { !!!: Too Win32-specific in VCL }
   ReadComponentRes:=nil;
 end;
 
@@ -183,82 +329,334 @@ end;
 function ReadComponentResEx(HInstance: THandle; const ResName: string): TComponent;
 
 begin
+  { !!!: Too Win32-specific in VCL }
   ReadComponentResEx:=nil;
 end;
 
 
 function ReadComponentResFile(const FileName: string; Instance: TComponent): TComponent;
-
+var
+  FileStream: TStream;
 begin
-  ReadComponentResFile:=nil;
+  FileStream := TFileStream.Create(FileName, fmOpenRead {!!!:or fmShareDenyWrite});
+  try
+    Result := FileStream.ReadComponentRes(Instance);
+  finally
+    FileStream.Free;
+  end;
 end;
 
 
 procedure WriteComponentResFile(const FileName: string; Instance: TComponent);
-
+var
+  FileStream: TStream;
 begin
+  FileStream := TFileStream.Create(FileName, fmCreate);
+  try
+    FileStream.WriteComponentRes(Instance.ClassName, Instance);
+  finally
+    FileStream.Free;
+  end;
 end;
 
 
-
+// !!!: INSERTION START
 procedure GlobalFixupReferences;
+var
+  FinishedList: TList;
+  NotFinishedList: TList;
+  GlobalList: TList;
+  I: Integer;
+  Root: TComponent;
+  Instance: TPersistent;
+  Reference: Pointer;
+
+  procedure AddFinished(Instance: TPersistent);
+  begin
+    if (FinishedList.IndexOf(Instance) < 0) and
+      (NotFinishedList.IndexOf(Instance) >= 0) then
+      FinishedList.Add(Instance);
+  end;
+
+  procedure AddNotFinished(Instance: TPersistent);
+  var
+    Index: Integer;
+  begin
+    Index := FinishedList.IndexOf(Instance);
+    if Index <> -1 then FinishedList.Delete(Index);
+    if NotFinishedList.IndexOf(Instance) < 0 then
+      NotFinishedList.Add(Instance);
+  end;
+
+begin
+  if Assigned(FindGlobalComponent) then
+  begin
+    // Fixup resolution requires a stable component / name space
+    // Block construction and destruction of forms / datamodules during fixups
+    {!!!: GlobalNameSpace.BeginWrite;
+    try}
+      GlobalList := GlobalFixupList.LockList;
+      try
+        if GlobalList.Count > 0 then
+        begin
+          FinishedList := TList.Create;
+          try
+            NotFinishedList := TList.Create;
+            try
+              I := 0;
+              while I < GlobalList.Count do
+                with TPropFixup(GlobalList[I]) do
+                begin
+                  Root := FindGlobalComponent(FRootName);
+                  if (Root <> nil) or (GetOrdProp(FInstance, FPropInfo) <> 0) then
+                  begin
+                    if Root <> nil then
+                    begin
+                      Reference := FindNestedComponent(Root, FName);
+                      SetOrdProp(FInstance, FPropInfo, Longint(Reference));
+                    end;
+                    AddFinished(FInstance);
+                    GlobalList.Delete(I);
+                    Free;
+                  end else
+                  begin
+                    AddNotFinished(FInstance);
+                    Inc(I);
+                  end;
+                end;
+            finally
+              NotFinishedList.Free;
+            end;
+            for I := 0 to FinishedList.Count - 1 do
+            begin
+              Instance := TPersistent(FinishedList[I]);
+              if Instance is TComponent then
+                Exclude(TComponent(Instance).FComponentState, csFixups);
+            end;
+          finally
+            FinishedList.Free;
+          end;
+        end;
+      finally
+        GlobalFixupList.UnlockList;
+      end;
+    {finally
+      GlobalNameSpace.EndWrite;
+    end;}
+  end;
+end;
+
+// !!!: INSERTION END
 
+
+// !!!: Rename this function
+function NameInStrings(Strings: TStrings; const Name: String): Boolean;
+var
+  n: String;
+  I: Integer;
 begin
+  n := UpperCase(Name);
+  for i := 0 to Strings.Count - 1 do
+    if UpperCase(Strings[i]) = n then
+    begin
+      Result := True;
+      exit;
+    end;
+  Result := False;
 end;
 
 
 procedure GetFixupReferenceNames(Root: TComponent; Names: TStrings);
-
+var
+  i: Integer;
+  CurFixup: TPropFixup;
 begin
+  with GlobalFixupList.LockList do
+    try
+      for i := 0 to Count - 1 do
+      begin
+        CurFixup := TPropFixup(Items[i]);
+        if ((not Assigned(Root)) or (CurFixup.FInstanceRoot = Root)) and
+          not NameInStrings(Names, CurFixup.FRootName) then
+          Names.Add(CurFixup.FRootName);
+      end;
+    finally
+      GlobalFixupList.UnlockList;
+    end;
 end;
 
 
 procedure GetFixupInstanceNames(Root: TComponent;
   const ReferenceRootName: string; Names: TStrings);
-
+var
+  i: Integer;
+  CurFixup: TPropFixup;
 begin
+  with GlobalFixupList.LockList do
+    try
+      for i := 0 to Count - 1 do
+      begin
+        CurFixup := TPropFixup(Items[i]);
+        if (CurFixup.FInstanceRoot = Root) and
+          (UpperCase(ReferenceRootName) = UpperCase(CurFixup.FRootName)) and
+          not NameInStrings(Names, CurFixup.FName) then
+          Names.Add(CurFixup.FName);
+      end;
+    finally
+      GlobalFixupList.UnlockList;
+    end;
 end;
 
 
 procedure RedirectFixupReferences(Root: TComponent; const OldRootName,
   NewRootName: string);
-
+var
+  i: Integer;
+  CurFixup: TPropFixup;
 begin
+  with GlobalFixupList.LockList do
+    try
+      for i := 0 to Count - 1 do
+      begin
+        CurFixup := TPropFixup(Items[i]);
+        if ((not Assigned(Root)) or (CurFixup.FInstanceRoot = Root)) and
+          (UpperCase(OldRootName) = UpperCase(CurFixup.FRootName)) then
+          CurFixup.FRootName := NewRootName;
+      end;
+      GlobalFixupReferences;
+    finally
+      GlobalFixupList.Unlocklist;
+    end;
 end;
 
 
 procedure RemoveFixupReferences(Root: TComponent; const RootName: string);
-
+var
+  i: Integer;
+  CurFixup: TPropFixup;
 begin
+  if Assigned(GlobalFixupList) then
+    with GlobalFixupList.LockList do
+      try
+        for i := Count - 1 downto 0 do
+        begin
+          CurFixup := TPropFixup(Items[i]);
+          if ((not Assigned(Root)) or (CurFixup.FInstanceRoot = Root)) and
+            ((Length(RootName) = 0) or
+	    (UpperCase(RootName) = UpperCase(CurFixup.FRootName))) then
+          begin
+            Delete(i);
+            CurFixup.Free;
+          end;
+        end;
+      finally
+        GlobalFixupList.UnlockList;
+      end;
 end;
 
 
 procedure RemoveFixups(Instance: TPersistent);
+var
+  i: Integer;
+  CurFixup: TPropFixup;
+begin
+  if Assigned(GlobalFixupList) then
+    with GlobalFixupList.LockList do
+      try
+        for i := Count - 1 downto 0 do
+        begin
+          CurFixup := TPropFixup(Items[i]);
+          if (CurFixup.FInstance = Instance) then
+          begin
+            Delete(i);
+            CurFixup.Free;
+          end;
+        end;
+      finally
+        GlobalFixupList.UnlockList;
+      end;
+end;
 
+
+function FindNestedComponent(Root: TComponent; const NamePath: string): TComponent;
+var
+  Current, Found: TComponent;
+  s, p: PChar;
+  Name: String;
 begin
+  Result := nil;
+  if Length(NamePath) > 0 then
+  begin
+    Current := Root;
+    p := PChar(NamePath);
+    while p[0] <> #0 do
+    begin
+      s := p;
+      while not (p^ in ['.', '-', #0]) do
+        Inc(p);
+      SetString(Name, s, p - s);
+      Found := Current.FindComponent(Name);
+      if (not Assigned(Found)) and (UpperCase(Name) = 'OWNER') then
+        Found := Current;
+      if not Assigned(Found) then exit;
+
+      // Remove the dereference operator from the name
+      if p[0] = '.' then
+        Inc(P);
+      if p[0] = '-' then
+        Inc(P);
+      if p[0] = '>' then
+        Inc(P);
+
+      Current := Found;
+    end;
+  end;
+  Result := Current;
 end;
 
+{!!!: threadvar block copied from VCL}
+{threadvar  -  doesn't work for all platforms yet!}
+var
+  GlobalLoaded: TList;
+  GlobalLists: TList;
 
 
 procedure BeginGlobalLoading;
 
 begin
+  if not Assigned(GlobalLists) then
+    GlobalLists := TList.Create;
+  GlobalLists.Add(GlobalLoaded);
+  GlobalLoaded := TList.Create;
 end;
 
 
 procedure NotifyGlobalLoading;
-
+var
+  List: TList;
+  i: Integer;
 begin
+  List := GlobalLoaded;
+  { Notify all global components that they have been loaded completely }
+  for i := 0 to List.Count - 1 do
+    TComponent(List[i]).Loaded;
 end;
 
 
 procedure EndGlobalLoading;
-
 begin
+  { Free the memory occupied by BeginGlobalLoading }
+  GlobalLoaded.Free;
+  GlobalLoaded := TList(GlobalLists.Last);
+  GlobalLists.Delete(GlobalLists.Count - 1);
+  if GlobalLists.Count = 0 then
+  begin
+    GlobalLists.Free;
+    GlobalLists := nil;
+  end;
 end;
 
 
-
 function CollectionsEqual(C1, C2: TCollection): Boolean;
 
 begin
@@ -750,12 +1148,57 @@ begin
   end;
 end;
 
+procedure CommonInit;
+begin
+  IntConstList := TThreadList.Create;
+  GlobalFixupList := TThreadList.Create;
+  ClassList := TThreadList.Create;
+  ClassAliasList := TStringList.Create;
+end;
+
+procedure CommonCleanup;
+var
+  i: Integer;
+begin
+  // !!!: GlobalNameSpace.BeginWrite;
+  with IntConstList.LockList do
+    try
+      for i := 0 to Count - 1 do
+        TIntConst(Items[I]).Free;
+    finally
+      IntConstList.UnlockList;
+    end;
+    IntConstList.Free;
+  ClassList.Free;
+  ClassAliasList.Free;
+  RemoveFixupReferences(nil, '');
+  GlobalFixupList.Free;
+  GlobalFixupList := nil;
+  GlobalLists.Free;
+  {!!!: GlobalNameSpace.Free;
+  GlobalNameSpace := nil;}
+end;
 
 
 
+{ TFiler implementation }
+{$i filer.inc}
+
+{ TReader implementation }
+{$i reader.inc}
+
+{ TWriter implementations }
+{$i writer.inc}
+{$i twriter.inc}
+
+
 {
   $Log$
-  Revision 1.16  2000-01-07 01:24:33  peter
+  Revision 1.17  2000-06-29 16:29:23  sg
+  * Implemented streaming. Note: The writer driver interface is stable, but
+    the reader interface is not final yet!
+
+  Revision 1.16  2000/01/07 01:24:33  peter
     * updated copyright to 2000
 
   Revision 1.15  2000/01/06 01:20:32  peter
@@ -775,11 +1218,4 @@ end;
 
   Revision 1.11  1999/09/11 21:59:31  fcl
   * Moved class and registration functions to cregist.inc  (sg)
-
-  Revision 1.10  1999/04/13 08:52:29  michael
-  + Moved strings.inc to stringl.inc, to avoid conflict with strings unit
-
-  Revision 1.9  1999/04/08 10:18:50  peter
-    * makefile updates
-
 }

fcl/inc/classesh.inc

@@ -123,10 +123,6 @@ type
 { Forward class declarations }
 
   TStream = class;
-  TAbstractFiler = Class;
-  TAbstractWriter = Class;
-  TAbstractReader = Class;
-
   TFiler = class;
   TReader = class;
   TWriter = class;
@@ -476,6 +472,8 @@ type
     procedure WriteComponentRes(const ResName: string; Instance: TComponent);
     procedure WriteDescendent(Instance, Ancestor: TComponent);
     procedure WriteDescendentRes(const ResName: string; Instance, Ancestor: TComponent);
+    procedure WriteResourceHeader(const ResName: string; {!!!:out} var FixupInfo: Integer);
+    procedure FixupResourceHeader(FixupInfo: Integer);
     procedure ReadResHeader;
     function ReadByte : Byte;
     function ReadWord : Word;
@@ -609,289 +607,114 @@ type
     function Clone(out stm: IStream): HResult; stdcall;
   end;
 }
+
 { TFiler }
 
   TValueType = (vaNull, vaList, vaInt8, vaInt16, vaInt32, vaExtended,
     vaString, vaIdent, vaFalse, vaTrue, vaBinary, vaSet, vaLString,
-    vaNil, vaCollection);
+    vaNil, vaCollection, vaSingle, vaCurrency, vaDate, vaWString, vaInt64);
 
-  TFilerFlag = (ffInherited, ffChildPos);
+  TFilerFlag = (ffInherited, ffChildPos, ffInline);
   TFilerFlags = set of TFilerFlag;
 
-(*
   TReaderProc = procedure(Reader: TReader) of object;
   TWriterProc = procedure(Writer: TWriter) of object;
   TStreamProc = procedure(Stream: TStream) of object;
-*)
-
-  TReaderProc = procedure(Reader: TAbstractReader) of object;
-  TWriterProc = procedure(Writer: TAbstractWriter) of object;
-  TStreamProc = procedure(Stream: TStream) of object;
 
-  TAbstractFiler = class(TObject)
+  TFiler = class(TObject)
   private
     FRoot: TComponent;
+    FLookupRoot: TComponent;
     FAncestor: TPersistent;
-     FIgnoreChildren: Boolean;
-     FPrefix : String;
-   public
+    FIgnoreChildren: Boolean;
+  protected
+    procedure SetRoot(ARoot: TComponent); virtual;
+  public
     procedure DefineProperty(const Name: string;
       ReadData: TReaderProc; WriteData: TWriterProc;
       HasData: Boolean); virtual; abstract;
     procedure DefineBinaryProperty(const Name: string;
       ReadData, WriteData: TStreamProc;
       HasData: Boolean); virtual; abstract;
-    property Root: TComponent read FRoot write FRoot;
+    property Root: TComponent read FRoot write SetRoot;
+    property LookupRoot: TComponent read FLookupRoot;
     property Ancestor: TPersistent read FAncestor write FAncestor;
     property IgnoreChildren: Boolean read FIgnoreChildren write FIgnoreChildren;
   end;
 
-{ TReader }
-
-  TFindMethodEvent = procedure(Reader: TReader; const MethodName: string;
-    var Address: Pointer; var Error: Boolean) of object;
-  TSetNameEvent = procedure(Reader: TReader; Component: TComponent;
-    var Name: string) of object;
-  TReferenceNameEvent = procedure(Reader: TReader; var Name: string) of object;
-  TAncestorNotFoundEvent = procedure(Reader: TReader; const ComponentName: string;
-    ComponentClass: TPersistentClass; var Component: TComponent) of object;
-  TReadComponentsProc = procedure(Component: TComponent) of object;
-  TReaderError = procedure(Reader: TReader; const Message: string; var Handled: Boolean) of object;
-
 
-  TAbstractReader = class(TAbstractFiler);
-(*  private
-  protected
-    function Error(const Message: string): Boolean; virtual;
-    function FindMethod(ARoot: TComponent; const AMethodName: string): Pointer; virtual;
-    procedure SetName(Component: TComponent; var Name: string); virtual;
-    procedure ReferenceName(var Name: string); virtual;
-    function FindAncestorComponent(const Name: string;
-                                   ComponentClass: TPersistentClass): TComponent; virtual;
-  public
-    destructor Destroy; override;
-    procedure BeginReferences;
-    procedure DefineProperty(const Name: string;
-      rd : TReaderProc; wd : TWriterProc;
-      HasData: Boolean); override;
-    procedure DefineBinaryProperty(const Name: string;
-      rd, wd: TStreamProc;
-      HasData: Boolean); override;
-    function EndOfList: Boolean;
-    procedure EndReferences;
-    procedure FixupReferences;
-    procedure FlushBuffer; override;
-    function NextValue: TValueType;
-    procedure ReadPrefix(var Flags: TFilerFlags; var AChildPos: Integer);
-    procedure ReadCollection(Collection: TCollection);
-    function ReadComponent(Component: TComponent): TComponent;
-    procedure ReadComponents(AOwner, AParent: TComponent;
-      Proc: TReadComponentsProc);
-    function ReadRootComponent(ARoot: TComponent): TComponent;
-    { Abstract methods }
-    procedure ReadSignature;
-    function ReadBoolean: Boolean; abstract;
-    function ReadChar: Char; abstract;
-    function ReadFloat: Extended;
-    function ReadIdent: string;
-    function ReadInteger: Longint;
-    procedure ReadListBegin;
-    procedure ReadListEnd;
-    function ReadStr: string;
-    function ReadString: string;
-    function ReadValue: TValueType;
-    procedure CopyValue(Writer: TWriter);
-    {!!!}
-    property Owner: TComponent read FOwner write FOwner;
-    property Parent: TComponent read FParent write FParent;
-    property Position: Longint read GetPosition write SetPosition;
-    property OnError: TReaderError read FOnError write FOnError;
-    property OnFindMethod: TFindMethodEvent read FOnFindMethod write FOnFindMethod;
-    property OnSetName: TSetNameEvent read FOnSetName write FOnSetName;
-    property OnReferenceName: TReferenceNameEvent read FOnReferenceName write FOnReferenceName;
-    property OnAncestorNotFound: TAncestorNotFoundEvent read FOnAncestorNotFound write FOnAncestorNotFound;
-  end;
-*)
+{ TComponent class reference type }
 
-{ TAbstractWriter }
+  TComponentClass = class of TComponent;
 
-  TAbstractWriter = class(TAbstractFiler)
-  private
-    FRootAncestor: TComponent;
-    FPropPath: string;
-    FAncestorList: TList;
-    FAncestorPos: Integer;
-    FChildPos: Integer;
-    procedure AddAncestor(Component: TComponent);
-    procedure WriteData(Instance: TComponent); // linker optimization
-    procedure WriteProperty(Instance: TPersistent; PropInfo: Pointer);
-    procedure WriteProperties(Instance: TPersistent);
-    Procedure DoOrdinalProp(Instance : TPersistent;Propinfo :PPropInfo);
-    Procedure DoStringProp(Instance : TPersistent;Propinfo :PPropInfo);
-    Procedure DoFloatProp(Instance : TPersistent;Propinfo :PPropInfo);
-    Procedure DoCollectionProp(Name: ShortString; Value : TCollection);
-    Procedure DoClassProp(Instance : TPersistent;Propinfo :PPropInfo);
-    Procedure DoMethodProp(Instance : TPersistent;Propinfo :PPropInfo);
-  protected
-    procedure WritePrefix(Flags: TFilerFlags; AChildPos: Integer);Virtual;Abstract;
-    Procedure StartObject(Const AClassName,AName : String);Virtual;abstract;
-    Procedure EndObject;Virtual;Abstract;
-    Procedure StartCollection(Const Name : String);Virtual;abstract;
-    Procedure EndCollection;Virtual;Abstract;
-    Procedure StartCollectionItem;Virtual;abstract;
-    Procedure EndCollectionItem;Virtual;Abstract;
-  public
-    destructor Destroy; override;
-    procedure DefineProperty(const Name: string;
-      rd : TReaderProc; wd : TWriterProc;
-      HasData: Boolean); override;
-    procedure DefineBinaryProperty(const Name: string;
-      rd, wd: TStreamProc;
-      HasData: Boolean); override;
-    procedure WriteDescendent(ARoot: TComponent; AAncestor: TComponent);
-    procedure WriteRootComponent(ARoot: TComponent);
-    procedure WriteComponent(Component: TComponent);virtual;
-    { Abstract }
-    Procedure WriteIntegerProperty(Const Name : Shortstring;Value : Longint);virtual;abstract;
-    Procedure WriteSetProperty (Const Name : ShortString;Value : longint; BaseType : TTypeInfo);virtual;abstract;
-    Procedure WriteEnumerationProperty (Const Name : ShortString;Value : Longint; Const EnumName : ShortSTring);virtual;abstract;
-    Procedure WriteStringProperty(Const Name : ShortString; Const Value : String);virtual;abstract;
-    Procedure WriteFloatProperty(Const Name : ShortString; Value : Extended);virtual;abstract;
-    Procedure WriteCollectionProperty(Const Name : ShortString;Value : TCollection);virtual;abstract;
-    Procedure WriteClassProperty(Instance : TPersistent;Propinfo :PPropInfo);virtual;abstract;
-    Procedure WriteComponentProperty(Const Name : ShortString;Value : TComponent);virtual;abstract;
-    Procedure WriteNilProperty(Const Name : Shortstring);virtual; abstract;
-    Procedure WriteMethodProperty(Const Name,AMethodName : ShortString);virtual;abstract;
-    Procedure WriteBinaryProperty(Const Name; Value : TStream);Virtual;Abstract;
-(*
-    { Abstract compatibility methods}
-    Procedure WriteValue(Value : TValueType);virtual;abstract;
-    procedure Write(const Buf; Count: Longint);virtual;abstract;
-    procedure WriteBoolean(Value: Boolean);virtual;abstract;
-    procedure WriteCollection(Value: TCollection);virtual;abstract;
-    procedure WriteComponent(Component: TComponent);virtual;abstract;
-    procedure WriteChar(Value: Char);virtual;abstract;
-    procedure WriteFloat(Value: Extended);virtual;abstract;
-    procedure WriteIdent(const Ident: string);virtual;abstract;
-    procedure WriteInteger(Value: Longint);virtual;abstract;
-    procedure WriteListBegin;virtual;abstract;
-    procedure WriteListEnd;virtual;abstract;
-    procedure WriteSignature;virtual;abstract;
-    procedure WriteStr(const Value: string);virtual;abstract;
-    procedure WriteString(const Value: string);virtual;abstract;
-*)
-    property RootAncestor: TComponent read FRootAncestor write FRootAncestor;
-  end;
 
-  TWriter = class(TAbstractWriter)
-  Private
-    FStream : TStream;
-    function GetPosition: Longint;
-    procedure SetPosition(Value: Longint);
-    procedure WritePropName(const PropName: string);
-  protected
-    procedure WriteBinary(wd : TStreamProc);
-  public
-    Constructor Create(S : TStream);
-    destructor Destroy; override;
-    { Compatibility }
-    procedure WriteBuffer;
-    Procedure FlushBuffer;
-    { Abstract }
-    Procedure WriteIntegerProperty(Const Name : Shortstring;Value : Longint);override;
-    Procedure WriteSetProperty (Const Name : ShortString;Value : longint; BaseType : TTypeInfo);override;
-    Procedure WriteEnumerationProperty (Const Name : ShortString;Value : Longint; Const EnumName : ShortSTring);override;
-    Procedure WriteStringProperty(Const Name : ShortString; Const Value : String);override;
-    Procedure WriteFloatProperty(Const Name : ShortString; Value : Extended);override;
-    Procedure WriteCollectionProperty(Const Name : ShortString;Value : TCollection);override;
-    Procedure WriteClassProperty(Instance : TPersistent;Propinfo :PPropInfo);override;
-    Procedure WriteComponentProperty(Const Name : ShortSTring; Value : TComponent);override;
-    Procedure WriteNilProperty(Const Name : Shortstring);override;
-    Procedure WriteMethodProperty(Const Name,AMethodName : ShortString);override;
-    { Abstract compatibility methods}
-    procedure WritePrefix(Flags: TFilerFlags; AChildPos: Integer); virtual;
-    Procedure WriteValue(Value : TValueType);virtual;
-    procedure Write(const Buf; Count: Longint);virtual;
-    procedure WriteBoolean(Value: Boolean);virtual;
-    procedure WriteCollection(Value: TCollection);virtual;
-    procedure WriteChar(Value: Char);virtual;
-    procedure WriteFloat(Value: Extended);virtual;
-    procedure WriteIdent(const Ident: string);virtual;
-    procedure WriteInteger(Value: Longint);virtual;
-    procedure WriteListBegin;virtual;
-    procedure WriteListEnd;virtual;
-    procedure WriteSignature;virtual;
-    procedure WriteStr(const Value: string);virtual;
-    procedure WriteString(const Value: string);virtual;
-    procedure DefineProperty(const Name: string;
-      rd : TReaderProc; wd : TWriterProc;
-      HasData: Boolean); override;
-    procedure DefineBinaryProperty(const Name: string;
-      rd, wd: TStreamProc;
-      HasData: Boolean); override;
-    property Position: Longint read GetPosition write SetPosition;
-  end;
+{ TReader }
 
-  TTextWriter = class(TAbstractWriter)
-  Private
-    FStream : TStream;
-    Procedure Write(Const Msg : String);
-    Procedure WriteLn(Const Msg : String);
-    Procedure WriteFmt(Fmt : String; Args :  Array of const);
-    procedure WritePropName(const PropName: string);
-  protected
-   Procedure StartCollection(Const AName : String);
-   Procedure StartCollectionItem;
-   Procedure EndCollectionItem;
-   Procedure EndCollection;
+  TAbstractObjectReader = class
   public
-    Constructor Create(S : TStream);
-    destructor Destroy; override;
-    { Abstract }
-    Procedure StartObject(Const AClassName,AName : String);override;
-    Procedure EndObject;Virtual;override;
-    Procedure WriteIntegerProperty(Const Name : Shortstring;Value : Longint);override;
-    Procedure WriteSetProperty (Const Name : ShortString;Value : longint; BaseType : TTypeInfo);override;
-    Procedure WriteEnumerationProperty (Const Name : ShortString;Value : Longint; Const EnumName : ShortSTring);override;
-    Procedure WriteStringProperty(Const Name : ShortString; Const Value : String);override;
-    Procedure WriteFloatProperty(Const Name : ShortString; Value : Extended);override;
-    Procedure WriteCollectionProperty(Const Name : ShortString;Value : TCollection);override;
-    Procedure WriteClassProperty(Instance : TPersistent;Propinfo :PPropInfo);override;
-    Procedure WriteComponentProperty(Const Name : ShortSTring; Value : TComponent);override;
-    Procedure WriteNilProperty(Const Name : Shortstring);override;
-    Procedure WriteMethodProperty(Const Name,AMethodName : ShortString);override;
+    function NextValue: TValueType; virtual; abstract;
+    function ReadValue: TValueType; virtual; abstract;
+    procedure BeginRootComponent; virtual; abstract;
+    procedure BeginComponent(var Flags: TFilerFlags; var AChildPos: Integer;
+      var CompClassName, CompName: String); virtual; abstract;
+    function BeginProperty: String; virtual; abstract;
+
+    { All ReadXXX methods are called _after_ the value type has been read! }
+    procedure ReadBinary(const DestData: TMemoryStream); virtual; abstract;
+    function ReadFloat: Extended; virtual; abstract;
+    function ReadSingle: Single; virtual; abstract;
+    {!!!: function ReadCurrency: Currency; virtual; abstract;}
+    function ReadDate: TDateTime; virtual; abstract;
+    function ReadIdent(ValueType: TValueType): String; virtual; abstract;
+    function ReadInt8: ShortInt; virtual; abstract;
+    function ReadInt16: SmallInt; virtual; abstract;
+    function ReadInt32: LongInt; virtual; abstract;
+    function ReadInt64: Int64; virtual; abstract;
+    function ReadSet(EnumType: Pointer): Integer; virtual; abstract;
+    function ReadStr: String; virtual; abstract;
+    function ReadString(StringType: TValueType): String; virtual; abstract;
+    procedure SkipComponent(SkipComponentInfos: Boolean); virtual; abstract;
+    procedure SkipValue; virtual; abstract;
   end;
 
-  TFiler = Class(TAbstractFiler);
-  TReader = Class(TWriter);
-
-(*
-  TFiler = class(TObject)
+  TBinaryObjectReader = class(TAbstractObjectReader)
   private
     FStream: TStream;
     FBuffer: Pointer;
     FBufSize: Integer;
     FBufPos: Integer;
     FBufEnd: Integer;
-    FRoot: TComponent;
-    FAncestor: TPersistent;
-    FIgnoreChildren: Boolean;
+    procedure Read(var Buf; Count: LongInt);
+    procedure SkipProperty;
+    procedure SkipSetBody;
   public
     constructor Create(Stream: TStream; BufSize: Integer);
     destructor Destroy; override;
-    procedure DefineProperty(const Name: string;
-      ReadData: TReaderProc; WriteData: TWriterProc;
-      HasData: Boolean); virtual; abstract;
-    procedure DefineBinaryProperty(const Name: string;
-      ReadData, WriteData: TStreamProc;
-      HasData: Boolean); virtual; abstract;
-    procedure FlushBuffer; virtual; abstract;
-    property Root: TComponent read FRoot write FRoot;
-    property Ancestor: TPersistent read FAncestor write FAncestor;
-    property IgnoreChildren: Boolean read FIgnoreChildren write FIgnoreChildren;
+
+    function NextValue: TValueType; override;
+    function ReadValue: TValueType; override;
+    procedure BeginRootComponent; override;
+    procedure BeginComponent(var Flags: TFilerFlags; var AChildPos: Integer;
+      var CompClassName, CompName: String); override;
+    function BeginProperty: String; override;
+
+    procedure ReadBinary(const DestData: TMemoryStream); override;
+    function ReadFloat: Extended; override;
+    function ReadSingle: Single; override;
+    {!!!: function ReadCurrency: Currency; override;}
+    function ReadDate: TDateTime; override;
+    function ReadIdent(ValueType: TValueType): String; override;
+    function ReadInt8: ShortInt; override;
+    function ReadInt16: SmallInt; override;
+    function ReadInt32: LongInt; override;
+    function ReadInt64: Int64; override;
+    function ReadSet(EnumType: Pointer): Integer; override;
+    function ReadStr: String; override;
+    function ReadString(StringType: TValueType): String; override;
+    procedure SkipComponent(SkipComponentInfos: Boolean); override;
+    procedure SkipValue; override;
   end;
 
-{ TReader }
 
   TFindMethodEvent = procedure(Reader: TReader; const MethodName: string;
     var Address: Pointer; var Error: Boolean) of object;
@@ -902,9 +725,14 @@ type
     ComponentClass: TPersistentClass; var Component: TComponent) of object;
   TReadComponentsProc = procedure(Component: TComponent) of object;
   TReaderError = procedure(Reader: TReader; const Message: string; var Handled: Boolean) of object;
+  TFindComponentClassEvent = procedure(Reader: TReader; const ClassName: string;
+    var ComponentClass: TComponentClass) of object;
+  TCreateComponentEvent = procedure(Reader: TReader;
+    ComponentClass: TComponentClass; var Component: TComponent) of object;
 
   TReader = class(TFiler)
   private
+    FDriver: TAbstractObjectReader;
     FOwner: TComponent;
     FParent: TComponent;
     FFixups: TList;
@@ -914,46 +742,37 @@ type
     FOnReferenceName: TReferenceNameEvent;
     FOnAncestorNotFound: TAncestorNotFoundEvent;
     FOnError: TReaderError;
-    FCanHandleExcepts: Boolean;
+    FOnFindComponentClass: TFindComponentClassEvent;
+    FOnCreateComponent: TCreateComponentEvent;
     FPropName: string;
-    procedure CheckValue(Value: TValueType);
+    FCanHandleExcepts: Boolean;
     procedure DoFixupReferences;
     procedure FreeFixups;
-    function GetPosition: Longint;
-    procedure PropertyError;
-    procedure ReadBuffer;
-    procedure ReadData(Instance: TComponent);
-    procedure ReadDataInner(Instance: TComponent);
-    procedure ReadProperty(AInstance: TPersistent);
-    procedure ReadPropValue(Instance: TPersistent; PropInfo: Pointer);
-    function ReadSet(SetType: Pointer): Integer;
-    procedure SetPosition(Value: Longint);
-    procedure SkipSetBody;
-    procedure SkipValue;
-    procedure SkipProperty;
-    procedure SkipComponent(SkipHeader: Boolean);
+    function FindComponentClass(const AClassName: string): TComponentClass;
   protected
     function Error(const Message: string): Boolean; virtual;
     function FindMethod(ARoot: TComponent; const AMethodName: string): Pointer; virtual;
-    procedure SetName(Component: TComponent; var Name: string); virtual;
-    procedure ReferenceName(var Name: string); virtual;
-    function FindAncestorComponent(const Name: string;
-      ComponentClass: TPersistentClass): TComponent; virtual;
+    procedure ReadProperty(AInstance: TPersistent);
+    procedure ReadPropValue(Instance: TPersistent; PropInfo: Pointer);
+    procedure PropertyError;
+    procedure ReadData(Instance: TComponent);
+    property PropName: string read FPropName;
+    property CanHandleExceptions: Boolean read FCanHandleExcepts;
   public
+    constructor Create(Stream: TStream; BufSize: Integer);
     destructor Destroy; override;
     procedure BeginReferences;
+    procedure CheckValue(Value: TValueType);
     procedure DefineProperty(const Name: string;
-      rd : TReaderProc; wd : TWriterProc;
+      AReadData: TReaderProc; WriteData: TWriterProc;
       HasData: Boolean); override;
     procedure DefineBinaryProperty(const Name: string;
-      rd, wd: TStreamProc;
+      AReadData, WriteData: TStreamProc;
       HasData: Boolean); override;
     function EndOfList: Boolean;
     procedure EndReferences;
     procedure FixupReferences;
-    procedure FlushBuffer; override;
     function NextValue: TValueType;
-    procedure Read(var Buf; Count: Longint);
     function ReadBoolean: Boolean;
     function ReadChar: Char;
     procedure ReadCollection(Collection: TCollection);
@@ -961,76 +780,155 @@ type
     procedure ReadComponents(AOwner, AParent: TComponent;
       Proc: TReadComponentsProc);
     function ReadFloat: Extended;
+    function ReadSingle: Single;
+    {!!!: function ReadCurrency: Currency;}
+    function ReadDate: TDateTime;
     function ReadIdent: string;
     function ReadInteger: Longint;
+    function ReadInt64: Int64;
     procedure ReadListBegin;
     procedure ReadListEnd;
-    procedure ReadPrefix(var Flags: TFilerFlags; var AChildPos: Integer);
     function ReadRootComponent(ARoot: TComponent): TComponent;
-    procedure ReadSignature;
-    function ReadStr: string;
     function ReadString: string;
+    {!!!: function ReadWideString: WideString;}
     function ReadValue: TValueType;
-    procedure CopyValue(Writer: TWriter); {!!!}
+    procedure CopyValue(Writer: TWriter);
     property Owner: TComponent read FOwner write FOwner;
     property Parent: TComponent read FParent write FParent;
-    property Position: Longint read GetPosition write SetPosition;
     property OnError: TReaderError read FOnError write FOnError;
     property OnFindMethod: TFindMethodEvent read FOnFindMethod write FOnFindMethod;
     property OnSetName: TSetNameEvent read FOnSetName write FOnSetName;
     property OnReferenceName: TReferenceNameEvent read FOnReferenceName write FOnReferenceName;
     property OnAncestorNotFound: TAncestorNotFoundEvent read FOnAncestorNotFound write FOnAncestorNotFound;
+    property OnCreateComponent: TCreateComponentEvent read FOnCreateComponent write FOnCreateComponent;
+    property OnFindComponentClass: TFindComponentClassEvent read FOnFindComponentClass write FOnFindComponentClass;
   end;
 
+
 { TWriter }
 
+  TAbstractObjectWriter = class
+  public
+    { Begin/End markers. Those ones who don't have an end indicator, use
+      "EndList", after the occurrence named in the comment. Note that this
+      only counts for "EndList" calls on the same level; each BeginXXX call
+      increases the current level. }
+    procedure BeginCollection; virtual; abstract;  { Ends with the next "EndList" }
+    procedure BeginComponent(Component: TComponent; Flags: TFilerFlags;
+      ChildPos: Integer); virtual; abstract;  { Ends after the second "EndList" }
+    procedure BeginList; virtual; abstract;
+    procedure EndList; virtual; abstract;
+    procedure BeginProperty(const PropName: String); virtual; abstract;
+    procedure EndProperty; virtual; abstract;
+
+    procedure WriteBinary(const Buffer; Count: Longint); virtual; abstract;
+    procedure WriteBoolean(Value: Boolean); virtual; abstract;
+    // procedure WriteChar(Value: Char);
+    procedure WriteFloat(const Value: Extended); virtual; abstract;
+    procedure WriteSingle(const Value: Single); virtual; abstract;
+    {!!!: procedure WriteCurrency(const Value: Currency); virtual; abstract;}
+    procedure WriteDate(const Value: TDateTime); virtual; abstract;
+    procedure WriteIdent(const Ident: string); virtual; abstract;
+    procedure WriteInteger(Value: Int64); virtual; abstract;
+    procedure WriteMethodName(const Name: String); virtual; abstract;
+    procedure WriteSet(Value: LongInt; SetType: Pointer); virtual; abstract;
+    procedure WriteString(const Value: String); virtual; abstract;
+  end;
+
+  TBinaryObjectWriter = class(TAbstractObjectWriter)
+  private
+    FStream: TStream;
+    FBuffer: Pointer;
+    FBufSize: Integer;
+    FBufPos: Integer;
+    FBufEnd: Integer;
+    FSignatureWritten: Boolean;
+    procedure FlushBuffer;
+    procedure Write(const Buffer; Count: Longint);
+    procedure WriteValue(Value: TValueType);
+    procedure WriteStr(const Value: String);
+  public
+    constructor Create(Stream: TStream; BufSize: Integer);
+    destructor Destroy; override;
+
+    procedure BeginCollection; override;
+    procedure BeginComponent(Component: TComponent; Flags: TFilerFlags;
+      ChildPos: Integer); override;
+    procedure BeginList; override;
+    procedure EndList; override;
+    procedure BeginProperty(const PropName: String); override;
+    procedure EndProperty; override;
+
+    procedure WriteBinary(const Buffer; Count: LongInt); override;
+    procedure WriteBoolean(Value: Boolean); override;
+    procedure WriteFloat(const Value: Extended); override;
+    procedure WriteSingle(const Value: Single); override;
+    {!!!: procedure WriteCurrency(const Value: Currency);  override;}
+    procedure WriteDate(const Value: TDateTime); override;
+    procedure WriteIdent(const Ident: string); override;
+    procedure WriteInteger(Value: Int64); override;
+    procedure WriteMethodName(const Name: String); override;
+    procedure WriteSet(Value: LongInt; SetType: Pointer); override;
+    procedure WriteString(const Value: String); override;
+  end;
+
+  TTextObjectWriter = class(TAbstractObjectWriter)
+  end;
+
+
+  TFindAncestorEvent = procedure (Writer: TWriter; Component: TComponent;
+    const Name: string; var Ancestor, RootAncestor: TComponent) of object;
+
   TWriter = class(TFiler)
   private
+    FDriver: TAbstractObjectWriter;
+    FDestroyDriver: Boolean;
     FRootAncestor: TComponent;
-    FPropPath: string;
+    FPropPath: String;
     FAncestorList: TList;
     FAncestorPos: Integer;
     FChildPos: Integer;
-    procedure AddAncestor(Component: TComponent);
-    function GetPosition: Longint;
-    procedure SetPosition(Value: Longint);
-    procedure WriteBuffer;
-    procedure WriteData(Instance: TComponent);
+    FOnFindAncestor: TFindAncestorEvent;
+    procedure AddToAncestorList(Component: TComponent);
+    procedure WriteComponentData(Instance: TComponent);
+  protected
+    procedure SetRoot(ARoot: TComponent); override;
+    procedure WriteBinary(AWriteData: TStreamProc);
     procedure WriteProperty(Instance: TPersistent; PropInfo: Pointer);
     procedure WriteProperties(Instance: TPersistent);
-    procedure WritePropName(const PropName: string);
-  protected
-    procedure WriteBinary(wd : TStreamProc);
-    procedure WritePrefix(Flags: TFilerFlags; AChildPos: Integer);
-    procedure WriteValue(Value: TValueType);
   public
+    constructor Create(ADriver: TAbstractObjectWriter);
+    constructor Create(Stream: TStream; BufSize: Integer);
     destructor Destroy; override;
     procedure DefineProperty(const Name: string;
-      rd : TReaderProc; wd : TWriterProc;
+      ReadData: TReaderProc; AWriteData: TWriterProc;
       HasData: Boolean); override;
     procedure DefineBinaryProperty(const Name: string;
-      rd, wd: TStreamProc;
+      ReadData, AWriteData: TStreamProc;
       HasData: Boolean); override;
-    procedure FlushBuffer; override;
-    procedure Write(const Buf; Count: Longint);
     procedure WriteBoolean(Value: Boolean);
     procedure WriteCollection(Value: TCollection);
     procedure WriteComponent(Component: TComponent);
     procedure WriteChar(Value: Char);
     procedure WriteDescendent(ARoot: TComponent; AAncestor: TComponent);
-    procedure WriteFloat(Value: Extended);
+    procedure WriteFloat(const Value: Extended);
+    procedure WriteSingle(const Value: Single);
+    {!!!: procedure WriteCurrency(const Value: Currency);}
+    procedure WriteDate(const Value: TDateTime);
     procedure WriteIdent(const Ident: string);
-    procedure WriteInteger(Value: Longint);
+    procedure WriteInteger(Value: Longint); overload;
+    procedure WriteInteger(Value: Int64); overload;
     procedure WriteListBegin;
     procedure WriteListEnd;
     procedure WriteRootComponent(ARoot: TComponent);
-    procedure WriteSignature;
-    procedure WriteStr(const Value: string);
     procedure WriteString(const Value: string);
-    property Position: Longint read GetPosition write SetPosition;
+    {!!!: procedure WriteWideString(const Value: WideString);}
     property RootAncestor: TComponent read FRootAncestor write FRootAncestor;
+    property OnFindAncestor: TFindAncestorEvent read FOnFindAncestor write FOnFindAncestor;
+
+    property Driver: TAbstractObjectWriter read FDriver;
   end;
-*)
+
 
 { TParser }
 
@@ -1125,7 +1023,8 @@ type
 
   TOperation = (opInsert, opRemove);
   TComponentState = set of (csLoading, csReading, csWriting, csDestroying,
-    csDesigning, csAncestor, csUpdating, csFixups);
+    csDesigning, csAncestor, csUpdating, csFixups, csFreeNotification,
+    csInline, csDesignInstance);
   TComponentStyle = set of (csInheritable, csCheckPropAvail);
   TGetChildProc = procedure (Child: TComponent) of object;
 
@@ -1179,7 +1078,7 @@ type
     procedure Loaded; virtual;
     procedure Notification(AComponent: TComponent;
       Operation: TOperation); virtual;
-    procedure ReadState(Reader: TAbstractReader); virtual;
+    procedure ReadState(Reader: TReader); virtual;
     procedure SetAncestor(Value: Boolean);
     procedure SetDesigning(Value: Boolean);
     procedure SetName(const NewName: TComponentName); virtual;
@@ -1205,7 +1104,7 @@ type
     //!!!!   Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): Integer; stdcall;
   public
     //!! Moved temporary
-    procedure WriteState(Writer: TAbstractWriter); virtual;
+    procedure WriteState(Writer: TWriter); virtual;
     constructor Create(AOwner: TComponent); virtual;
     destructor Destroy; override;
     procedure DestroyComponents;
@@ -1228,14 +1127,11 @@ type
     property DesignInfo: Longint read FDesignInfo write FDesignInfo;
     property Owner: TComponent read FOwner;
     property VCLComObject: Pointer read FVCLComObject write FVCLComObject;
-//!!  published
-    property Name: TComponentName read FName write SetName ; // stored False;
-    property Tag: Longint read FTag write FTag ; // default 0;
+  published
+    property Name: TComponentName read FName write SetName stored False;
+    property Tag: Longint read FTag write FTag default 0;
   end;
 
-{ TComponent class reference type }
-
-  TComponentClass = class of TComponent;
 
 { Component registration handlers }
 
@@ -1276,6 +1172,9 @@ procedure RegisterNoIcon(ComponentClasses: array of TComponentClass);
 procedure RegisterNonActiveX(ComponentClasses: array of TComponentClass;
   AxRegType: TActiveXRegType);
 
+{!!!: var
+  GlobalNameSpace: TMultiReadExclusiveWriteSynchronizer;}
+
 
 { Object filing routines }
 
@@ -1293,8 +1192,8 @@ var
   MainThreadID: THandle;
   FindGlobalComponent: TFindGlobalComponent;
 
-procedure RegisterIntegerConsts(IntegerType: Pointer; IdentToInt: TIdentToInt;
-  IntToIdent: TIntToIdent);
+procedure RegisterIntegerConsts(IntegerType: Pointer; IdentToIntFn: TIdentToInt;
+  IntToIdentFn: TIntToIdent);
 function IdentToInt(const Ident: string; var Int: Longint; const Map: array of TIdentMapEntry): Boolean;
 function IntToIdent(Int: Longint; var Ident: string; const Map: array of TIdentMapEntry): Boolean;
 
@@ -1313,6 +1212,7 @@ procedure RedirectFixupReferences(Root: TComponent; const OldRootName,
   NewRootName: string);
 procedure RemoveFixupReferences(Root: TComponent; const RootName: string);
 procedure RemoveFixups(Instance: TPersistent);
+function FindNestedComponent(Root: TComponent; const NamePath: string): TComponent;
 
 procedure BeginGlobalLoading;
 procedure NotifyGlobalLoading;
@@ -1334,7 +1234,11 @@ function LineStart(Buffer, BufPos: PChar): PChar;
 
 {
   $Log$
-  Revision 1.21  2000-01-07 01:24:33  peter
+  Revision 1.22  2000-06-29 16:29:23  sg
+  * Implemented streaming. Note: The writer driver interface is stable, but
+    the reader interface is not final yet!
+
+  Revision 1.21  2000/01/07 01:24:33  peter
     * updated copyright to 2000
 
   Revision 1.20  2000/01/06 01:20:32  peter

fcl/inc/compon.inc

@@ -112,8 +112,18 @@ end;
 
 Procedure TComponent.SetReference(Enable: Boolean);
 
+var
+  Field: ^TComponent;
 begin
-  // For delphi compatibility only.
+  if Assigned(Owner) then
+  begin
+    Field := Owner.FieldAddress(Name);
+    if Assigned(Field) then
+      if Enable then
+        Field^ := Self
+      else
+        Field^ := nil;
+  end;
 end;
 
 
@@ -219,10 +229,10 @@ begin
 end;
 
 
-Procedure TComponent.ReadState(Reader: TAbstractReader);
+Procedure TComponent.ReadState(Reader: TReader);
 
 begin
-//!!  Reader.ReadData(Self);
+  Reader.ReadData(Self);
 end;
 
 
@@ -333,10 +343,10 @@ begin
 end;
 
 
-Procedure TComponent.WriteState(Writer: TAbstractWriter);
+Procedure TComponent.WriteState(Writer: TWriter);
 
 begin
-  Writer.WriteData(self);
+  Writer.WriteComponentData(Self);
 end;
 
 
@@ -478,7 +488,11 @@ end;
 
 {
   $Log$
-  Revision 1.11  2000-01-07 01:24:33  peter
+  Revision 1.12  2000-06-29 16:29:23  sg
+  * Implemented streaming. Note: The writer driver interface is stable, but
+    the reader interface is not final yet!
+
+  Revision 1.11  2000/01/07 01:24:33  peter
     * updated copyright to 2000
 
   Revision 1.10  2000/01/06 01:20:32  peter

fcl/inc/constse.inc

@@ -41,18 +41,18 @@ const
   SInvalidPropertyPath = 'Invalid property path';
   SUnknownProperty = 'Unknown property';
   SReadOnlyProperty = 'Read-only property';
-  SPropertyException = 'Error when reading %s.%s: %s';
-  SAncestorNotFound = 'Ancestor of ''%s'' not found.';
+  SPropertyException = 'Error while reading %s%s%s: %s';
+  SAncestorNotFound = 'Ancestor of ''%s'' not found';
   SInvalidBitmap = 'Invalid Bitmap';
   SInvalidIcon = 'Invalid Icon';
-  SInvalidMetafile = 'Invalid MetaFile';
-  SInvalidPixelFormat = 'Invalid PixelFormat';
+  SInvalidMetafile = 'Invalid Metafile';
+  SInvalidPixelFormat = 'Invalid Pixelformat';
   SBitmapEmpty = 'Bitmap is empty';
   SScanLine = 'Line index out of bounds';
-  SChangeIconSize = 'Can not change Icon size';
+  SChangeIconSize = 'Can not change icon size';
   SOleGraphic = 'Invalid operation for TOleGraphic';
   SUnknownExtension = 'Unknown extension (.%s)';
-  SUnknownClipboardFormat = 'Unknown Clipboard format';
+  SUnknownClipboardFormat = 'Unknown clipboard format';
   SOutOfResources = 'Out of system resources';
   SNoCanvasHandle = 'Canvas handle does not allow drawing';
   SInvalidImageSize = 'Invalid image size';
@@ -60,9 +60,9 @@ const
   SDimsDoNotMatch = 'Image size mismatch';
   SInvalidImageList = 'Invalid ImageList';
   SReplaceImage = 'Image can not be replaced';
-  SImageIndexError = 'Invalid ImageList-Index';
-  SImageReadFail = 'The ImageList data could not be read from Stream';
-  SImageWriteFail = 'The ImageList data could not be written to Stream';
+  SImageIndexError = 'Invalid ImageList index';
+  SImageReadFail = 'The ImageList data could not be read from stream';
+  SImageWriteFail = 'The ImageList data could not be written to stream';
   SWindowDCError = 'Error when??';
   SClientNotSet = 'Client of TDrag was not initialized';
   SWindowClass = 'Error when initializing Window Class';
@@ -272,7 +272,11 @@ const
 
 {
   $Log$
-  Revision 1.8  2000-02-15 21:57:51  sg
+  Revision 1.9  2000-06-29 16:29:23  sg
+  * Implemented streaming. Note: The writer driver interface is stable, but
+    the reader interface is not final yet!
+
+  Revision 1.8  2000/02/15 21:57:51  sg
   * Added copyright notice and CVS log tags where necessary
 
 }

fcl/inc/constsg.inc

@@ -42,7 +42,7 @@ const
   SInvalidPropertyPath = 'Ungültiger Pfad für Eigenschaft';
   SUnknownProperty = 'Eigenschaft existiert nicht';
   SReadOnlyProperty = 'Eigenschaft kann nur gelesen werden';
-  SPropertyException = 'Fehler beim Lesen von %s.%s: %s';
+  SPropertyException = 'Fehler beim Lesen von %s%s: %s';
   SAncestorNotFound = 'Vorfahr für ''%s'' nicht gefunden';
   SInvalidBitmap = 'Bitmap ist ungültig';
   SInvalidIcon = 'Ungültiges Symbol';
@@ -273,7 +273,11 @@ const
 
 {
   $Log$
-  Revision 1.6  2000-02-15 21:57:51  sg
+  Revision 1.7  2000-06-29 16:29:23  sg
+  * Implemented streaming. Note: The writer driver interface is stable, but
+    the reader interface is not final yet!
+
+  Revision 1.6  2000/02/15 21:57:51  sg
   * Added copyright notice and CVS log tags where necessary
 
 }

fcl/inc/constss.inc

@@ -41,7 +41,7 @@ const
   SInvalidPropertyPath = 'Path de propiedad no valido';
   SUnknownProperty = 'Propiedad desconocidad';
   SReadOnlyProperty = 'Propiedad de solo lectura';
-  SPropertyException = 'Error leyendo %s.%s: %s';
+  SPropertyException = 'Error leyendo %s%s: %s';
 {N}  SAncestorNotFound = 'Ancestor of ''%s'' not found.';
   SInvalidBitmap = 'Bitmap no valido';
   SInvalidIcon = 'Icono no valido';
@@ -272,7 +272,11 @@ const
 
 {
   $Log$
-  Revision 1.6  2000-02-15 21:57:51  sg
+  Revision 1.7  2000-06-29 16:29:23  sg
+  * Implemented streaming. Note: The writer driver interface is stable, but
+    the reader interface is not final yet!
+
+  Revision 1.6  2000/02/15 21:57:51  sg
   * Added copyright notice and CVS log tags where necessary
 
 }

fcl/inc/filer.inc

@@ -15,21 +15,18 @@
   *                         TFiler                                    *
   *********************************************************************}
 
-{
-  $Log$
-  Revision 1.5  2000-01-07 01:24:33  peter
-    * updated copyright to 2000
-
-  Revision 1.4  2000/01/06 01:20:33  peter
-    * moved out of packages/ back to topdir
+procedure TFiler.SetRoot(ARoot: TComponent);
+begin
+  FRoot := ARoot;
+end;
 
-  Revision 1.2  2000/01/04 18:07:16  michael
-  + Streaming implemented
 
-  Revision 1.2  1998/08/24 12:38:23  michael
-  small fixes
-
-  Revision 1.1  1998/05/04 14:30:11  michael
-  * Split file according to Class; implemented dummys for all methods, so unit compiles.
+{
+  $Log$
+  Revision 1.6  2000-06-29 16:29:23  sg
+  * Implemented streaming. Note: The writer driver interface is stable, but
+    the reader interface is not final yet!
 
+  Revision 1.5  2000/01/07 01:24:33  peter
+    * updated copyright to 2000
 }

fcl/inc/reader.inc

@@ -12,381 +12,1257 @@
 
  **********************************************************************}
 {****************************************************************************}
-{*                             TREADER                                      *}
+{*                       TBinaryObjectReader                                *}
 {****************************************************************************}
 
-Procedure TReader.CheckValue(Value: TValueType);
-
+constructor TBinaryObjectReader.Create(Stream: TStream; BufSize: Integer);
 begin
+  inherited Create;
+  FStream := Stream;
+  FBufSize := BufSize;
+  GetMem(FBuffer, BufSize);
 end;
 
+destructor TBinaryObjectReader.Destroy;
+begin
+  { Seek back the amount of bytes that we didn't process unitl now: }
+  FStream.Seek(Integer(FBufPos) - Integer(FBufEnd), soFromCurrent);
 
+  if Assigned(FBuffer) then
+    FreeMem(FBuffer, FBufSize);
 
-Procedure TReader.DoFixupReferences;
+  inherited Destroy;
+end;
 
+function TBinaryObjectReader.ReadValue: TValueType;
 begin
+  Result := vaNull; { Necessary in FPC as TValueType is larger than 1 byte! }
+  Read(Result, 1);
 end;
 
-
-
-Procedure TReader.FreeFixups;
-
+function TBinaryObjectReader.NextValue: TValueType;
 begin
+  Result := ReadValue;
+  { We only 'peek' at the next value, so seek back to unget the read value: }
+  Dec(FBufPos);
 end;
 
-
-
-Function TReader.GetPosition: Longint;
-
+procedure TBinaryObjectReader.BeginRootComponent;
+var
+  Signature: LongInt;
 begin
-  GetPosition:=0;
+  { Read filer signature }
+  Read(Signature, 4);
+  if Signature <> LongInt(FilerSignature) then
+    raise EReadError.Create(SInvalidImage);
 end;
 
-
-
-Procedure TReader.PropertyError;
-
+procedure TBinaryObjectReader.BeginComponent(var Flags: TFilerFlags;
+  var AChildPos: Integer; var CompClassName, CompName: String);
+var
+  Prefix: Byte;
+  ValueType: TValueType;
 begin
+  { Every component can start with a special prefix: }
+  Flags := [];
+  if (Byte(NextValue) and $f0) = $f0 then
+  begin
+    Prefix := Byte(ReadValue);
+    Flags := TFilerFlags(Prefix and $0f);
+    if ffChildPos in Flags then
+    begin
+      ValueType := NextValue;
+      case ValueType of
+        vaInt8:
+	  AChildPos := ReadInt8;
+	vaInt16:
+	  AChildPos := ReadInt16;
+        vaInt32:
+	  AChildPos := ReadInt32;
+	else
+	  raise EReadError.Create(SInvalidPropertyValue);
+      end;
+    end;
+  end;
+
+  CompClassName := ReadStr;
+  CompName := ReadStr;
 end;
 
-
-
-Procedure TReader.ReadBuffer;
-
+function TBinaryObjectReader.BeginProperty: String;
 begin
+  Result := ReadStr;
 end;
 
-
-
-Procedure TReader.ReadData(Instance: TComponent);
-
+procedure TBinaryObjectReader.ReadBinary(const DestData: TMemoryStream);
+var
+  BinSize: LongInt;
 begin
+  Read(BinSize, 4);
+  DestData.Size := BinSize;
+  Read(DestData.Memory^, BinSize);
 end;
 
-
-
-Procedure TReader.ReadDataInner(Instance: TComponent);
-
+function TBinaryObjectReader.ReadFloat: Extended;
 begin
+  Read(Result, SizeOf(Extended))
 end;
 
-
-
-Procedure TReader.ReadProperty(AInstance: TPersistent);
-
+function TBinaryObjectReader.ReadSingle: Single;
 begin
+  Read(Result, SizeOf(Single))
 end;
 
+{!!!: function TBinaryObjectReader.ReadCurrency: Currency;
+begin
+  Read(Result, SizeOf(Currency))
+end;}
 
-
-Procedure TReader.ReadPropValue(Instance: TPersistent; PropInfo: Pointer);
-
+function TBinaryObjectReader.ReadDate: TDateTime;
 begin
+  Read(Result, SizeOf(TDateTime))
 end;
 
-
-
-Function TReader.ReadSet(SetType: Pointer): Integer;
-
+function TBinaryObjectReader.ReadIdent(ValueType: TValueType): String;
+var
+  i: Byte;
 begin
-  ReadSet:=0;
+  case ValueType of
+    vaIdent:
+      begin
+        Read(i, 1);
+	SetLength(Result, i);
+        Read(Pointer(@Result[1])^, i);
+      end;
+    vaNil:
+      Result := 'nil';
+    vaFalse:
+      Result := 'False';
+    vaTrue:
+      Result := 'True';
+    vaNull:
+      Result := 'Null';
+  end;
 end;
 
-
-
-Procedure TReader.SetPosition(Value: Longint);
-
+function TBinaryObjectReader.ReadInt8: ShortInt;
 begin
+  Read(Result, 1);
 end;
 
-
-
-Procedure TReader.SkipSetBody;
-
+function TBinaryObjectReader.ReadInt16: SmallInt;
 begin
+  Read(Result, 2);
 end;
 
-
-
-Procedure TReader.SkipValue;
-
+function TBinaryObjectReader.ReadInt32: LongInt;
 begin
+  Read(Result, 4);
 end;
 
-
-
-Procedure TReader.SkipProperty;
-
+function TBinaryObjectReader.ReadInt64: Int64;
 begin
+  Read(Result, 8);
 end;
 
-
-
-Procedure TReader.SkipComponent(SkipHeader: Boolean);
-
+function TBinaryObjectReader.ReadSet(EnumType: Pointer): Integer;
+var
+  Name: String;
+  Value: Integer;
 begin
+  try
+    while True do
+    begin
+      Name := ReadStr;
+      if Length(Name) = 0 then
+        break;
+      Value := GetEnumValue(PTypeInfo(EnumType), Name);
+      if Value = -1 then
+        raise EReadError.Create(SInvalidPropertyValue);
+      Result := Result or Value;
+    end;
+  except
+    SkipSetBody;
+    raise;
+  end;
 end;
 
+function TBinaryObjectReader.ReadStr: String;
+var
+  i: Byte;
+begin
+  Read(i, 1);
+  SetLength(Result, i);
+  Read(Pointer(@Result[1])^, i);
+end;
 
+function TBinaryObjectReader.ReadString(StringType: TValueType): String;
+var
+  i: Integer;
+begin
+  case StringType of
+    vaString:
+      begin
+        i := 0;
+        Read(i, 1);
+      end;
+    vaLString:
+      Read(i, 4);
+  end;
+  SetLength(Result, i);
+  if i > 0 then
+    Read(Pointer(@Result[1])^, i);
+end;
 
-Function TReader.Error(const Message: string): Boolean;
-
+{!!!: function TBinaryObjectReader.ReadWideString: WideString;
+var
+  i: Integer;
 begin
-  Error:=false;
+  FDriver.Read(i, 4);
+  SetLength(Result, i);
+  if i > 0 then
+    Read(PWideChar(Result), i * 2);
+end;}
+
+procedure TBinaryObjectReader.SkipComponent(SkipComponentInfos: Boolean);
+var
+  Flags: TFilerFlags;
+  Dummy: Integer;
+  CompClassName, CompName: String;
+begin
+  if SkipComponentInfos then
+    { Skip prefix, component class name and component object name }
+    BeginComponent(Flags, Dummy, CompClassName, CompName);
+
+  { Skip properties }
+  while NextValue <> vaNull do
+    SkipProperty;
+  ReadValue;
+
+  { Skip children }
+  while NextValue <> vaNull do
+    SkipComponent(True);
+  ReadValue;
 end;
 
+procedure TBinaryObjectReader.SkipValue;
+
+  procedure SkipBytes(Count: LongInt);
+  var
+    Dummy: array[0..1023] of Byte;
+    SkipNow: Integer;
+  begin
+    while Count > 0 do
+    begin
+      if Count > 1024 then
+        SkipNow := 1024
+      else
+        SkipNow := Count;
+      Read(Dummy, SkipNow);
+      Dec(Count, SkipNow);
+    end;
+  end;
+
+var
+  Count: LongInt;
+begin
+  case ReadValue of
+    vaNull, vaFalse, vaTrue, vaNil: ;
+    vaList:
+      begin
+        while NextValue <> vaNull do
+          SkipValue;
+	ReadValue;
+      end;
+    vaInt8:
+      SkipBytes(1);
+    vaInt16:
+      SkipBytes(2);
+    vaInt32:
+      SkipBytes(4);
+    vaExtended:
+      SkipBytes(SizeOf(Extended));
+    vaString, vaIdent:
+      ReadStr;
+    vaBinary, vaLString, vaWString:
+      begin
+        Read(Count, 4);
+        SkipBytes(Count);
+      end;
+    vaSet:
+      SkipSetBody;
+    vaCollection:
+      begin
+        while NextValue <> vaNull do
+        begin
+	  { Skip the order value if present }
+          if NextValue in [vaInt8, vaInt16, vaInt32] then
+	    SkipValue;
+          SkipBytes(1);
+          while NextValue <> vaNull do
+	    SkipProperty;
+	  ReadValue;
+        end;
+	ReadValue;
+      end;
+    vaSingle:
+      SkipBytes(Sizeof(Single));
+    {!!!: vaCurrency:
+      SkipBytes(SizeOf(Currency));}
+    vaDate:
+      SkipBytes(Sizeof(TDateTime));
+    vaInt64:
+      SkipBytes(8);
+  end;
+end;
 
+{ private methods }
 
-Function TReader.FindMethod(ARoot: TComponent; const AMethodName: string): Pointer;
+procedure TBinaryObjectReader.Read(var Buf; Count: LongInt);
+var
+  CopyNow: LongInt;
+  Dest: Pointer;
+begin
+  Dest := @Buf;
+  while Count > 0 do
+  begin
+    if FBufPos >= FBufEnd then
+    begin
+      FBufEnd := FStream.Read(FBuffer^, FBufSize);
+      if FBufEnd = 0 then
+        raise EReadError.Create(SReadError);
+      FBufPos := 0;
+    end;
+    CopyNow := FBufEnd - FBufPos;
+    if CopyNow > Count then
+      CopyNow := Count;
+    Move(PChar(FBuffer)[FBufPos], Dest^, CopyNow);
+    Inc(FBufPos, CopyNow);
+    Inc(Dest, CopyNow);
+    Dec(Count, CopyNow);
+  end;
+end;
 
+procedure TBinaryObjectReader.SkipProperty;
 begin
-  FindMethod:=nil;
+  { Skip property name, then the property value }
+  ReadStr;
+  SkipValue;
 end;
 
+procedure TBinaryObjectReader.SkipSetBody;
+begin
+  while Length(ReadStr) > 0 do;
+end;
 
 
-Procedure TReader.SetName(Component: TComponent; var Name: string);
 
-begin
-end;
+{****************************************************************************}
+{*                             TREADER                                      *}
+{****************************************************************************}
 
 
+// This may be better put somewhere else:
 
-Procedure TReader.ReferenceName(var Name: string);
+type
 
-begin
-end;
+  TFieldInfo = packed record
+    FieldOffset: LongWord;
+    ClassTypeIndex: Word;
+    Name: ShortString;
+  end;
 
+  PFieldClassTable = ^TFieldClassTable;
+  TFieldClassTable = packed record
+    Count: Word;
+    Entries: array[Word] of TPersistentClass;
+  end;
 
+  PFieldTable = ^TFieldTable;
+  TFieldTable = packed record
+    FieldCount: Word;
+    ClassTable: PFieldClassTable;
+    // Fields: array[Word] of TFieldInfo;  Elements have variant size!
+  end;
 
-Function TReader.FindAncestorComponent(const Name: string;
-  ComponentClass: TPersistentClass): TComponent;
 
+function GetFieldClass(Instance: TObject; const ClassName: string): TPersistentClass;
+var
+  UClassName: String;
+  ClassType: TClass;
+  ClassTable: PFieldClassTable;
+  i: Integer;
+  FieldTable: PFieldTable;
 begin
-  FindAncestorComponent:=nil;
+  // At first, try to locate the class in the class tables
+  UClassName := UpperCase(ClassName);
+  ClassType := Instance.ClassType;
+  while ClassType <> TPersistent do
+  begin
+    FieldTable := PFieldTable((Pointer(ClassType) + vmtFieldTable)^);
+    ClassTable := PFieldTable((Pointer(ClassType) + vmtFieldTable)^)^.ClassTable;
+    if Assigned(ClassTable) then
+      for i := 0 to ClassTable^.Count - 1 do
+      begin
+        Result := ClassTable^.Entries[i];
+        if UpperCase(Result.ClassName) = UClassName then
+          exit;
+      end;
+     // Try again with the parent class type
+     ClassType := ClassType.ClassParent;
+  end;
+  Result := Classes.GetClass(ClassName);
 end;
 
 
+constructor TReader.Create(Stream: TStream; BufSize: Integer);
+begin
+  inherited Create;
+  FDriver := TBinaryObjectReader.Create(Stream, BufSize);
+end;
 
 destructor TReader.Destroy;
-
 begin
+  FDriver.Free;
+  inherited Destroy;
 end;
 
-
-
-Procedure TReader.BeginReferences;
-
+procedure TReader.BeginReferences;
 begin
+  FLoaded := TList.Create;
+  try
+    FFixups := TList.Create;
+  except
+    FLoaded.Free;
+    raise;
+  end;
 end;
 
-
-
-Procedure TReader.DefineProperty(const Name: string;
-  rd : TReaderProc; wd : TWriterProc;
-  HasData: Boolean);
-
+procedure TReader.CheckValue(Value: TValueType);
 begin
+  if FDriver.NextValue <> Value then
+    raise EReadError.Create(SInvalidPropertyValue)
+  else
+    FDriver.ReadValue;
 end;
 
-
-
-Procedure TReader.DefineBinaryProperty(const Name: string;
-  rd, wd: TStreamProc;
-  HasData: Boolean);
-
+procedure TReader.DefineProperty(const Name: String; AReadData: TReaderProc;
+  WriteData: TWriterProc; HasData: Boolean);
 begin
+  if Assigned(AReadData) and (UpperCase(Name) = UpperCase(FPropName)) then
+  begin
+    AReadData(Self);
+    SetLength(FPropName, 0);
+  end;
 end;
 
-
-
-Function TReader.EndOfList: Boolean;
-
+procedure TReader.DefineBinaryProperty(const Name: String;
+  AReadData, WriteData: TStreamProc; HasData: Boolean);
+var
+  MemBuffer: TMemoryStream;
 begin
-  EndOfList:=false;
+  if Assigned(AReadData) and (UpperCase(Name) = UpperCase(FPropName)) then
+  begin
+    { Check if the next property really is a binary property}
+    if FDriver.NextValue <> vaBinary then
+    begin
+      FDriver.SkipValue;
+      FCanHandleExcepts := True;
+      raise EReadError.Create(SInvalidPropertyValue);
+    end else
+      FDriver.ReadValue;
+
+    MemBuffer := TMemoryStream.Create;
+    try
+      FDriver.ReadBinary(MemBuffer);
+      FCanHandleExcepts := True;
+      AReadData(MemBuffer);
+    finally
+      MemBuffer.Free;
+    end;
+    SetLength(FPropName, 0);
+  end;
 end;
 
-
-
-Procedure TReader.EndReferences;
-
+function TReader.EndOfList: Boolean;
 begin
+  Result := FDriver.NextValue = vaNull;
 end;
 
-
-
-Procedure TReader.FixupReferences;
-
+procedure TReader.EndReferences;
 begin
+  FreeFixups;
+  FLoaded.Free;
+  FLoaded := nil;
 end;
 
-
-
-Procedure TReader.FlushBuffer;
-
+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): Pointer;
+var
+  ErrorResult: Boolean;
+begin
+  Result := ARoot.MethodAddress(AMethodName);
+  ErrorResult := Result = nil;
 
+  { always give the OnFindMethod callback a chance to locate the method }
+  if Assigned(FOnFindMethod) then
+    FOnFindMethod(Self, AMethodName, Result, ErrorResult);
 
-Function TReader.NextValue: TValueType;
+  if ErrorResult then
+    raise EReadError.Create(SInvalidPropertyValue);
+end;
 
+procedure RemoveGlobalFixup(Fixup: TPropFixup);
+var
+  i: Integer;
 begin
-  NextValue:=vaNull;
+  with GlobalFixupList.LockList do
+    try
+      for i := Count - 1 downto 0 do
+        with TPropFixup(Items[i]) do
+          if (FInstance = Fixup.FInstance) and
+	    (FPropInfo = Fixup.FPropInfo) then
+          begin
+            Free;
+            Delete(i);
+          end;
+    finally
+      GlobalFixupList.UnlockList;
+    end;
 end;
 
-
-
-Procedure TReader.Read(var Buf; Count: Longint);
-
+procedure TReader.DoFixupReferences;
+var
+  i: Integer;
+  CurFixup: TPropFixup;
+  CurName: String;
+  Target: Pointer;
 begin
+  if Assigned(FFixups) then
+    try
+      for i := 0 to FFixups.Count - 1 do
+      begin
+        CurFixup := TPropFixup(FFixups[i]);
+        CurName := CurFixup.FName;
+        if Assigned(FOnReferenceName) then
+          FOnReferenceName(Self, CurName);
+        Target := FindNestedComponent(CurFixup.FInstanceRoot, CurName);
+        RemoveGlobalFixup(CurFixup);
+        if (not Assigned(Target)) and CurFixup.MakeGlobalReference then
+        begin
+          GlobalFixupList.Add(CurFixup);
+          FFixups[i] := nil;
+        end else
+          SetOrdProp(CurFixup.FInstance, CurFixup.FPropInfo, LongInt(Target));
+      end;
+    finally
+      FreeFixups;
+    end;
 end;
 
-
-
-Function TReader.ReadBoolean: Boolean;
-
+procedure TReader.FixupReferences;
+var
+  i: Integer;
 begin
-  ReadBoolean:=false;
+  DoFixupReferences;
+  GlobalFixupReferences;
+  for i := 0 to FLoaded.Count - 1 do
+    TComponent(FLoaded[I]).Loaded;
 end;
 
-
-
-Function TReader.ReadChar: Char;
-
+procedure TReader.FreeFixups;
+var
+  i: Integer;
 begin
-  ReadChar:=#0;
+  if Assigned(FFixups) then
+  begin
+    for i := 0 to FFixups.Count - 1 do
+      TPropFixup(FFixups[I]).Free;
+    FFixups.Free;
+    FFixups := nil;
+  end;
 end;
 
-
-
-Procedure TReader.ReadCollection(Collection: TCollection);
-
+function TReader.NextValue: TValueType;
 begin
+  Result := FDriver.NextValue;
 end;
 
-
-
-Function TReader.ReadComponent(Component: TComponent): TComponent;
-
+procedure TReader.PropertyError;
 begin
-  ReadComponent:=nil;
+  FDriver.SkipValue;
+  raise EReadError.Create(SUnknownProperty);
 end;
 
-
-
-Procedure TReader.ReadComponents(AOwner, AParent: TComponent;
-  Proc: TReadComponentsProc);
-
+function TReader.ReadBoolean: Boolean;
+var
+  ValueType: TValueType;
 begin
+  ValueType := FDriver.ReadValue;
+  if ValueType = vaTrue then
+    Result := True
+  else if ValueType = vaFalse then
+    Result := False
+  else
+    raise EReadError.Create(SInvalidPropertyValue);
 end;
 
-
-
-Function TReader.ReadFloat: Extended;
-
+function TReader.ReadChar: Char;
+var
+  s: String;
 begin
-  ReadFloat:=0.0;
+  s := ReadString;
+  if Length(s) = 1 then
+    Result := s[1]
+  else
+    raise EReadError.Create(SInvalidPropertyValue);
 end;
 
-
-
-Function TReader.ReadIdent: string;
-
+procedure TReader.ReadCollection(Collection: TCollection);
+var
+  Item: TPersistent;
 begin
-  ReadIdent:='';
+  Collection.BeginUpdate;
+  try
+    if not EndOfList then
+      Collection.Clear;
+    while not EndOfList do
+    begin
+      if FDriver.NextValue in [vaInt8, vaInt16, vaInt32] then
+        ReadInteger;		{ Skip order value }
+      Item := Collection.Add;
+      ReadListBegin;
+      while not EndOfList do
+        ReadProperty(Item);
+      ReadListEnd;
+    end;
+    ReadListEnd;
+  finally
+    Collection.EndUpdate;
+  end;
 end;
 
-
-
-Function TReader.ReadInteger: Longint;
-
+function TReader.ReadComponent(Component: TComponent): TComponent;
+var
+  Flags: TFilerFlags;
+
+  function Recover(var Component: TComponent): Boolean;
+  begin
+    Result := False;
+    if ExceptObject.InheritsFrom(Exception) then
+    begin
+      if not ((ffInherited in Flags) or Assigned(Component)) then
+        Component.Free;
+      Component := nil;
+      FDriver.SkipComponent(False);
+      Result := Error(Exception(ExceptObject).Message);
+    end;
+  end;
+
+var
+  CompClassName, Name: String;
+  ChildPos: Integer;
+  SavedParent, SavedLookupRoot: TComponent;
+  ComponentClass: TComponentClass;
+  NewComponent: TComponent;
 begin
-  ReadInteger:=0;
+  FDriver.BeginComponent(Flags, ChildPos, CompClassName, Name);
+  SavedParent := Parent;
+  SavedLookupRoot := FLookupRoot;
+  try
+    Result := Component;
+    if not Assigned(Result) then
+      try
+        if ffInherited in Flags then
+	begin
+          { Try to locate the existing ancestor component }
+
+	  if Assigned(FLookupRoot) then
+	    Result := FLookupRoot.FindComponent(Name)
+	  else
+	    Result := nil;
+
+	  if not Assigned(Result) then
+	  begin
+	    if Assigned(FOnAncestorNotFound) then
+	      FOnAncestorNotFound(Self, Name,
+	        FindComponentClass(CompClassName), Result);
+	    if not Assigned(Result) then
+	      raise EReadError.CreateFmt(SAncestorNotFound, [Name]);
+	  end;
+
+          Parent := Result.GetParentComponent;
+          if not Assigned(Parent) then
+	    Parent := Root;
+	end else
+	begin
+          Result := nil;
+          ComponentClass := FindComponentClass(CompClassName);
+          if Assigned(FOnCreateComponent) then
+            FOnCreateComponent(Self, ComponentClass, Result);
+          if not Assigned(Result) then
+          begin
+//!!!:            NewComponent := TComponent(ComponentClass.NewInstance);
+	    NewComponent := TComponentClass(ComponentClass).Create(Owner);
+            if ffInline in Flags then
+	      NewComponent.FComponentState :=
+	        NewComponent.FComponentState + [csLoading, csInline];
+//!!!:            NewComponent.Create(Owner);
+
+	    { Don't set Result earlier because else we would come in trouble
+	      with the exception recover mechanism! (Result should be NIL if
+	      an error occured) }
+            Result := NewComponent;
+          end;
+          Include(Result.FComponentState, csLoading);
+	end;
+      except
+        if not Recover(Result) then
+	  raise;
+      end;
+
+    if Assigned(Result) then
+      try
+        Include(Result.FComponentState, csLoading);
+        if not (ffInherited in Flags) then
+          try
+            Result.SetParentComponent(Parent);
+	    if Assigned(FOnSetName) then
+	      FOnSetName(Self, Result, Name);
+	    Result.Name := Name;
+            if Assigned(FindGlobalComponent) and
+              (FindGlobalComponent(Name) = Result) then
+              Include(Result.FComponentState, csInline);
+          except
+            if not Recover(Result) then
+	      raise;
+          end;
+        if not Assigned(Result) then
+	  exit;
+        if csInline in Result.ComponentState then
+          FLookupRoot := Result;
+
+	{ Read the component state }
+        Include(Result.FComponentState, csReading);
+        Result.ReadState(Self);
+        Exclude(Result.FComponentState, csReading);
+
+        if ffChildPos in Flags then
+	  Parent.SetChildOrder(Result, ChildPos);
+
+        { Add component to list of loaded components, if necessary }
+	if (not ((ffInherited in Flags) or (csInline in Result.ComponentState))) or
+	  (FLoaded.IndexOf(Result) < 0) then
+	  FLoaded.Add(Result);
+      except
+        if ((ffInherited in Flags) or Assigned(Component)) then
+	  Result.Free;
+        raise;
+      end;
+  finally
+    Parent := SavedParent;
+    FLookupRoot := SavedLookupRoot;
+  end;
 end;
 
-
-
-Procedure TReader.ReadListBegin;
-
+procedure TReader.ReadData(Instance: TComponent);
+var
+  DoFreeFixups: Boolean;
+  SavedOwner, SavedParent: TComponent;
 begin
+  if not Assigned(FFixups) then
+  begin
+    FFixups := TList.Create;
+    DoFreeFixups := True;
+  end else
+    DoFreeFixups := False;
+
+  try
+    { Read properties }
+    while not EndOfList do
+      ReadProperty(Instance);
+    ReadListEnd;
+
+    { Read children }
+    SavedOwner := Owner;
+    SavedParent := Parent;
+    try
+      Owner := Instance.GetChildOwner;
+      if not Assigned(Owner) then
+        Owner := Root;
+      Parent := Instance.GetChildParent;
+
+      while not EndOfList do
+        ReadComponent(nil);
+      ReadListEnd;
+    finally
+      Owner := SavedOwner;
+      Parent := SavedParent;
+    end;
+
+    { Fixup references if necessary (normally only if this is the root) }
+    if DoFreeFixups then
+      DoFixupReferences;
+
+  finally
+    if DoFreeFixups then
+      FreeFixups;
+  end;
 end;
 
-
-
-Procedure TReader.ReadListEnd;
-
+function TReader.ReadFloat: Extended;
 begin
+  if FDriver.NextValue = vaExtended then
+  begin
+    ReadValue;
+    Result := FDriver.ReadFloat
+  end else
+    Result := ReadInteger;
 end;
 
-
-
-Procedure TReader.ReadPrefix(var Flags: TFilerFlags; var AChildPos: Integer);
-
+function TReader.ReadSingle: Single;
 begin
+  if FDriver.NextValue = vaSingle then
+  begin
+    FDriver.ReadValue;
+    Result := FDriver.ReadSingle;
+  end else
+    Result := ReadInteger;
 end;
 
-
-
-Function TReader.ReadRootComponent(ARoot: TComponent): TComponent;
-
+{!!!: function TReader.ReadCurrency: Currency;
+begin
+  if FDriver.NextValue = vaCurrency then
+  begin
+    FDriver.ReadValue;
+    Result := FDriver.ReadCurrency;
+  end else
+    Result := ReadInteger;
+end;}
+
+function TReader.ReadDate: TDateTime;
 begin
-  ReadRootComponent:=nil;
+  if FDriver.NextValue = vaDate then
+  begin
+    FDriver.ReadValue;
+    Result := FDriver.ReadDate;
+  end else
+    Result := ReadInteger;
 end;
 
-
-
-Procedure TReader.ReadSignature;
-
+function TReader.ReadIdent: String;
+var
+  ValueType: TValueType;
 begin
+  ValueType := FDriver.ReadValue;
+  if ValueType in [vaIdent, vaNil, vaFalse, vaTrue, vaNull] then
+    Result := FDriver.ReadIdent(ValueType)
+  else
+    raise EReadError.Create(SInvalidPropertyValue);
 end;
 
 
-
-Function TReader.ReadStr: string;
-
+function TReader.ReadInteger: LongInt;
 begin
-  ReadStr:='';
+  case FDriver.ReadValue of
+    vaInt8:
+      Result := FDriver.ReadInt8;
+    vaInt16:
+      Result := FDriver.ReadInt16;
+    vaInt32:
+      Result := FDriver.ReadInt32;
+  else
+    raise EReadError.Create(SInvalidPropertyValue);
+  end;
 end;
 
+function TReader.ReadInt64: Int64;
+begin
+  if FDriver.NextValue = vaInt64 then
+  begin
+    FDriver.ReadValue;
+    Result := FDriver.ReadInt64;
+  end else
+    Result := ReadInteger;
+end;
 
+procedure TReader.ReadListBegin;
+begin
+  CheckValue(vaList);
+end;
 
-Function TReader.ReadString: string;
-
+procedure TReader.ReadListEnd;
 begin
-  ReadString:='';
+  CheckValue(vaNull);
 end;
 
+procedure TReader.ReadProperty(AInstance: TPersistent);
+var
+  Path: String;
+  Instance: TPersistent;
+  DotPos, NextPos: PChar;
+  PropInfo: PPropInfo;
+  Obj: TObject;
+  Name: String;
+begin
+  try
+    Path := FDriver.BeginProperty;
+    try
+      Instance := AInstance;
+      FCanHandleExcepts := True;
+      DotPos := PChar(Path);
+      while True do
+      begin
+        NextPos := StrScan(DotPos, '.');
+	if Assigned(NextPos) then
+  	  FPropName := Copy(String(DotPos), 1, Integer(NextPos - DotPos))
+        else
+	begin
+	  FPropName := DotPos;
+	  break;
+	end;
+
+        PropInfo := GetPropInfo(Instance.ClassInfo, FPropName);
+        if not Assigned(PropInfo) then
+	  PropertyError;
+
+        if PropInfo^.PropType^.Kind = tkClass then
+          Obj := TObject(GetOrdProp(Instance, PropInfo))
+	else
+	  Obj := nil;
+
+        if not Obj.InheritsFrom(TPersistent) then
+	begin
+	  { All path elements must be persistent objects! }
+	  FDriver.SkipValue;
+          raise EReadError.Create(SInvalidPropertyPath);
+	end;
+        Instance := TPersistent(Obj);
+      end;
+
+      PropInfo := GetPropInfo(Instance.ClassInfo, FPropName);
+      if Assigned(PropInfo) then
+        ReadPropValue(Instance, PropInfo)
+      else
+      begin
+        FCanHandleExcepts := False;
+        Instance.DefineProperties(Self);
+        FCanHandleExcepts := True;
+        if Length(FPropName) > 0 then
+	  PropertyError;
+      end;
+    except
+      on e: Exception do
+      begin
+        SetLength(Name, 0);
+        if AInstance.InheritsFrom(TComponent) then
+	  Name := TComponent(AInstance).Name;
+        if Length(Name) = 0 then
+	  Name := AInstance.ClassName;
+        raise EReadError.CreateFmt(SPropertyException,
+	  [Name, DotSep, Path, e.Message]);
+      end;
+    end;
+  except
+    on e: Exception do
+      if not FCanHandleExcepts or not Error(E.Message) then
+        raise;
+  end;
+end;
 
+procedure TReader.ReadPropValue(Instance: TPersistent; PropInfo: Pointer);
+const
+  NullMethod: TMethod = (Code: nil; Data: nil);
+var
+  PropType: PTypeInfo;
+  Value: LongInt;
+  IdentToIntFn: TIdentToInt;
+  Ident: String;
+  Method: TMethod;
+begin
+  if not Assigned(PPropInfo(PropInfo)^.SetProc) then
+    raise EReadError.Create(SReadOnlyProperty);
+
+  PropType := PPropInfo(PropInfo)^.PropType;
+  case PropType^.Kind of
+    tkInteger:
+      if FDriver.NextValue = vaIdent then
+      begin
+        IdentToIntFn := FindIdentToInt(PPropInfo(PropInfo)^.PropType);
+        Ident := ReadIdent;
+        if Assigned(IdentToIntFn) and IdentToIntFn(Ident, Value) then
+          SetOrdProp(Instance, PropInfo, Value)
+        else
+          raise EReadError.Create(SInvalidPropertyValue);
+      end else
+        SetOrdProp(Instance, PropInfo, ReadInteger);
+    tkChar:
+      SetOrdProp(Instance, PropInfo, Ord(ReadChar));
+    tkEnumeration:
+      begin
+        Value := GetEnumValue(PropType, ReadIdent);
+        if Value = -1 then
+          raise EReadError.Create(SInvalidPropertyValue);
+        SetOrdProp(Instance, PropInfo, Value);
+      end;
+    tkFloat:
+      SetFloatProp(Instance, PropInfo, ReadFloat);
+    tkSet:
+      begin
+        CheckValue(vaSet);
+        SetOrdProp(Instance, PropInfo,
+	  FDriver.ReadSet(GetTypeData(PropType)^.CompType));
+      end;
+    tkMethod:
+      if FDriver.NextValue = vaNil then
+      begin
+        FDriver.ReadValue;
+        SetMethodProp(Instance, PropInfo, NullMethod);
+      end else
+      begin
+        Method.Code := FindMethod(Root, ReadIdent);
+        Method.Data := Root;
+        if Assigned(Method.Code) then
+	  SetMethodProp(Instance, PropInfo, Method);
+      end;
+    tkSString, tkLString, tkAString, tkWString:
+      SetStrProp(Instance, PropInfo, ReadString);
+    {!!!: tkVariant}
+    tkClass:
+      case FDriver.NextValue of
+        vaNil:
+          begin
+            FDriver.ReadValue;
+            SetOrdProp(Instance, PropInfo, 0)
+          end;
+        vaCollection:
+          begin
+            FDriver.ReadValue;
+            ReadCollection(TCollection(GetOrdProp(Instance, PropInfo)));
+          end
+        else
+          FFixups.Add(TPropFixup.Create(Instance, Root, PropInfo, '', ReadIdent));
+      end;
+    tkInt64: SetInt64Prop(Instance, PropInfo, ReadInt64);
+  end;
+end;
 
-Function TReader.ReadValue: TValueType;
+function TReader.ReadRootComponent(ARoot: TComponent): TComponent;
+var
+  Dummy, i: Integer;
+  Flags: TFilerFlags;
+  CompClassName, CompName: String;
+begin
+  FDriver.BeginRootComponent;
+  Result := nil;
+  {!!!: GlobalNameSpace.BeginWrite;  // Loading from stream adds to name space
+  try}
+    try
+      FDriver.BeginComponent(Flags, Dummy, 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.Name := CompName;
+      end else
+      begin
+        Result := ARoot;
+
+        if not (csDesigning in Result.ComponentState) then
+        begin
+	  Result.FComponentState :=
+	    Result.FComponentState + [csLoading, csReading];
+
+          if Assigned(FindGlobalComponent) then
+          begin
+	    { We need an unique name }
+            i := 0;
+            Result.Name := CompName;
+            while Assigned(FindGlobalComponent(Result.Name)) do
+            begin
+              Inc(i);
+              Result.Name := CompName + '_' + IntToStr(i);
+            end;
+          end else
+            Result.Name := '';
+        end;
+      end;
+
+      FRoot := Result;
+      FLookupRoot := Result;
+      if Assigned(GlobalLoaded) then
+        FLoaded := GlobalLoaded
+      else
+        FLoaded := TList.Create;
+
+      try
+        if FLoaded.IndexOf(FRoot) < 0 then
+          FLoaded.Add(FRoot);
+        FOwner := FRoot;
+	FRoot.FComponentState := FRoot.FComponentState + [csLoading, csReading];
+        FRoot.ReadState(Self);
+        Exclude(FRoot.FComponentState, csReading);
+
+        if not Assigned(GlobalLoaded) then
+          for i := 0 to FLoaded.Count - 1 do
+	    TComponent(FLoaded[i]).Loaded;
+
+      finally
+        if not Assigned(GlobalLoaded) then
+	  FLoaded.Free;
+        FLoaded := nil;
+      end;
+      GlobalFixupReferences;
+    except
+      RemoveFixupReferences(ARoot, '');
+      if not Assigned(ARoot) then
+        Result.Free;
+      raise;
+    end;
+  {finally
+    GlobalNameSpace.EndWrite;
+  end;}
+end;
 
+procedure TReader.ReadComponents(AOwner, AParent: TComponent;
+  Proc: TReadComponentsProc);
+var
+  Component: TComponent;
 begin
-  ReadValue:=vaNull;
+  Root := AOwner;
+  Owner := AOwner;
+  Parent := AParent;
+  BeginReferences;
+  try
+    while not EndOfList do
+    begin
+      FDriver.BeginRootComponent;
+      Component := ReadComponent(nil);
+      if Assigned(Proc) then
+        Proc(Component);
+    end;
+    ReadListEnd;
+    FixupReferences;
+  finally
+    EndReferences;
+  end;
 end;
 
 
+function TReader.ReadString: String;
+var
+  StringType: TValueType;
+begin
+  StringType := FDriver.ReadValue;
+  if StringType in [vaString, vaLString] then
+    Result := FDriver.ReadString(StringType)
+  else
+    raise EReadError.Create(SInvalidPropertyValue);
+end;
 
-Procedure TReader.CopyValue(Writer: TWriter); {!!!}
+{!!!: function TReader.ReadWideString: WideString;
+begin
+  CheckValue(vaWString);
+  Result := FDriver.ReadWideString;
+end;}
 
+function TReader.ReadValue: TValueType;
 begin
+  Result := FDriver.ReadValue;
 end;
-{
-  $Log$
-  Revision 1.6  2000-01-07 01:24:33  peter
-    * updated copyright to 2000
 
-  Revision 1.5  2000/01/06 01:20:33  peter
-    * moved out of packages/ back to topdir
+procedure TReader.CopyValue(Writer: TWriter);
+
+  procedure CopyBytes(Count: Integer);
+  var
+    Buffer: array[0..1023] of Byte;
+  begin
+{!!!:    while Count > 1024 do
+    begin
+      FDriver.Read(Buffer, 1024);
+      Writer.Driver.Write(Buffer, 1024);
+      Dec(Count, 1024);
+    end;
+    if Count > 0 then
+    begin
+      FDriver.Read(Buffer, Count);
+      Writer.Driver.Write(Buffer, Count);
+    end;}
+  end;
+
+var
+  s: String;
+  Count: LongInt;
+begin
+  case FDriver.NextValue of
+    vaNull:
+      Writer.WriteIdent('NULL');
+    vaFalse:
+      Writer.WriteIdent('FALSE');
+    vaTrue:
+      Writer.WriteIdent('TRUE');
+    vaNil:
+      Writer.WriteIdent('NIL');
+    {!!!: vaList, vaCollection:
+      begin
+        Writer.WriteValue(FDriver.ReadValue);
+        while not EndOfList do
+          CopyValue(Writer);
+        ReadListEnd;
+        Writer.WriteListEnd;
+      end;}
+    vaInt8, vaInt16, vaInt32:
+      Writer.WriteInteger(ReadInteger);
+    vaExtended:
+      Writer.WriteFloat(ReadFloat);
+    {!!!: vaString:
+      Writer.WriteStr(ReadStr);}
+    vaIdent:
+      Writer.WriteIdent(ReadIdent);
+    {!!!: vaBinary, vaLString, vaWString:
+      begin
+        Writer.WriteValue(FDriver.ReadValue);
+        FDriver.Read(Count, SizeOf(Count));
+        Writer.Driver.Write(Count, SizeOf(Count));
+        CopyBytes(Count);
+      end;}
+    {!!!: vaSet:
+      Writer.WriteSet(ReadSet);}
+    vaSingle:
+      Writer.WriteSingle(ReadSingle);
+    {!!!: vaCurrency:
+      Writer.WriteCurrency(ReadCurrency);}
+    vaDate:
+      Writer.WriteDate(ReadDate);
+    vaInt64:
+      Writer.WriteInteger(ReadInt64);
+  end;
+end;
 
-  Revision 1.2  2000/01/04 18:07:16  michael
-  + Streaming implemented
+function TReader.FindComponentClass(const AClassName: String): TComponentClass;
+begin
+  TPersistentClass(Result) := GetFieldClass(Root, AClassName);
+  if not Assigned(Result) and Assigned(FLookupRoot) and (FLookupRoot <> Root) then
+    TPersistentClass(Result) := GetFieldClass(FLookupRoot, AClassName);
+  if Assigned(FOnFindComponentClass) then
+    FOnFindComponentClass(Self, AClassName, Result);
+  if not (Assigned(Result) and Result.InheritsFrom(TComponent)) then
+    raise EClassNotFound.CreateFmt(SClassNotFound, [AClassName]);
+end;
 
-  Revision 1.3  1999/09/13 08:35:16  fcl
-  * Changed some argument names (Root->ARoot etc.) because the new compiler
-    now performs more ambiguity checks  (sg)
 
-  Revision 1.2  1999/04/08 10:18:54  peter
-    * makefile updates
+{
+  $Log$
+  Revision 1.7  2000-06-29 16:29:23  sg
+  * Implemented streaming. Note: The writer driver interface is stable, but
+    the reader interface is not final yet!
 
+  Revision 1.6  2000/01/07 01:24:33  peter
+    * updated copyright to 2000
 }

fcl/inc/streams.inc

@@ -85,111 +85,142 @@
   function TStream.ReadComponent(Instance: TComponent): TComponent;
 
     var
-       Reader : TReader;
+      Reader: TReader;
 
     begin
-(*
-       Reader.Create(Self,1024);
-       if assigned(Instance) then
-         ReadComponent:=Reader.ReadRootComponent(Instance)
-       else
-         begin
-            {!!!!!}
-         end;
-       Reader.Destroy;
-*)
+
+      Reader := TReader.Create(Self, 4096);
+      try
+        Result := Reader.ReadRootComponent(Instance);
+      finally
+        Reader.Free;
+      end;
+
     end;
 
   function TStream.ReadComponentRes(Instance: TComponent): TComponent;
 
     begin
-       {!!!!!}
-       ReadComponentRes:=nil;
+
+      ReadResHeader;
+      Result := ReadComponent(Instance);
+
     end;
 
   procedure TStream.WriteComponent(Instance: TComponent);
 
+    begin
+
+      WriteDescendent(Instance, nil);
+
+    end;
+
+  procedure TStream.WriteComponentRes(const ResName: string; Instance: TComponent);
+
+    begin
+
+      WriteDescendentRes(ResName, Instance, nil);
+
+    end;
+
+  procedure TStream.WriteDescendent(Instance, Ancestor: TComponent);
+
     var
+       Driver : TAbstractObjectWriter;
        Writer : TWriter;
 
     begin
-(*
+
+       Driver := TBinaryObjectWriter.Create(Self, 4096);
        Try
-         Writer.Create(Self,1024);
-         Writer.WriteRootComponent(Instance);
+         Writer := TWriter.Create(Driver);
+	 Try
+           Writer.WriteDescendent(Instance, Ancestor);
+	 Finally
+	   Writer.Destroy;
+	 end;
        Finally
-         Writer.Destroy;
+	 Driver.Free;
        end;
-*)
+
     end;
 
-  procedure TStream.WriteComponentRes(const ResName: string; Instance: TComponent);
+  procedure TStream.WriteDescendentRes(const ResName: string; Instance, Ancestor: TComponent);
 
     var
-       startpos,s : longint;
+      FixupInfo: Integer;
+
+    begin
+
+      { Write a resource header }
+      WriteResourceHeader(ResName, FixupInfo);
+      { Write the instance itself }
+      WriteDescendent(Instance, Ancestor);
+      { Insert the correct resource size into the resource header }
+      FixupResourceHeader(FixupInfo);
+
+    end;
+
+  procedure TStream.WriteResourceHeader(const ResName: string; {!!!: out} var FixupInfo: Integer);
 
     begin
-{$ifdef Win16Res}
        { Numeric resource type }
        WriteByte($ff);
        { Application defined data }
        WriteWord($0a);
        { write the name as asciiz }
-//       WriteBuffer(ResName[1],length(ResName));
+       WriteBuffer(ResName[1],length(ResName));
        WriteByte(0);
        { Movable, Pure and Discardable }
        WriteWord($1030);
-       { size isn't known yet }
+       { Placeholder for the resource size }
        WriteDWord(0);
-       startpos:=GetPosition;
-       WriteComponent(Instance);
-       { calculate size }
-       s:=GetPosition-startpos;
-       { back patch size }
-       SetPosition(startpos-4);
-       WriteDWord(s);
-{$endif Win16Res}
+       { Return current stream position so that the resource size can be
+         inserted later }
+       FixupInfo := Position;
     end;
 
-  procedure TStream.WriteDescendent(Instance, Ancestor: TComponent);
+  procedure TStream.FixupResourceHeader(FixupInfo: Integer);
+
+    var
+       ResSize : Integer;
 
     begin
-       {!!!!!}
-    end;
 
-  procedure TStream.WriteDescendentRes(const ResName: string; Instance, Ancestor: TComponent);
+      ResSize := Position - FixupInfo;
+
+      { Insert the correct resource size into the placeholder written by
+        WriteResourceHeader }
+      Position := FixupInfo - 4;
+      WriteDWord(ResSize);
+      { Seek back to the end of the resource }
+      Position := FixupInfo + ResSize;
 
-    begin
-       {!!!!!}
     end;
 
   procedure TStream.ReadResHeader;
 
     begin
-{$ifdef Win16Res}
        try
          { application specific resource ? }
          if ReadByte<>$ff then
-           raise EInvalidImage.Create('');
+           raise EInvalidImage.Create(SInvalidImage);
          if ReadWord<>$000a then
-           raise EInvalidImage.Create('');
+           raise EInvalidImage.Create(SInvalidImage);
          { read name }
          while ReadByte<>0 do
            ;
          { check the access specifier }
          if ReadWord<>$1030 then
-           raise EInvalidImage.Create('');
+           raise EInvalidImage.Create(SInvalidImage);
          { ignore the size }
          ReadDWord;
        except
-{/////
          on EInvalidImage do
            raise;
          else
            raise EInvalidImage.create(SInvalidImage);
-}
        end;
-{$endif Win16Res}
     end;
 
   function TStream.ReadByte : Byte;
@@ -625,7 +656,11 @@ end;
 
 {
   $Log$
-  Revision 1.20  2000-01-07 01:24:33  peter
+  Revision 1.21  2000-06-29 16:29:23  sg
+  * Implemented streaming. Note: The writer driver interface is stable, but
+    the reader interface is not final yet!
+
+  Revision 1.20  2000/01/07 01:24:33  peter
     * updated copyright to 2000
 
   Revision 1.19  2000/01/06 01:20:33  peter

fcl/inc/twriter.inc

@@ -12,7 +12,7 @@
 
  **********************************************************************}
 
-Procedure TTextWriter.WriteLn(Const Msg : String);
+(*Procedure TTextWriter.WriteLn(Const Msg : String);
 
 Const CRLF = #10;
 
@@ -211,11 +211,15 @@ Procedure TTextWriter.WriteMethodProperty(Const Name,AMethodName : ShortString);
 
 begin
   WriteFmt ('%s = %s',[Name,AMethodName]);
-end;
+end;*)
 
 {
   $Log$
-  Revision 1.3  2000-02-15 21:57:51  sg
+  Revision 1.4  2000-06-29 16:29:23  sg
+  * Implemented streaming. Note: The writer driver interface is stable, but
+    the reader interface is not final yet!
+
+  Revision 1.3  2000/02/15 21:57:51  sg
   * Added copyright notice and CVS log tags where necessary
 
 }

fcl/inc/writer.inc

@@ -11,625 +11,805 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
-{****************************************************************************}
-{*                             TAbstractWriter                                      *}
-{****************************************************************************}
-
-{ $define serdebug}
-
-Procedure TAbstractWriter.AddAncestor(Component: TComponent);
 
-begin
-  FAncestorList.Add(Component);
-end;
 
-Procedure TAbstractWriter.WriteData(Instance: TComponent);
+{****************************************************************************}
+{*                         TBinaryObjectWriter                              *}
+{****************************************************************************}
 
+constructor TBinaryObjectWriter.Create(Stream: TStream; BufSize: Integer);
 begin
-{$ifdef serdebug}
-  Writeln(stderr,'Writer: Starting WriteData');
-{$endif}
-  With Instance do
-    StartObject(ClassName,Name);
-  WriteProperties(Instance);
-  Instance.GetChildren(@WriteComponent,FRoot);
-  EndObject;
+  inherited Create;
+  FStream := Stream;
+  FBufSize := BufSize;
+  GetMem(FBuffer, BufSize);
 end;
 
-{
-  These methods do the main work: decide if a property must be written,
-  and then call the write method.
-  Later on the NeedsWriting function should take the ancestor into
-  account as well, for form inheritance...
-}
-
-
-Procedure TAbstractWriter.DoOrdinalProp(Instance : TPersistent;Propinfo :PPropInfo);
-
-Var
-  Value : longint;
-
+destructor TBinaryObjectWriter.Destroy;
 begin
-  {$ifdef serdebug}
-    Writeln(stderr,'Writer: Starting DoOrdinalProp');
-  {$endif}
-  Value:=GetOrdProp(Instance,Propinfo);
-  If Value<>(PropInfo^.default) then
-    With PropInfo^ do
-      Case PropType^.Kind of
-        tkInteger :  WriteIntegerProperty(Name,Value);
-        tkSet : WriteSetProperty (Name,Value,GetTypeData(Proptype)^.CompType^);
-        tkEnumeration : WriteEnumerationProperty (Name,Value,GetEnumName(Proptype,Value));
-      end;
-end;
+  // Flush all data which hasn't been written yet
+  FlushBuffer;
 
-Procedure TAbstractWriter.DoStringProp(Instance : TPersistent;Propinfo :PPropInfo);
+  if Assigned(FBuffer) then
+    FreeMem(FBuffer, FBufSize);
 
-Var Value : String;
-
-begin
-  {$ifdef serdebug}
-    Writeln(stderr,'Writer: Starting DoStringProp');
-  {$endif}
-  Value:=GetStrProp(Instance,PropInfo);
-  If Value<>'' Then
-    With Propinfo^ do
-      WriteStringProperty(Name,Value);
+  inherited Destroy;
 end;
 
-Procedure TAbstractWriter.DoFloatProp(Instance : TPersistent;Propinfo :PPropInfo);
-
-Var Value : Extended;
-
+procedure TBinaryObjectWriter.BeginCollection;
 begin
-  {$ifdef serdebug}
-    Writeln(stderr,'Writer: Starting DoFloatProp');
-  {$endif}
-  Value:=GetFloatProp(Instance,Propinfo);
-  If (Value<>0.0) then
-    With PropInfo^ do
-      WriteFloatProperty(Name,Value);
+  WriteValue(vaCollection);
 end;
 
-
-Procedure TAbstractWriter.DoCollectionProp(Name: ShortString; Value : TCollection);
-
-Var OldPrefix : String;
-
+procedure TBinaryObjectWriter.BeginComponent(Component: TComponent;
+  Flags: TFilerFlags; ChildPos: Integer);
+var
+  Prefix: Byte;
 begin
-  {$ifdef serdebug}
-    Writeln(stderr,'Writer: Starting DoCollectionProp');
-  {$endif}
-  Try
-    OldPrefix:=FPrefix;
-    FPrefix:='';
-    WriteCollectionProperty(Name,Value)
-  Finally
-    FPrefix:=OldPrefix;
-  end;
-end;
-
-
-Procedure TAbstractWriter.DoClassProp(Instance : TPersistent;Propinfo :PPropInfo);
-
-{
-  Some explanation:
-  1) Only TPersistent properties can be written, since higher has no
-     RTTI (actually, we could test if the class has RTTI if it isn't
-     TPersistent, but Delphi doesn't - We can add it later)
-  2) If it is a TPersistent but not TComponent, then the only
-     thing that is (can be) written is the defineproperties;
-     we have this handled by calling writeproperties again.
-  3) When a property is a TComponent, it is owned by the form or by a
-     TDataModule; This means that the component is streamed also
-     (owner-owned) by the form, so it is sufficient to store a reference
-     to the component, not store the component itself.
-
-     Again, this is very form-oriented; at a later stage, we should see
-     to make this more broader.
-
-}
-
-Var
-  Value : TObject;
-
-  Function NeedsWriting : Boolean;
-
+  if not FSignatureWritten then
   begin
-    Result:=Value<>Nil;
+    Write(FilerSignature, SizeOf(FilerSignature));
+    FSignatureWritten := True;
   end;
 
-  Function GetComponentPath(Component : TComponent): String;
-
+  { Only write the flags if they are needed! }
+  if Flags <> [] then
   begin
-    If Component.Owner=Root Then
-      Result:=Component.Name          // 2 objects In the same form.
-    else if Component=Root then
-      Result:='Owner'                 // Component = Form.
-    else if Component.Owner<>Nil then
-      Result:=Format('%s.%s',[Component.Owner.name,Component.Name]) // Component on other e.g. Datamodule.
-    else
-      Result:=Format('%s.%s',[Component.Name+'owner']); // All other cases.
+    Prefix := Integer(Flags) or $f0;
+    Write(Prefix, 1);
+    if ffChildPos in Flags then
+      WriteInteger(ChildPos);
   end;
 
-Var
-  OldPrefix,CName : String;
+  WriteStr(Component.ClassName);
+  WriteStr(Component.Name);
+end;
 
+procedure TBinaryObjectWriter.BeginList;
 begin
-{$ifdef serdebug}
-  Writeln(stderr,'Writer: Starting DoClassProp');
-{$endif}
-  Value:=TObject(GetOrdProp(Instance,PropInfo));  // get as pointer
-{$ifdef serdebug}
-  If Value=Nil then
-    Writeln(stderr,'Writer: value is nil');
-  Writeln(stderr,'name ',propinfo^.Name);
-{$endif}
-  If (Value=Nil) Then
-    begin
-    If Needswriting then
-      With Propinfo^ do
-        WriteNilProperty(Name)
-    end
-  else
-    If Value is TPersistent then
-      begin
-{$ifdef serdebug}
-  Writeln(stderr,'Writer: value is tpersistent');
-{$endif}
-        If Value is TComponent then
-          { Component is written by itself,
-            just write a reference }
-          begin
-          Cname:=GetComponentPath(TComponent(Value));
-          If NeedsWriting and (Cname<>'') then
-            begin
-              With PropInfo^ do
-                WriteComponentProperty(Name,TComponent(Value));
-            end;
-          end
-        else If Value is TCollection then
-           DoCollectionProp(Propinfo^.Name,TCollection(Value))
-        else
-          With Propinfo^ do
-            begin  // TPersistent, not TComponent.
-            OldPrefix:=FPrefix;
-            FPrefix:=Format('%s%s.',[OldPrefix,Name]); // eg. Memo.Lines.Strings !
-            try
-              WriteProperties(TPersistent(Value));
-            finally
-              FPrefix:=OldPrefix;
-            end;
-          end;
-      end
-   // We can't write it if it isn't a TPersistent...
+  WriteValue(vaList);
 end;
 
-Procedure TAbstractWriter.DoMethodProp(Instance : TPersistent;Propinfo :PPropInfo);
-{
-
-  Some explanation: AFAIK Delphi only allows to assign methods from the
-  current form to an event. (An event is a Method) this means that the
-  instance part of the method IS the Form which IS the 'root' component.
-  this means that we can safely assume that Method.Data = Root...
-
-  Remark also that Form Methods are always in a Published section of the form,
-  Since Delphi manages them, hence the method name is always in RTTI.
-
-  If we want a more general streaming method (i.e. not form oriented) then
-  we would have to write ComponentPath.MethodName or something.
-}
-
-Var
-  Value : TMethod;
-
+procedure TBinaryObjectWriter.EndList;
 begin
-{$ifdef serdebug}
-  Writeln(stderr,'Writer: Starting DoMethodProp');
-{$endif}
-  Value:=GetMethodProp(Instance,Propinfo);
-  With Value do
-    If Code<>Nil then
-      WriteMethodProperty(Propinfo^.Name,Root.MethodName(Code));
+  WriteValue(vaNull);
 end;
 
-Procedure TAbstractWriter.WriteProperty(Instance: TPersistent; PropInfo: Pointer);
-
-{$ifdef serdebug}
-Const
- TypeNames : Array [TTYpeKind] of string[15] =
-            ('Unknown','Integer','Char','Enumeration',
-             'Float','Set','Method','ShortString','LongString',
-             'AnsiString','WideString','Variant','Array','Record',
-             'Interface','Class','Object','WideChar','Bool');
-
- Const OrdinalTypes = [tkInteger,tkChar,tkENumeration,tkbool];
-{$endif}
-
+procedure TBinaryObjectWriter.BeginProperty(const PropName: String);
 begin
-{$ifdef serdebug}
-  Writeln(stderr,'Writer: Starting WriteProperty');
-  With PPropInfo(Propinfo)^ do
-    begin
-    Writeln (stderr,' Type kind: ',TypeNames[PropType^.Kind]);
-    Writeln (stderr,' Type Name: ',PropType^.Name);
-    Writeln (stderr,'Writer: Starting WriteProperty');
-    end;
-{$endif}
-  // Dispatching routine. For compatibility only.
-  With PPropinfo(Propinfo)^ do
-    Case PropType^.Kind of
-      tkchar,tkInteger,tkenumeration,tkset : DoOrdinalProp(Instance,Propinfo);
-      tkAstring,tkstring,tkLString,tkWstring : DoStringProp(Instance,Propinfo);
-      tkfloat : DoFloatProp(Instance,PropInfo);
-      tkClass : DoClassProp(Instance,PropInfo);
-      tkMethod : DoMethodProp(Instance,PropInfo);
-    end;
+  WriteStr(PropName);
 end;
 
-
-Procedure TAbstractWriter.WriteProperties(Instance: TPersistent);
-
-Var I,PropCount : Longint;
-    Props : PPropList;
-
+procedure TBinaryObjectWriter.EndProperty;
 begin
-{$ifdef serdebug}
-  Writeln(stderr,'Writer: Starting WriteProperties');
-{$endif}
-  PropCount:=GetTypeData(Instance.ClassInfo)^.PropCount;
-{$ifdef serdebug}
-  Writeln(stderr,'Writer : Propcount: ',PropCount);
-{$endif}
-  Try
-    GetMem (Props,SizeOf(Pointer)*PropCount);
-    GetPropInfos(Instance.ClassInfo,Props);
-    For I:=0 to PropCount-1 do
-      WriteProperty(Instance,Props^[I]);
-  finally
-    FreeMem(Props);
-  end;
-//  Instance.DefineProperties(Self);
 end;
 
-Destructor TAbstractWriter.Destroy;
-
+procedure TBinaryObjectWriter.WriteBinary(const Buffer; Count: LongInt);
 begin
+  WriteValue(vaBinary);
+  Write(Count, 4);
+  Write(Buffer, Count);
 end;
 
-Procedure TAbstractWriter.WriteDescendent(ARoot: TComponent; AAncestor: TComponent);
-
+procedure TBinaryObjectWriter.WriteBoolean(Value: Boolean);
 begin
-{$ifdef serdebug}
-  Writeln(stderr,'Writer: Starting WriteDescendent');
-{$endif}
-  FRootAncestor:=AAncestor;
-  FAncestor:=Ancestor;
-  FRoot:=ARoot;
-  WriteComponent(ARoot)
+  if Value then
+    WriteValue(vaTrue)
+  else
+    WriteValue(vaFalse);
 end;
 
-
-Procedure TAbstractWriter.WriteRootComponent(ARoot: TComponent);
-
+procedure TBinaryObjectWriter.WriteFloat(const Value: Extended);
 begin
-{$ifdef serdebug}
-  Writeln(stderr,'Writer: Starting WriteRootComponent');
-{$endif}
-  WriteDescendent(ARoot,Nil);
+  WriteValue(vaExtended);
+  Write(Value, SizeOf(Value));
 end;
 
-procedure TAbstractWriter.WriteComponent(Component: TComponent);
-
-Var I : longint;
-    TheAncestor : TComponent;
-
+procedure TBinaryObjectWriter.WriteSingle(const Value: Single);
 begin
-{$ifdef serdebug}
-  Writeln(stderr,'Writer: Starting WriteComponent');
-{$endif}
-  Include(Component.FComponentState,csWriting);
-  TheAncestor:=Nil;
-  If Assigned(FAncestorList) then
-    For I:=0 to FAncestorList.Count-1 do
-      If TComponent(FAncestorList[i]).Name=Component.Name then
-        begin
-        TheAncestor:=Tcomponent(FancestorList[i]);
-        break;
-        end;
-  Ancestor:=TheAncestor;
-  Component.WriteState(Self);
-  Exclude(Component.FComponentState,csWriting);
+  WriteValue(vaSingle);
+  Write(Value, SizeOf(Value));
 end;
 
+{!!!: procedure TBinaryObjectWriter.WriteCurrency(const Value: Currency);
+begin
+  WriteValue(vaCurrency);
+  Write(Value, SizeOf(Value));
+end;}
 
-{ ---------------------------------------------------------------------
-    TWriter Methods
-  ---------------------------------------------------------------------}
-
-Constructor TWriter.Create(S : TStream);
-
+procedure TBinaryObjectWriter.WriteDate(const Value: TDateTime);
 begin
-  FStream:=S;
+  WriteValue(vaDate);
+  Write(Value, SizeOf(Value));
 end;
 
-
-Destructor TWriter.Destroy;
-
+procedure TBinaryObjectWriter.WriteIdent(const Ident: string);
 begin
+  { Check if Ident is a special identifier before trying to just write
+    Ident directly }
+  if UpperCase(Ident) = 'NIL' then
+    WriteValue(vaNil)
+  else if UpperCase(Ident) = 'FALSE' then
+    WriteValue(vaFalse)
+  else if UpperCase(Ident) = 'TRUE' then
+    WriteValue(vaTrue)
+  else if UpperCase(Ident) = 'NULL' then
+    WriteValue(vaNull) else
+  begin
+    WriteValue(vaIdent);
+    WriteStr(Ident);
+  end;
 end;
 
-Procedure TWriter.FlushBuffer;
-
+procedure TBinaryObjectWriter.WriteInteger(Value: Int64);
 begin
-  // For compatibility only.
+  { Use the smallest possible integer type for the given value: }
+  if (Value >= -128) and (Value <= 127) then
+  begin
+    WriteValue(vaInt8);
+    Write(Value, 1);
+  end else if (Value >= -32768) and (Value <= 32767) then
+  begin
+    WriteValue(vaInt16);
+    Write(Value, 2);
+  end else if (Value >= -$80000000) and (Value <= $7fffffff) then
+  begin
+    WriteValue(vaInt32);
+    Write(Value, 4);
+  end else
+  begin
+    WriteValue(vaInt64);
+    Write(Value, 8);
+  end;
 end;
 
-
-Procedure TWriter.Write(const Buf; Count: Longint);
-
+procedure TBinaryObjectWriter.WriteMethodName(const Name: String);
 begin
-  FStream.Write(Buf,Count);
+  if Length(Name) > 0 then
+  begin
+    WriteValue(vaIdent);
+    WriteStr(Name);
+  end else
+    WriteValue(vaNil);
 end;
 
-Procedure TWriter.WriteIntegerProperty(Const Name : Shortstring;Value : Longint);
-
+procedure TBinaryObjectWriter.WriteSet(Value: LongInt; SetType: Pointer);
+var
+  i: Integer;
+  Mask: LongInt;
 begin
-  WritePropName(Name);
-  WriteInteger(Value);
+  WriteValue(vaSet);
+  Mask := 1;
+  for i := 0 to 31 do
+  begin
+    if (Value and Mask) <> 0 then
+      WriteStr(GetEnumName(PTypeInfo(SetType), i));
+    Mask := Mask shl 1;
+  end;
+  WriteStr('');
 end;
 
-
-Procedure TWriter.WriteSetProperty (Const Name : ShortString;Value : longint; BaseType : TTypeInfo);
-
+procedure TBinaryObjectWriter.WriteString(const Value: String);
+var
+  i: Integer;
 begin
-  WritePropName(Name);
+  i := Length(Value);
+  if i <= 255 then
+  begin
+    WriteValue(vaString);
+    Write(i, 1);
+  end else
+  begin
+    WriteValue(vaLString);
+    Write(i, 4);
+  end;
+  if i > 0 then
+    Write(Value[1], i);
 end;
 
+{!!!: procedure TBinaryObjectWriter.WriteWideString(const Value: WideString);
+var
+  i: Integer;
+begin
+  WriteValue(vaWString);
+  i := Length(Value);
+  Write(i, 4);
+  Write(Value[1], i * 2);
+end;}
 
-Procedure TWriter.WriteEnumerationProperty (Const Name : ShortString;Value : Longint; Const EnumName : ShortSTring);
-
+procedure TBinaryObjectWriter.FlushBuffer;
 begin
-  WritePropName(Name);
-  WriteIdent(EnumName);
+  FStream.WriteBuffer(FBuffer^, FBufPos);
+  FBufPos := 0;
 end;
 
-
-Procedure TWriter.WriteStringProperty(Const Name : ShortString; Const Value : String);
-
+procedure TBinaryObjectWriter.Write(const Buffer; Count: LongInt);
+var
+  CopyNow: LongInt;
 begin
-  WritePropName(Name);
-  WriteString(Value);
+  while Count > 0 do
+  begin
+    CopyNow := Count;
+    if CopyNow > FBufSize - FBufPos then
+      CopyNow := FBufSize - FBufPos;
+    Move(Buffer, PChar(FBuffer)[FBufPos], CopyNow);
+    Dec(Count, CopyNow);
+    Inc(FBufPos, CopyNow);
+    if FBufPos = FBufSize then
+      FlushBuffer;
+  end;
 end;
 
-
-Procedure TWriter.WriteFloatProperty(Const Name : ShortString; Value : Extended);
-
+procedure TBinaryObjectWriter.WriteValue(Value: TValueType);
 begin
-  WritePropName(Name);
-  WriteFloat(Value);
+  Write(Value, 1);
 end;
 
-
-Procedure TWriter.WriteCollectionProperty(Const Name : ShortString;Value : TCollection);
-
+procedure TBinaryObjectWriter.WriteStr(const Value: String);
+var
+  i: Integer;
 begin
+  i := Length(Value);
+  if i > 255 then
+    i := 255;
+  Write(i, 1);
+  if i > 0 then
+    Write(Value[1], i);
 end;
 
 
-Procedure TWriter.WriteClassProperty(Instance : TPersistent;Propinfo :PPropInfo);
-
-begin
-end;
 
+{****************************************************************************}
+{*                             TWriter                                      *}
+{****************************************************************************}
 
-Procedure TWriter.WriteComponentProperty(Const Name : ShortString; Value : TComponent);
 
+constructor TWriter.Create(ADriver: TAbstractObjectWriter);
 begin
-  WritePropName(Name);
-  WriteIdent(Value.Name);
+  inherited Create;
+  FDriver := ADriver;
 end;
 
-
-Procedure TWriter.WriteNilProperty(Const Name : Shortstring);
-
+constructor TWriter.Create(Stream: TStream; BufSize: Integer);
 begin
-  WritePropName(Name);
-  WriteValue(vaNil)
+  inherited Create;
+  FDriver := TBinaryObjectWriter.Create(Stream, BufSize);
+  FDestroyDriver := True;
 end;
 
-
-Procedure TWriter.WriteMethodProperty(Const Name,AMethodName : Shortstring);
-
+destructor TWriter.Destroy;
 begin
+  if FDestroyDriver then
+    FDriver.Free;
+  inherited Destroy;
 end;
 
-
-procedure TWriter.WriteBoolean(Value: Boolean);
-
+// Used as argument for calls to TComponent.GetChildren:
+procedure TWriter.AddToAncestorList(Component: TComponent);
 begin
-  If Value then WriteValue(vaTrue) else WriteValue(vaFalse)
+  FAncestorList.Add(Component);
 end;
 
-
-procedure TWriter.WriteCollection(Value: TCollection);
-
+procedure TWriter.DefineProperty(const Name: String;
+  ReadData: TReaderProc; AWriteData: TWriterProc; HasData: Boolean);
 begin
+  if HasData and Assigned(AWriteData) then
+  begin
+    // Write the property name and then the data itself
+    Driver.BeginProperty(FPropPath + Name);
+    AWriteData(Self);
+    Driver.EndProperty;
+  end;
 end;
 
-
-procedure TWriter.WriteChar(Value: Char);
-
+procedure TWriter.DefineBinaryProperty(const Name: String;
+  ReadData, AWriteData: TStreamProc; HasData: Boolean);
 begin
+  if HasData and Assigned(AWriteData) then
+  begin
+    // Write the property name and then the data itself
+    Driver.BeginProperty(FPropPath + Name);
+    WriteBinary(AWriteData);
+    Driver.EndProperty;
+  end;
 end;
 
+procedure TWriter.SetRoot(ARoot: TComponent);
+begin
+  inherited SetRoot(ARoot);
+  // Use the new root as lookup root too
+  FLookupRoot := ARoot;
+end;
 
-procedure TWriter.WriteFloat(Value: Extended);
-
+procedure TWriter.WriteBinary(AWriteData: TStreamProc);
+var
+  MemBuffer: TMemoryStream;
+  BufferSize: Longint;
 begin
+  { First write the binary data into a memory stream, then copy this buffered
+    stream into the writing destination. This is necessary as we have to know
+    the size of the binary data in advance (we're assuming that seeking within
+    the writer stream is not possible) }
+  MemBuffer := TMemoryStream.Create;
+  try
+    AWriteData(MemBuffer);
+    BufferSize := MemBuffer.Size;
+    Driver.WriteBinary(MemBuffer.Memory^, BufferSize);
+  finally
+    MemBuffer.Free;
+  end;
 end;
 
+procedure TWriter.WriteBoolean(Value: Boolean);
+begin
+  Driver.WriteBoolean(Value);
+end;
 
-procedure TWriter.WriteIdent(const Ident: string);
+procedure TWriter.WriteChar(Value: Char);
+begin
+  WriteString(Value);
+end;
 
+procedure TWriter.WriteCollection(Value: TCollection);
+var
+  i: Integer;
 begin
-  if (Ident='Nil') then WriteValue(vaNil) else
-  if (Ident='True') then WriteValue(vaTrue) else
-  If (Ident='False') then WriteValue(vaFalse) else
+  Driver.BeginCollection;
+  if Assigned(Value) then
+    for i := 0 to Value.Count - 1 do
     begin
-    WriteValue(vaIdent);
-    WriteStr(Ident);
-    end
+      { Each collection item needs its own ListBegin/ListEnd tag, or else the
+        reader wouldn't be able to know where an item ends and where the next
+	one starts }
+      WriteListBegin;
+      WriteProperties(Value.Items[i]);
+      WriteListEnd;
+    end;
+  WriteListEnd;
 end;
 
+procedure TWriter.WriteComponent(Component: TComponent);
+var
+  SavedAncestor: TPersistent;
+  SavedRootAncestor, AncestorComponent, CurAncestor: TComponent;
+  i: Integer;
+  s: String;
+begin
+  SavedAncestor := Ancestor;
+  SavedRootAncestor := RootAncestor;
 
-procedure TWriter.WriteInteger(Value: Longint);
+  try
+    // The component has to know that it is being written now...
+    Include(Component.FComponentState, csWriting);
 
-begin
-  If (Value>=-128) and (Value<=127) then
+    // Locate the component in the ancestor list, if necessary
+    if Assigned(FAncestorList) then
     begin
-    WriteValue(vaInt8);
-    Write(Value,SizeOf(ShortInt));
-    end
-  else If (Value>=-32768) and (Value<=32767) then
+      Ancestor := nil;
+      s := UpperCase(Component.Name);
+      for i := 0 to FAncestorList.Count - 1 do
+      begin
+        CurAncestor := TComponent(FAncestorList[i]);
+        if UpperCase(CurAncestor.Name) = s then
+	begin
+	  Ancestor := CurAncestor;
+	  break;
+	end;
+      end;
+    end;
+
+    // Do we have to call the OnFindAncestor callback?
+    if Assigned(FOnFindAncestor) and
+      ((not Assigned(Ancestor)) or Ancestor.InheritsFrom(TComponent)) then
     begin
-    WriteValue(vaInt16);
-    Write(Value,SizeOf(SmallInt));
-    end
- else
-   begin
-   WriteValue(vaInt32);
-   Write(Value,SizeOf(Longint));
-   end;
-end;
+      AncestorComponent := TComponent(Ancestor);
+      FOnFindAncestor(Self, Component, Component.Name,
+        AncestorComponent, FRootAncestor);
+      Ancestor := AncestorComponent;
+    end;
 
+    // Finally write the component state
+    Component.WriteState(Self);
 
-procedure TWriter.WriteListBegin;
+    // The writing has been finished now...
+    Exclude(Component.FComponentState, csWriting);
 
-begin
-  WriteValue(vaList);
+  finally
+    Ancestor := SavedAncestor;
+    FRootAncestor := SavedRootAncestor;
+  end;
 end;
 
+procedure TWriter.WriteComponentData(Instance: TComponent);
+var
+  SavedAncestorList: TList;
+  SavedRoot, SavedRootAncestor: TComponent;
+  SavedAncestorPos, SavedChildPos: Integer;
+  Flags: TFilerFlags;
+begin
+  // Determine the filer flags to store
+  if Assigned(Ancestor) and ((not (csInline in Instance.ComponentState)) or
+    ((csAncestor in Instance.ComponentState) and Assigned(FAncestorList))) then
+    Flags := [ffInherited]
+  else if csInline in Instance.ComponentState then
+    Flags := [ffInline]
+  else
+    Flags := [];
 
-procedure TWriter.WriteListEnd;
+  if Assigned(FAncestorList) and (FAncestorPos < FAncestorList.Count) and
+    ((not Assigned(Ancestor)) or
+    (TPersistent(FAncestorList[FAncestorPos]) <> Ancestor)) then
+    Include(Flags, ffChildPos);
 
-begin
-  WriteValue(vaNull)
-end;
+  Driver.BeginComponent(Instance, Flags, FChildPos);
 
+  if Assigned(FAncestorList) and (FAncestorPos < FAncestorList.Count) then
+  begin
+    if Assigned(Ancestor) then
+      Inc(FAncestorPos);
+    Inc(FChildPos);
+  end;
 
-procedure TWriter.WriteSignature;
+  // Write property list
+  WriteProperties(Instance);
+  WriteListEnd;
+
+  // Write children list
+  SavedAncestorList := FAncestorList;
+  SavedAncestorPos := FAncestorPos;
+  SavedChildPos := FChildPos;
+  SavedRoot := FRoot;
+  SavedRootAncestor := FRootAncestor;
+  try
+    FAncestorList := nil;
+    FAncestorPos := 0;
+    FChildPos := 0;
+    if not IgnoreChildren then
+      try
+        // Set up the ancestor list if we have an ancestor
+        if Assigned(FAncestor) and FAncestor.InheritsFrom(TComponent) then
+        begin
+          if csInline in TComponent(FAncestor).ComponentState then
+            FRootAncestor := TComponent(FAncestor);
+          FAncestorList := TList.Create;
+          TComponent(FAncestor).GetChildren(@AddToAncestorList, FRootAncestor);
+        end;
 
-begin
-  Write(FilerSignature,SizeOf(FilerSignature));
-end;
+        if csInline in Instance.ComponentState then
+          FRoot := Instance;
 
+        Instance.GetChildren(@WriteComponent, FRoot);
 
-procedure TWriter.WriteStr(const Value: string);
+      finally
+        FAncestorList.Free;
+      end;
 
-Var L : longint;
+  finally
+    FAncestorList := SavedAncestorList;
+    FAncestorPos := SavedAncestorPos;
+    FChildPos := SavedChildPos;
+    FRoot := SavedRoot;
+    FRootAncestor := SavedRootAncestor;
+  end;
 
-begin
-  L:=Length(Value);
-  If L>255 then
-    L:=255;
-  Write(L,SizeOf(Byte));
-  Write(Pointer(Value)^,L);
+  WriteListEnd;
 end;
 
+procedure TWriter.WriteDescendent(ARoot: TComponent; AAncestor: TComponent);
+begin
+  FRoot := ARoot;
+  FAncestor := AAncestor;
+  FRootAncestor := AAncestor;
+  FLookupRoot := ARoot;
 
-procedure TWriter.WriteString(const Value: string);
-
-Var L : longint;
+  WriteComponent(ARoot);
+end;
 
+procedure TWriter.WriteFloat(const Value: Extended);
 begin
-  L:=Length(Value);
-  If L<=255 then
-    begin
-    WriteValue(vastring);
-    Write(L,SizeOf(Byte));
-    end
-  else
-    begin
-    WriteValue(vaLstring);
-    Write(L,SizeOf(Longint))
-    end;
-  Write(Pointer(Value)^,L);
+  Driver.WriteFloat(Value);
 end;
 
-Procedure TWriter.WritePrefix(Flags: TFilerFlags; AChildPos: Integer);
-
+procedure TWriter.WriteSingle(const Value: Single);
 begin
+  Driver.WriteSingle(Value);
 end;
 
-Procedure TWriter.WriteValue(Value : TValueType);
+{!!!: procedure TWriter.WriteCurrency(const Value: Currency);
+begin
+  Driver.WriteCurrency(Value);
+end;}
 
+procedure TWriter.WriteDate(const Value: TDateTime);
 begin
-  Write(Value,SizeOf(Value));
+  Driver.WriteDate(Value);
 end;
 
-Procedure TWriter.WriteBuffer;
-
+procedure TWriter.WriteIdent(const Ident: string);
 begin
-  // For compatibility only.
+  Driver.WriteIdent(Ident);
 end;
 
-function  TWriter.GetPosition: Longint;
-
+procedure TWriter.WriteInteger(Value: LongInt);
 begin
-  GetPosition:=0;
+  Driver.WriteInteger(Value);
 end;
 
-
-Procedure TWriter.SetPosition(Value: Longint);
-
+procedure TWriter.WriteInteger(Value: Int64);
 begin
+  Driver.WriteInteger(Value);
 end;
 
-Procedure TWriter.WriteBinary(wd : TStreamProc);
-
+procedure TWriter.WriteListBegin;
 begin
+  Driver.BeginList;
 end;
 
-Procedure TWriter.WritePropName(const PropName: string);
-
+procedure TWriter.WriteListEnd;
 begin
-  WriteStr(PropName)
+  Driver.EndList;
 end;
 
-Procedure TWriter.DefineProperty(const Name: string;
-  rd : TReaderProc; wd : TWriterProc;
-  HasData: Boolean);
-
+procedure TWriter.WriteProperties(Instance: TPersistent);
+var
+  i, PropCount: Integer;
+  PropInfo: PPropInfo;
+  PropList: PPropList;
 begin
-end;
+  { First step: Write the properties given by the RTTI for Instance }
+  PropCount := GetTypeData(Instance.ClassInfo)^.PropCount;
+  if PropCount > 0 then
+  begin
+    GetMem(PropList, PropCount * SizeOf(PPropInfo));
+    try
+      GetPropInfos(Instance.ClassInfo, PropList);
+      for i := 0 to PropCount - 1 do
+      begin
+        PropInfo := PropList^[i];
+        if IsStoredProp(Instance, PropInfo) then
+          WriteProperty(Instance, PropInfo);
+      end;
+    finally
+      FreeMem(PropList);
+    end;
+  end;
+
+  { Second step: Give Instance the chance to write its own private data }
+  Instance.DefineProperties(Self);
+end;
+
+procedure TWriter.WriteProperty(Instance: TPersistent; PropInfo: Pointer);
+var
+  HasAncestor: Boolean;
+  PropType: PTypeInfo;
+  Value, DefValue: LongInt;
+  Ident: String;
+  IntToIdentFn: TIntToIdent;
+  FloatValue, DefFloatValue: Extended;
+  MethodValue: TMethod;
+  DefMethodCodeValue: Pointer;
+  StrValue, DefStrValue: String;
+  AncestorObj: TObject;
+  Component: TComponent;
+  ObjValue: TObject;
+  SavedAncestor: TPersistent;
+  SavedPropPath, Name: String;
+  Int64Value, DefInt64Value: Int64;
+begin
+
+  if (not Assigned(PPropInfo(PropInfo)^.SetProc)) or
+    (not Assigned(PPropInfo(PropInfo)^.GetProc)) then
+    exit;
+
+  { Check if the ancestor can be used }
+  HasAncestor := Assigned(Ancestor) and ((Instance = Root) or
+    (Instance.ClassType = Ancestor.ClassType));
+
+  PropType := PPropInfo(PropInfo)^.PropType;
+  case PropType^.Kind of
+    tkInteger, tkChar, tkEnumeration, tkSet:
+      begin
+        Value := GetOrdProp(Instance, PropInfo);
+        if HasAncestor then
+          DefValue := GetOrdProp(Ancestor, PropInfo)
+        else
+          DefValue := PPropInfo(PropInfo)^.Default;
+
+        if Value <> DefValue then
+        begin
+	  Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
+          case PropType^.Kind of
+            tkInteger:
+      	      begin
+		// Check if this integer has a string identifier
+		IntToIdentFn := FindIntToIdent(PPropInfo(PropInfo)^.PropType);
+		if Assigned(IntToIdentFn) and IntToIdentFn(Value, Ident) then
+	          // Integer can be written a human-readable identifier
+	          WriteIdent(Ident)
+		else
+	          // Integer has to be written just as number
+	          WriteInteger(Value);
+	      end;
+    	    tkChar:
+              WriteChar(Chr(Value));
+    	    tkSet:
+	      Driver.WriteSet(Value, GetTypeData(PropType)^.CompType);
+    	    tkEnumeration:
+              WriteIdent(GetEnumName(PropType, Value));
+          end;
+	  Driver.EndProperty;
+	end;
+      end;
+    tkFloat:
+      begin
+        FloatValue := GetFloatProp(Instance, PropInfo);
+        if HasAncestor then
+          DefFloatValue := GetFloatProp(Ancestor, PropInfo)
+        else
+          DefFloatValue := 0;
+        if FloatValue <> DefFloatValue then
+        begin
+	  Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
+          WriteFloat(FloatValue);
+	  Driver.EndProperty;
+        end;
+      end;
+    tkMethod:
+      begin
+        MethodValue := GetMethodProp(Instance, PropInfo);
+        if HasAncestor then
+          DefMethodCodeValue := GetMethodProp(Ancestor, PropInfo).Code
+        else
+          DefMethodCodeValue := nil;
 
+        if (MethodValue.Code <> DefMethodCodeValue) and
+          ((not Assigned(MethodValue.Code)) or
+          ((Length(FLookupRoot.MethodName(MethodValue.Code)) >= 0))) then
+        begin
+          Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
+          if Assigned(MethodValue.Code) then
+            Driver.WriteMethodName(FLookupRoot.MethodName(MethodValue.Code))
+          else
+            Driver.WriteMethodName('');
+	  Driver.EndProperty;
+        end;
+      end;
+    tkSString, tkLString, tkAString, tkWString:
+      // !!!: Can we really handle WideStrings here?
+      begin
+        StrValue := GetStrProp(Instance, PropInfo);
+        if HasAncestor then
+          DefStrValue := GetStrProp(Ancestor, PropInfo)
+        else
+          SetLength(DefStrValue, 0);
 
-Procedure TWriter.DefineBinaryProperty(const Name: string;
-  rd, wd: TStreamProc;
-  HasData: Boolean);
+        if StrValue <> DefStrValue then
+        begin
+          Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
+          WriteString(StrValue);
+	  Driver.EndProperty;
+        end;
+      end;
+  {!!!: tkVariant:}
+    tkClass:
+      begin
+        ObjValue := TObject(GetOrdProp(Instance, PropInfo));
+        if HasAncestor then
+        begin
+          AncestorObj := TObject(GetOrdProp(Ancestor, PropInfo));
+          if Assigned(AncestorObj) then
+            if Assigned(ObjValue) and
+              (TComponent(AncestorObj).Owner = FRootAncestor) and
+    	      (TComponent(ObjValue).Owner = Root) and
+              (UpperCase(TComponent(AncestorObj).Name) = UpperCase(TComponent(ObjValue).Name)) then
+              AncestorObj := ObjValue
+	    else
+	      AncestorObj := nil;
+	end else
+          AncestorObj := nil;
+
+	if (not Assigned(ObjValue)) and (ObjValue <> AncestorObj) then
+	begin
+          Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
+	  Driver.WriteIdent('NIL');
+	  Driver.EndProperty;
+	end else if ObjValue.InheritsFrom(TPersistent) then
+          if ObjValue.InheritsFrom(TComponent) then
+          begin
+	    Component := TComponent(ObjValue);
+	    if ObjValue <> AncestorObj then
+    	    begin
+	      { Determine the correct name of the component this property contains }
+              if Component.Owner = LookupRoot then
+        	Name := Component.Name
+              else if Component = LookupRoot then
+        	Name := 'Owner'
+              else if Assigned(Component.Owner) and (Length(Component.Owner.Name) > 0)
+        	and (Length(Component.Name) > 0) then
+        	Name := Component.Owner.Name + '.' + Component.Name
+              else if Length(Component.Name) > 0 then
+        	Name := Component.Name + '.Owner'
+              else
+		SetLength(Name, 0);
+
+              if Length(Name) > 0 then
+              begin
+		Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
+        	WriteIdent(Name);
+		Driver.EndProperty;
+              end;
+	    end;
+          end else if ObjValue.InheritsFrom(TCollection) then
+          begin
+    	    if (not HasAncestor) or (not CollectionsEqual(TCollection(ObjValue),
+              TCollection(GetOrdProp(Ancestor, PropInfo)))) then
+	    begin
+	      Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
+              SavedPropPath := FPropPath;
+              try
+        	SetLength(FPropPath, 0);
+        	WriteCollection(TCollection(ObjValue));
+              finally
+        	FPropPath := SavedPropPath;
+		Driver.EndProperty;
+              end;
+    	    end;
+          end else
+          begin
+    	    SavedAncestor := Ancestor;
+    	    SavedPropPath := FPropPath;
+    	    try
+              FPropPath := FPropPath + PPropInfo(PropInfo)^.Name + '.';
+              if HasAncestor then
+        	Ancestor := TPersistent(GetOrdProp(Ancestor, PropInfo));
+              WriteProperties(TPersistent(ObjValue));
+    	    finally
+              Ancestor := SavedAncestor;
+              FPropPath := SavedPropPath;
+    	    end;
+          end;
+      end;
+    tkInt64:
+      begin
+        Int64Value := GetInt64Prop(Instance, PropInfo);
+        if HasAncestor then
+          DefInt64Value := GetInt64Prop(Ancestor, PropInfo)
+        else
+          DefInt64Value := 0;
 
-begin
+        if Int64Value <> DefInt64Value then
+        begin
+          Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
+          WriteInteger(Int64Value);
+	  Driver.EndProperty;
+        end;
+      end;
+  end;
 end;
 
-Procedure TAbstractWriter.DefineProperty(const Name: string;
-  rd : TReaderProc; wd : TWriterProc;
-  HasData: Boolean);
-
+procedure TWriter.WriteRootComponent(ARoot: TComponent);
 begin
+  WriteDescendent(ARoot, nil);
 end;
 
-
-Procedure TAbstractWriter.DefineBinaryProperty(const Name: string;
-  rd, wd: TStreamProc;
-  HasData: Boolean);
-
+procedure TWriter.WriteString(const Value: String);
 begin
+  Driver.WriteString(Value);
 end;
 
+{!!!: procedure TWriter.WriteWideString(const Value: WideString);
+begin
+  Driver.WriteWideString(Value);
+end;}
+
+
 {
   $Log$
-  Revision 1.6  2000-01-07 01:24:33  peter
+  Revision 1.7  2000-06-29 16:29:23  sg
+  * Implemented streaming. Note: The writer driver interface is stable, but
+    the reader interface is not final yet!
+
+  Revision 1.6  2000/01/07 01:24:33  peter
     * updated copyright to 2000
 
   Revision 1.5  2000/01/06 01:20:33  peter