clserializers.pas

用Delphi实现的数据库持久化

  end;
end;

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

  IniFile := nil;
  try
    IniFile := TIniFile.Create(IniFilename);
    SaveObjToIniFile( Source, IniFile, IniSection )
  finally
    IniFile.Free;
  end;
end;

function TclIniSerializer.SectionExists(sSectionName: string): boolean;
begin
  Result := IniFile.SectionExists(sSectionName);
end;

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

procedure TclIniSerializer.WriteDate(sSectionName, sName: string;
  fValue: double);
begin
  IniFile.WriteDate(sSectionName, sName, fValue);
end;

procedure TclIniSerializer.WriteDateTime(sSectionName, sName: string;
  fValue: double);
begin
  IniFile.WriteDateTime(sSectionName, sName, fValue);
end;

procedure TclIniSerializer.WriteFloat(sSectionName, sName: string;
  fValue: double);
begin
  IniFile.WriteFloat(sSectionName, sName, fValue);
end;

procedure TclIniSerializer.WriteInteger(sSectionName, sName: string;
  nValue: integer);
begin
  IniFile.WriteInteger(sSectionName, sName, nValue);
end;

procedure TclIniSerializer.WriteString(sSectionName, sName,
  sValue: string);
begin
  IniFile.WriteString(sSectionName, sName, sValue);
end;

procedure TclIniSerializer.WriteTime(sSectionName, sName: string;
  fValue: double);
begin
  IniFile.WriteTime(sSectionName, sName, fValue);
end;

{ TclRegSerializer }

procedure TclRegSerializer.CleanUpRegistries;
var
  Reg: TRegistry;
  i: integer;
begin
  for i := slRegistries.Count - 1 downto 0 do
  begin
    Reg := TRegistry(slRegistries.Objects[i]);
    Reg.CloseKey;
    Reg.Free;
    slRegistries.Delete(i);
  end;
end;

{
ClearKey
Completely remove the specified registry key
}
procedure TclRegSerializer.ClearKey(sKey: string);
var
  slKeys: TStringList;
  i: integer;
  Reg: TRegistry;
