Delphi: RTTI与ini配置文件

项目以Rtti特性做文件参数配置,简化每项读写ini操作,记录以做备忘,代码如下:

unit uGlobal;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Forms, TypInfo, IniFiles;

type
  TConfigBase = class(TPersistent)
  private
    FFileName: string;
    procedure Load(AIniFile: TIniFile); overload;
    procedure Save(AIniFile: TIniFile); overload;
  protected
    function GetSectionName: string; virtual;
    procedure LoadProperty(PropInfo: PPropInfo; const Section: string; IniFile: TIniFile); virtual;
    procedure SaveProperty(PropInfo: PPropInfo; const Section: string; IniFile: TIniFile); virtual;
  public
    procedure Load(AFileName: string); overload;
    procedure Save(AFileName: string); overload;
  end;

  TLiveUpdate = class;

  TApp = class(TConfigBase)
  private
    FAppName: string;
    FVersion: string;
    FShowMsg: Boolean;
    FProductID: Integer;
    FWindowState: TWindowState;
    FLiveUpdate: TLiveUpdate;
  protected
    function GetSectionName: string; override;
  public
    constructor Create;
    destructor Destroy; override;
  published
    property AppName: string read FAppName write FAppName;
    property Version: string read FVersion write FVersion;
    property ShowMsg: Boolean read FShowMsg write FShowMsg;
    property ProductID: Integer read FProductID write FProductID;
    property WindowState: TWindowState read FWindowState write FWindowState;
    property LiveUpdate: TLiveUpdate read FLiveUpdate write FLiveUpdate;
  end;

  TLiveUpdate = class(TConfigBase)
  private
    FAvailabled: Boolean;
    FAutoUpdate: Boolean;
    FUpdatePeriod: Integer;
    FLastUpdateDate: TDateTime;
  protected
    procedure LoadProperty(PropInfo: PPropInfo; const Section: string; IniFile: TIniFile); override;
    procedure SaveProperty(PropInfo: PPropInfo; const Section: string; IniFile: TIniFile); override;
  public
    constructor Create;
  published
    property Availabled: Boolean read FAvailabled write FAvailabled;
    property AutoUpdate: Boolean read FAutoUpdate write FAutoUpdate;
    property UpdatePeriod: Integer read FUpdatePeriod write FUpdatePeriod;
    property LastUpdateDate: TDateTime read FLastUpdateDate write FLastUpdateDate;
  end;

function App: TApp;

implementation

var
  FApp: TApp;

function App: TApp;
begin
  if FApp = nil then
    FApp := TApp.Create;
  Result := FApp;
end;

{ TConfigBase }

function TConfigBase.GetSectionName: string;
begin
  Result := ClassName;
  if Result[1] = 'T' then
    Result := Copy(Result, 2, Length(Result) - 1);
end;

procedure TConfigBase.Load(AFileName: string);
var
  IniFile: TIniFile;
begin
  if not FileExists(AFileName) then Exit;

  IniFile := TIniFile.Create(AFileName);
  try
    Load(IniFile);
  finally
    IniFile.Free;
  end;
end;

procedure TConfigBase.Load(AIniFile: TIniFile);
var
  I, Count: Integer;
  PropInfo: PPropInfo;
  PropList: PPropList;
  Section: string;
begin
  Count := GetTypeData(ClassInfo)^.PropCount;
  if Count = 0 then Exit;

  GetMem(PropList, Count * SizeOf(Pointer));
  try
    Section := GetSectionName;
    GetPropInfos(ClassInfo, PropList);
    for I := 0 to Count - 1 do
    begin
      PropInfo := PropList^[I];
      if (PropInfo <> nil) and IsStoredProp(self, PropInfo) and (PropInfo^.SetProc <> nil) then
        LoadProperty(PropInfo, Section, AIniFile);
    end;
  finally
    FreeMem(PropList);
  end;
end;

procedure TConfigBase.LoadProperty(PropInfo: PPropInfo; const Section: string;
  IniFile: TIniFile);
var
  PropType: PTypeInfo;
  Obj: TObject;
begin
  PropType := PropInfo^.PropType^;
  if (PropType^.Kind <> tkClass) and (not IniFile.ValueExists(Section, string(PropInfo^.Name))) then Exit;

  case PropType^.Kind of
    tkClass:
      begin
        Obj := GetObjectProp(self, PropInfo);
        if Assigned(Obj) and (Obj is TConfigBase) then
          TConfigBase(Obj).Load(IniFile);
      end;
    tkInteger, tkChar, tkWChar:
      SetOrdProp(Self, PropInfo, IniFile.ReadInteger(Section, string(PropInfo.Name), PropInfo^.Default));
    tkString, tkLString, tkUstring, tkWString:
      SetStrProp(Self, PropInfo, IniFile.ReadString(Section, string(PropInfo.Name), ''));
    tkEnumeration:
      SetEnumProp(Self, PropInfo, IniFile.ReadString(Section, string(PropInfo.Name), ''));
    tkSet:
      SetSetProp(Self, PropInfo, IniFile.ReadString(Section, string(PropInfo.Name), ''));
    tkFloat:
      SetFloatProp(Self, PropInfo, IniFile.ReadFloat(Section, string(PropInfo^.Name), 0));
  end;
