clserializers.pas

用Delphi实现的数据库持久化

      tkInteger, tkChar: Prop.AsInteger := ReadInteger( sSection, Prop.Name );
      tkString, tkLString, tkWString, tkEnumeration, tkSet:
        begin
          Prop.AsString := ReadString( sSection, Prop.Name );
        end;
      tkFloat:
        begin
          if SameText( Prop.TypeInfo.Name, 'TDateTime' ) then
          begin
            Prop.AsFloat := ReadDateTime( sSection, Prop.Name );
          end
          else if SameText( Prop.TypeInfo.Name, 'TTime' ) then
          begin
            Prop.AsFloat := ReadTime( sSection, Prop.Name );
          end
          else if SameText( Prop.TypeInfo.Name, 'TDate' ) then
          begin
            Prop.AsFloat := ReadDate( sSection, Prop.Name );
          end
          else
            Prop.AsFloat := ReadFloat( sSection, Prop.Name );
        end;
      tkClass:
        begin
          if Prop.IsDelegate then
          begin
            LoadSubObject( sSection + '\' + Prop.Name, Prop.AsObject );
          end
          else
          begin
            if Prop.ObjClassType = TComponent then
            begin
              Prop.AsObject := rtFindGlobalComponent(
                ReadString( sSection, Prop.Name ) );
            end;
          end;
        end;
    end;
  end;
end;

function TclAbstractSerializer.DoDeserializeTo(Target: TObject; sSection: string ): string;
var
  TargetWrapper: TrtWrapper;
begin
  Assert( Assigned( Target ),
    Format(ERR_OBJISNIL, ['DoDeserializeTo', 'Target'] ));

  TargetWrapper := nil;
  try
    TargetWrapper := TrtWrapper.Create( Target );

    Result := DoDeserializeTo( TargetWrapper, sSection );
  finally
    TargetWrapper.Free;
  end;
end;

procedure TclAbstractSerializer.DoSerializeFrom(Source: TrtWrapper; sSection: string );
  {
  StoreSubObject
  Stores a SubObject in the specified SubSection in the IniFile.

  This method provides any special handling required for special subobjects,
  such as TCollection and TStrings.
  }
  procedure StoreSubObject( SubSection: string; SubObject: TObject );
  var
    SubWrapper: TrtWrapper;

    Strings: TStrings;
    nSLine: integer;

    Collection: TCollection;
    nCItem: integer;
  begin
    if not Assigned( SubObject ) then exit;
    SubWrapper := nil;
    try
      //Create a TrtWrapper and configure it with the same settings as Source
      SubWrapper := TrtWrapper.Create( SubObject, Source.VisiblePropKinds );
      SubWrapper.StopNames := Source.StopNames;

      RemoveSection( SubSection );
      CreateSection( SubSection );

      if SubObject is TStrings then
      begin  //Write out the text property of a TStrings
        Strings := TStrings( SubObject );
        for nSLine := 0 to Strings.Count - 1 do
          WriteString( SubSection, 'Line' + InttoStr(nSLine), Strings[nSLine] );
      end
      else  //Save the SubObject
        DoSerializeFrom( SubWrapper, SubSection );

      //If the SubObject is a collection, write out the collection items
      if SubObject is TCollection then
      begin
        //Create a section to indicate that the collection property's sub-
        //  items are stored.
        WriteString( SubSection, 'rt_TCollection', '1' );

        //Clear any existing collection item sections
        nCItem := 0;
        while SectionExists( FormatSubSection( SubSection, 'CItem' + InttoStr( nCItem ) ) ) do
        begin
          RemoveSection( FormatSubSection( SubSection, 'CItem' + InttoStr( nCItem ) ) );
          inc( nCItem );
        end;

        //Store collection items
        Collection := TCollection( SubObject );
        for nCItem := 0 to Collection.Count - 1 do
        begin
          StoreSubObject( FormatSubSection( SubSection, 'CItem' + InttoStr( nCItem ) ),
            Collection.Items[nCItem] );
        end;
      end;

    finally
      SubWrapper.Free;
    end;
  end;
var
  Prop: TrtProperty;
  nProp: integer;
begin
  //Enforce assumptions
  Assert( Assigned( Source ),
    Format(ERR_OBJISNIL, ['DoSerializeFrom', 'Source'] ));
  Assert( Assigned( Source.ObjInstance ),
    Format(ERR_OBJISNIL, ['DoSerializeFrom', 'Source wrapper''s object'] ));

  RemoveSection( sSection );

  //Loop through the published properties of the object
  for nProp := 0 to Source.Count - 1 do
  begin
    Prop := Source.Items[nProp];

    if Prop.ReadOnly then continue;

    //Save the property with the TIniFile method appropriate for the property kind.
    case Prop.Kind of
      tkInteger, tkChar: WriteInteger( sSection, Prop.Name, Prop.AsInteger );
      tkString, tkLString, tkWString, tkEnumeration, tkSet:
        begin
          WriteString( sSection, Prop.Name, Prop.AsString );
        end;
      tkFloat:
        begin
          if SameText( Prop.TypeInfo.Name, 'TDateTime' ) then
          begin
            WriteDateTime( sSection, Prop.Name, Prop.AsFloat );
          end
          else if SameText( Prop.TypeInfo.Name, 'TTime' ) then
          begin
            WriteTime( sSection, Prop.Name, Prop.AsFloat );
          end
          else if SameText( Prop.TypeInfo.Name, 'TDate' ) then
          begin
            WriteDate( sSection, Prop.Name, Prop.AsFloat );
          end
          else
            WriteFloat( sSection, Prop.Name, Prop.AsFloat );
        end;
      tkClass:
        begin
          if Prop.IsDelegate then
          begin
            StoreSubObject( FormatSubSection( sSection, Prop.Name), Prop.AsObject );
          end
          else
          begin
            if Prop.ObjClassType = TComponent then
            begin
              WriteString( sSection, Prop.Name, TComponent( Prop.AsObject ).Name );
            end;
          end;
        end;
    end;
  end;
end;

procedure TclAbstractSerializer.DoSerializeFrom(Source: TObject; sSection: string );
var
  SourceWrapper: TrtWrapper;
begin
  Assert( Assigned( Source ), Format(ERR_OBJISNIL, ['DoSerializeFrom', 'Source'] ));

  SourceWrapper := nil;
  try
    SourceWrapper := TrtWrapper.Create( Source );
    DoSerializeFrom( SourceWrapper, sSection );
  finally
    SourceWrapper.Free;
  end;
end;

function TclAbstractSerializer.GetParentSection(sSectionName: string): string;
begin
  Result := ExtractFilePath( sSectionName );
end;

function TclAbstractSerializer.FormatSubSection(sSectionName,
  sSubSection: string): string;
begin
  Result := sSectionName + '\' + sSubSection;
end;

function TclAbstractSerializer.ExtractSubSectionName(
  sSectionName: string): string;
begin
  Result := ExtractFileName( sSectionName );
end;

{ TclIniSerializer }

procedure TclIniSerializer.CreateSection(sSectionName: string);
begin
  //no need, since TIniFile will automatically create sections if we ask nicely.
end;

function TclIniSerializer.LoadObjFromIniFile(Source: TIniFile;
  IniSection: string; Target: TObject): string;
begin
  IniFile := Source;
  DoDeserializeTo( Target, IniSection );
end;

function TclIniSerializer.LoadObjFromIniFile(Source: TIniFile;
  IniSection: string; Target: TrtWrapper): string;
begin
  IniFile := Source;
  DoDeserializeTo( Target, IniSection );
end;

function TclIniSerializer.LoadObjFromIniFile(Target: TrtWrapper;
  IniFilename, IniSection: string): string;
var
  IniFile: TIniFile;
begin
  Assert( Assigned(Target),
    Format(ERR_OBJISNIL, ['LoadObjFromIniFile', 'Target'] ));

  IniFile := nil;
  try
    IniFile := TIniFile.Create( IniFilename );
    Result := LoadObjFromIniFile( IniFile, IniSection, Target );
  finally
    IniFile.Free;
  end;
end;

function TclIniSerializer.LoadObjFromIniFile(Target: TObject; IniFilename,
  IniSection: string): string;
var
  IniFile: TIniFile;
begin
  Assert( Assigned(Target),
    Format(ERR_OBJISNIL, ['LoadObjFromIniFile', 'Target'] ));

  IniFile := nil;
  try
    IniFile := TIniFile.Create( IniFilename );
    Result := LoadObjFromIniFile( IniFile, IniSection, Target )
  finally
    IniFile.Free;
  end;
end;

function TclIniSerializer.ReadDate(sSectionName, sName: string): double;
begin
  Result := IniFile.ReadDate( sSectionName, sName, 0 );
end;

function TclIniSerializer.ReadDateTime(sSectionName, sName: string): double;
begin
  Result := IniFile.ReadDateTime( sSectionName, sName, 0 );
end;

function TclIniSerializer.ReadFloat(sSectionName, sName: string): double;
begin
  Result := IniFile.ReadFloat( sSectionName, sName, 0 );
end;

function TclIniSerializer.ReadInteger(sSectionName, sName: string): integer;
begin
  Result := IniFile.ReadInteger( sSectionName, sName, 0 );
end;

function TclIniSerializer.ReadString(sSectionName, sName: string): string;
begin
  Result := IniFile.ReadString( sSectionName, sName, '' );
end;

function TclIniSerializer.ReadTime(sSectionName, sName: string): double;
begin
  Result := IniFile.ReadTime( sSectionName, sName, 0 );
end;

procedure TclIniSerializer.RemoveSection(sSectionName: string);
begin
  IniFile.EraseSection( sSectionName );
end;

procedure TclIniSerializer.SaveObjToIniFile(Source: TrtWrapper;
  Target: TIniFile; IniSection: string);
begin
  IniFile := Target;
  DoSerializeFrom( Source, IniSection );
end;

procedure TclIniSerializer.SaveObjToIniFile(Source: TObject;
  Target: TIniFile; IniSection: string);
begin
  IniFile := Target;
  DoSerializeFrom( Source, IniSection );
end;

procedure TclIniSerializer.SaveObjToIniFile(Source: TObject; IniFilename,
  IniSection: string);
var
  RObj: TrtWrapper;
begin
  Assert( Assigned( Source ), Format(ERR_OBJISNIL, ['SaveObjToIniFile', 'Source'] ));

  RObj := nil;
  try
    RObj := TrtWrapper.Create( Source );
    SaveObjToIniFile( RObj, IniFilename, IniSection )
  finally
    RObj.Free;