1. Andreas Stenius
  2. asconfig

Source

asconfig / Src / ASConfig.pas

unit ASConfig;

interface

uses
  Classes, SysUtils, Rtti, TypInfo, IniFiles;

type
  TSavePropMethod = procedure(const Name: string; const Value: TValue) of object;
  TSavePropMethodMap = array[TTypeKind] of TSavePropMethod;

  TLoadPropMethod = function(const Name: string; const Default: TValue): TValue of object;
  TLoadPropMethodMap = array[TTypeKind] of TLoadPropMethod;

  TASCustomConfig = class(TComponent)
  private
    FSavePropMethodMap: TSavePropMethodMap;
    FLoadPropMethodMap: TLoadPropMethodMap;
  protected
    procedure BeforeSave(const Obj: TObject; const Path: string); virtual;
    procedure AfterSave(const Obj: TObject; const Path: string); virtual;
    procedure BeforeLoad(const Obj: TObject; const Path: string); virtual;
    procedure AfterLoad(const Obj: TObject; const Path: string); virtual;

    property SavePropMethodMap: TSavePropMethodMap read FSavePropMethodMap write FSavePropMethodMap;
    property LoadPropMethodMap: TLoadPropMethodMap read FLoadPropMethodMap write FLoadPropMethodMap;
  public
    procedure Save(const Obj: TObject; const Path: string = 'Default');
    procedure Load(const Obj: TObject; const Path: string = 'Default');
  end;

  TASCustomConfigIniFile = class(TASCustomConfig)
  private
    FFileName: string;
    FIniFile: TIniFile;
    FSection: string;
  protected
    procedure SaveInteger(const Name: string; const Value: TValue);
    procedure SaveString(const Name: string; const Value: TValue);
    procedure SaveFloat(const Name: string; const Value: TValue);
    function LoadInteger(const Name: string; const Default: TValue): TValue;
    function LoadString(const Name: string; const Default: TValue): TValue;
    function LoadFloat(const Name: string; const Default: TValue): TValue;

    procedure OpenIniFile(const Section: string);
    procedure CloseIniFile;

    procedure BeforeSave(const Obj: TObject; const Path: string); override;
    procedure AfterSave(const Obj: TObject; const Path: string); override;
    procedure BeforeLoad(const Obj: TObject; const Path: string); override;
    procedure AfterLoad(const Obj: TObject; const Path: string); override;

    property IniFile: TIniFile read FIniFile;
    property Section: string read FSection write FSection;
  public
    constructor Create(AOwner: TComponent); override;
    property FileName: string read FFileName write FFileName;
  end;

  TASConfigIniFile = class(TASCustomConfigIniFile)
  published
    property FileName;
  end;

  TASCustomConfigRegistry = class(TASCustomConfig)

  end;

  TASConfigRegistry = class(TASCustomConfigRegistry)

  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('ASTEKK', [TASConfigIniFile {, TASConfigRegistry}]);
end;

{ TASCustomConfig }

procedure TASCustomConfig.AfterLoad(const Obj: TObject; const Path: string);
begin
end;

procedure TASCustomConfig.AfterSave(const Obj: TObject; const Path: string);
begin
end;

procedure TASCustomConfig.BeforeLoad(const Obj: TObject; const Path: string);
begin
end;

procedure TASCustomConfig.BeforeSave(const Obj: TObject; const Path: string);
begin
end;

procedure TASCustomConfig.Load(const Obj: TObject; const Path: string);
var
  Ctx: TRttiContext;
  T: TRttiType;
  P: TRttiProperty;
  L: TLoadPropMethod;
begin
  BeforeLoad(Obj, Path);

  Ctx := TRttiContext.Create;
  try
    T := Ctx.GetType(Obj.ClassType);
    for P in T.GetProperties do begin
      if not ((P.Visibility in [mvPublic, mvPublished]) and P.IsReadable) then
        Continue;

      L := LoadPropMethodMap[P.PropertyType.TypeKind];
      if Assigned(L) then
        P.SetValue(Obj, L(P.Name, P.GetValue(Obj)));
    end;
  finally
    Ctx.Free;
  end;

  AfterLoad(Obj, Path);
end;

procedure TASCustomConfig.Save(const Obj: TObject; const Path: string);
var
  Ctx: TRttiContext;
  T: TRttiType;
  P: TRttiProperty;
  S: TSavePropMethod;
begin
  BeforeSave(Obj, Path);

  Ctx := TRttiContext.Create;
  try
    T := Ctx.GetType(Obj.ClassType);
    for P in T.GetProperties do begin
      if not ((P.Visibility in [mvPublic, mvPublished]) and P.IsReadable) then
        Continue;

      S := SavePropMethodMap[P.PropertyType.TypeKind];
      if Assigned(S) then
        S(P.Name, P.GetValue(Obj));
    end;
  finally
    Ctx.Free;
  end;

  AfterSave(Obj, Path);