end;

procedure TConfigBase.Save(AFileName: string);
var
  IniFile: TIniFile;
begin
  if AFileName = '' then Exit;

  IniFile := TIniFile.Create(AFileName);
  try
    try
      Save(IniFile);
    except on E: Exception do
      OutputDebugString(PChar(Format('Exceptoin: save to file %s fail, err: %s', [AFileName, E.Message])));
    end;
  finally
    IniFile.Free;
  end;
end;

procedure TConfigBase.Save(AIniFile: TIniFile);
var
  I, Count: Integer;
  PropInfo: PPropInfo;
  PropList: PPropList;
  Section: string;
begin
  Section := GetSectionName;
  Count := GetTypeData(ClassInfo)^.PropCount;
  if Count > 0 then
  begin
    GetMem(PropList, Count * SizeOf(Pointer));
    try
      GetPropInfos(ClassInfo, PropList);
      for I := 0 to Count - 1 do
      begin
        PropInfo := PropList^[I];
        if (PropInfo <> nil) and IsStoredProp(self, PropInfo) and (PropInfo^.GetProc <> nil) then
          SaveProperty(PropInfo, Section, AIniFile);
      end;
    finally
      FreeMem(PropList);
    end;
  end;
end;

procedure TConfigBase.SaveProperty(PropInfo: PPropInfo; const Section: string;
  IniFile: TIniFile);
var
  PropType: PTypeInfo;
  Obj: TObject;
const
  Format_d = '%d';
begin
  PropType := PropInfo^.PropType^;
  case PropType^.Kind of
    tkClass:
      begin
        Obj := GetObjectProp(self, PropInfo);
        if Assigned(Obj) and (Obj is TConfigBase) then
          TConfigBase(Obj).Save(IniFile);
      end;
    tkInteger, tkChar, tkWChar:
      IniFile.WriteInteger(Section, string(PropInfo^.Name), GetOrdProp(Self, PropInfo));
    tkString, tkLString, tkUstring, tkWString:
      IniFile.WriteString(Section, string(PropInfo^.Name), GetWideStrProp(Self, PropInfo));
    tkEnumeration:
      IniFile.WriteString(Section, string(PropInfo^.Name), GetEnumName(PropType, GetOrdProp(Self, PropInfo)));
    tkSet:
      IniFile.WriteString(Section, string(PropInfo^.Name), GetSetProp(Self, PropInfo));
    tkFloat:
      IniFile.WriteFloat(Section, string(PropInfo^.Name), GetFloatProp(Self, PropInfo));
  end;
end;

{ TApp }

constructor TApp.Create;
begin
  FFileName := ChangeFileExt(ParamStr(0), '.ini');
  FWindowState := wsNormal;
  FLiveUpdate := TLiveUpdate.Create;
  Load(FFileName);
end;

destructor TApp.Destroy;
begin
  Save(FFileName);
  inherited Destroy;
end;

function TApp.GetSectionName: string;
begin
  Result := 'System';
end;

{ TLiveUpdate }

constructor TLiveUpdate.Create;
begin
  FAvailabled := True;
  FAutoUpdate := True;
  FUpdatePeriod := 7;
  FLastUpdateDate := Now;
end;

procedure TLiveUpdate.LoadProperty(PropInfo: PPropInfo; const Section: string;
  IniFile: TIniFile);
begin
  if PropInfo^.Name = 'LastUpdateDate' then
    FLastUpdateDate := IniFile.ReadDateTime(Section, string(PropInfo^.Name), Now)
  else
    inherited;
end;

procedure TLiveUpdate.SaveProperty(PropInfo: PPropInfo; const Section: string;
  IniFile: TIniFile);
begin
  if PropInfo^.Name = 'LastUpdateDate' then
    IniFile.WriteDateTime(Section, string(PropInfo^.Name), GetFloatProp(Self, PropInfo))
  else
    inherited;
end;

end.

使用方法:

procedure TForm1.FormCreate(Sender: TObject);
begin
  App.AppName := 'RttInfo';
  App.Version := GetFileVersion(ParamStr(0));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  App.Free;
end;

比单个字段读写ini字段,省事