begin
  slKeys := nil;
  try
    slKeys := TStringList.Create;
    Reg := GetRegForKey( sKey );
    if Reg.OpenKey( sKey, false ) then
    begin
      //Remove all sub-keys
      Reg.GetKeyNames( slKeys );
      for i := 0 to slKeys.Count - 1 do
        ClearKey( sKey + '\' + slKeys[i] );

      //Close and delete the specified key
      Reg.CloseKey;
      if not Reg.DeleteKey( sKey ) then
        raise Exception.CreateFmt( 'Error deleting key (%s)', [sKey] );
    end;
  finally
    slKeys.Free;
  end;
end;

constructor TclRegSerializer.Create;
begin
  inherited;
  slRegistries := TStringList.Create;
end;

procedure TclRegSerializer.CreateSection(sSectionName: string);
begin
  GetRegForKey(sSectionName);
end;

destructor TclRegSerializer.Destroy;
begin
  slRegistries.Free;
  inherited;
end;

function TclRegSerializer.GetRegForKey(sKey: string): TRegistry;
begin
  //If one doesn't exist
  if slRegistries.IndexOf( sKey ) < 0 then
  begin //create it
    Result := TRegistry.Create;
    Result.RootKey := BaseReg.RootKey;
    Result.OpenKey( sKey, true );
    slRegistries.AddObject( sKey, Result );
  end
  else
  begin
    Result := TRegistry(slRegistries.Objects[slRegistries.IndexOf( sKey )]);
  end;
end;

function TclRegSerializer.LoadObjFromRegistry(Target: TObject;
  RegistryKey: string; RootKey: HKEY): string;
var
  Reg: TRegistry;
begin
  Assert( Assigned(Target),
    Format(ERR_OBJISNIL, ['LoadObjFromRegistry', 'Target'] ));

  Reg := nil;
  try
    Reg := TRegistry.Create;
    Reg.RootKey := RootKey;
    if Reg.OpenKey( RegistryKey, true ) then
      Result := LoadObjFromRegistry( Reg, Target )
    else
      raise Exception.CreateFmt( 'SaveObjToRegistry: Error opening key (%s)',
        [RegistryKey] );
  finally
    Reg.Free;
  end;
end;

function TclRegSerializer.LoadObjFromRegistry(Source: TRegistry;
  Target: TObject): string;
begin
  BaseReg := Source;
  Result := DoDeserializeTo( Target, Source.CurrentPath );
end;

function TclRegSerializer.LoadObjFromRegistry(Source: TRegistry;
  Target: TrtWrapper): string;
begin
  BaseReg := Source;
  Result := DoDeserializeTo( Target, Source.CurrentPath );
end;

function TclRegSerializer.ReadDate(sSectionName, sName: string): double;
begin
  Result := GetRegForKey( sSectionName ).ReadDate( sName );
end;

function TclRegSerializer.ReadDateTime(sSectionName,
  sName: string): double;
begin
  Result := GetRegForKey( sSectionName ).ReadDateTime( sName );
end;

function TclRegSerializer.ReadFloat(sSectionName, sName: string): double;
begin
  Result := GetRegForKey( sSectionName ).ReadFloat( sName );
end;

function TclRegSerializer.ReadInteger(sSectionName,
  sName: string): integer;
begin
  Result := GetRegForKey( sSectionName ).ReadInteger( sName );
end;

function TclRegSerializer.ReadString(sSectionName, sName: string): string;
begin
  Result := GetRegForKey( sSectionName ).ReadString( sName );
end;

function TclRegSerializer.ReadTime(sSectionName, sName: string): double;
begin
  Result := GetRegForKey( sSectionName ).ReadTime( sName );
end;

procedure TclRegSerializer.RemoveSection(sSectionName: string);
var
  Reg: TRegistry;
begin
  Reg := GetRegForKey( sSectionName );
  Reg.CloseKey;
  ClearKey( sSectionName );
  Reg.OpenKey( sSectionName, true );
end;

procedure TclRegSerializer.SaveObjToRegistry(Source: TObject;
  RegistryKey: string; RootKey: HKEY);
var
  RObj: TrtWrapper;
begin
  Assert( Assigned( Source ), Format(ERR_OBJISNIL, ['SaveObjToRegistry', 'Source'] ));

  RObj := nil;
  try
    RObj := TrtWrapper.Create( Source );
    SaveObjToRegistry( RObj, RegistryKey, RootKey )
  finally
    RObj.Free;
  end;
end;

procedure TclRegSerializer.SaveObjToRegistry(Source: TObject;
  Target: TRegistry);
begin
  BaseReg := Target;
  DoSerializeFrom( Source, BaseReg.CurrentPath );
end;

procedure TclRegSerializer.SaveObjToRegistry(Source: TrtWrapper;
  Target: TRegistry);
begin
  BaseReg := Target;
  DoSerializeFrom( Source, BaseReg.CurrentPath );
end;

procedure TclRegSerializer.SaveObjToRegistry(Source: TrtWrapper;
  RegistryKey: string; RootKey: HKEY);
var
  Reg: TRegistry;
begin
  Assert( Assigned( Source ), Format(ERR_OBJISNIL, ['SaveObjToRegistry', 'Source'] ));

  Reg := nil;
  try
    Reg := TRegistry.Create;
    Reg.RootKey := RootKey;
    if Reg.OpenKey( RegistryKey, true ) then
      SaveObjToRegistry( Source, Reg )
    else
      raise Exception.CreateFmt( ERR_REGISTRY_OPENKEY,
        ['SaveObjToRegistry', RegistryKey] );
  finally
    Reg.Free;
  end;
end;

function TclRegSerializer.SectionExists(sSectionName: string): boolean;
begin
  Result := GetRegForKey( GetParentSection( sSectionName ) ).KeyExists( ExtractSubSectionName( sSectionName ) );
end;

function TclRegSerializer.ValueExists(sSectionName,
  sName: string): boolean;
begin
  Result := GetRegForKey( sSectionName ).ValueExists( sName );
end;

procedure TclRegSerializer.WriteDate(sSectionName, sName: string;
  fValue: double);
begin
  GetRegForKey( sSectionName ).WriteDate( sName, fValue );
end;

procedure TclRegSerializer.WriteDateTime(sSectionName, sName: string;
  fValue: double);
begin
  GetRegForKey( sSectionName ).WriteDateTime( sName, fValue );
end;

procedure TclRegSerializer.WriteFloat(sSectionName, sName: string;
  fValue: double);
begin
  GetRegForKey( sSectionName ).WriteFloat( sName, fValue );
end;

procedure TclRegSerializer.WriteInteger(sSectionName, sName: string;
  nValue: integer);
begin
  GetRegForKey( sSectionName ).WriteInteger( sName, nValue );
end;

procedure TclRegSerializer.WriteString(sSectionName, sName,
  sValue: string);
begin
  GetRegForKey( sSectionName ).WriteString( sName, sValue );
end;

procedure TclRegSerializer.WriteTime(sSectionName, sName: string;
  fValue: double);
begin
  GetRegForKey( sSectionName ).WriteTime( sName, fValue );
end;

initialization
  FIniSerializer := nil;
  FRegSerializer := nil;
finalization
  FIniSerializer.Free;
  FRegSerializer.Free;

end.