end;

{ TASCustomConfigIniFile }

procedure TASCustomConfigIniFile.AfterLoad(const Obj: TObject; const Path: string);
begin
  CloseIniFile;
end;

procedure TASCustomConfigIniFile.AfterSave(const Obj: TObject; const Path: string);
begin
  CloseIniFile;
end;

procedure TASCustomConfigIniFile.BeforeLoad(const Obj: TObject; const Path: string);
begin
  OpenIniFile(Path);
end;

procedure TASCustomConfigIniFile.BeforeSave(const Obj: TObject; const Path: string);
begin
  OpenIniFile(Path);
end;

procedure TASCustomConfigIniFile.CloseIniFile;
begin
  FreeAndNil(FIniFile);
end;

constructor TASCustomConfigIniFile.Create(AOwner: TComponent);
var
  SaveMap: TSavePropMethodMap;
  LoadMap: TLoadPropMethodMap;
begin
  inherited Create(AOwner);

  SaveMap[tkUnknown     ] := nil;
  SaveMap[tkInteger     ] := SaveInteger;
  SaveMap[tkChar        ] := nil;
  SaveMap[tkEnumeration ] := nil;
  SaveMap[tkFloat       ] := SaveFloat;
  SaveMap[tkString      ] := SaveString;
  SaveMap[tkSet         ] := nil;
  SaveMap[tkClass       ] := nil;
  SaveMap[tkMethod      ] := nil;
  SaveMap[tkWChar       ] := nil;
  SaveMap[tkLString     ] := SaveString;
  SaveMap[tkWString     ] := SaveString;
  SaveMap[tkVariant     ] := nil;
  SaveMap[tkArray       ] := nil;
  SaveMap[tkRecord      ] := nil;
  SaveMap[tkInterface   ] := nil;
  SaveMap[tkInt64       ] := nil;
  SaveMap[tkDynArray    ] := nil;
  SaveMap[tkUString     ] := SaveString;
  SaveMap[tkClassRef    ] := nil;
  SaveMap[tkPointer     ] := nil;
  SaveMap[tkProcedure   ] := nil;
  SavePropMethodMap := SaveMap;

  LoadMap[tkUnknown     ] := nil;
  LoadMap[tkInteger     ] := LoadInteger;
  LoadMap[tkChar        ] := nil;
  LoadMap[tkEnumeration ] := nil;
  LoadMap[tkFloat       ] := LoadFloat;
  LoadMap[tkString      ] := LoadString;
  LoadMap[tkSet         ] := nil;
  LoadMap[tkClass       ] := nil;
  LoadMap[tkMethod      ] := nil;
  LoadMap[tkWChar       ] := nil;
  LoadMap[tkLString     ] := LoadString;
  LoadMap[tkWString     ] := LoadString;
  LoadMap[tkVariant     ] := nil;
  LoadMap[tkArray       ] := nil;
  LoadMap[tkRecord      ] := nil;
  LoadMap[tkInterface   ] := nil;
  LoadMap[tkInt64       ] := nil;
  LoadMap[tkDynArray    ] := nil;
  LoadMap[tkUString     ] := LoadString;
  LoadMap[tkClassRef    ] := nil;
  LoadMap[tkPointer     ] := nil;
  LoadMap[tkProcedure   ] := nil;
  LoadPropMethodMap := LoadMap;
end;

function TASCustomConfigIniFile.LoadFloat(const Name: string; const Default: TValue): TValue;
begin
  Result := TValue.From(IniFile.ReadFloat(Section, Name, Default.AsExtended));
end;

function TASCustomConfigIniFile.LoadInteger(const Name: string; const Default: TValue): TValue;
begin
  Result := TValue.From(IniFile.ReadInteger(Section, Name, Default.AsInteger));
end;

function TASCustomConfigIniFile.LoadString(const Name: string; const Default: TValue): TValue;
begin
  Result := TValue.From(IniFile.ReadString(Section, Name, Default.AsString));
end;

procedure TASCustomConfigIniFile.OpenIniFile(const Section: string);
begin
  if Assigned(FIniFile) then
    FreeAndNil(FIniFile);

  FIniFile := TIniFile.Create(FileName);
  Self.Section := Section;
end;

procedure TASCustomConfigIniFile.SaveFloat(const Name: string; const Value: TValue);
begin
  IniFile.WriteFloat(Section, Name, Value.AsExtended);
end;

procedure TASCustomConfigIniFile.SaveInteger(const Name: string; const Value: TValue);
begin
  IniFile.WriteInteger(Section, Name, Value.AsInteger);
end;

procedure TASCustomConfigIniFile.SaveString(const Name: string; const Value: TValue);
begin
  IniFile.WriteString(Section, Name, Value.AsString);
end;

end.