Delphi:是否可以在全局命名空间中枚举记录的所有实例(~typed常量)?

时间:2011-05-18 08:37:52

标签: delphi record rtti

根据我迄今为止所做的研究,我已经猜测答案是否定的只是为了确保......(此外,一旦支持 ,此条目就可以更新可用)。

我认为问题标题应该已经自给自足了,但我想要做的是FWIW:我有一个围绕记录常量构建的配置框架:我的应用程序中可用的每个配置选项都在一个中心位置定义以类型化常量的形式,其中包含注册表(或INI)键的名称,其数据类型及其默认值。这些常量是我传递给我的框架中的访问器方法,然后实现检索和存储选项值所必需的逻辑。

我现在想扩展这些记录中的信息,还包括我可用于自动生成描述这些选项的ADM / ADMX文件(ifdef'在发布版本中编辑出来)的元数据。

但是为此,我需要能够枚举这些常量,除非我添加某种显式注册机制,这似乎是不必要的重复。

理想情况下,我不想在记录类型中添加其他字段,而是希望以属性的形式声明元信息,但那些(但是?)不能应用于常量。此外,这不会改变任何关于首先枚举常量的必要性。

假设目前无法通过RTTI实现这一点,我可能会考虑将元数据放入注释中并以某种方式解析出来。这可能是另一个问题。

[平台信息:目前正在使用Delphi 2010,但我已经拥有XE许可证 - 只是没有时间安装它,但是]

1 个答案:

答案 0 :(得分:4)

答案很长......: - )

您可能希望尝试使用不同的方法来尝试枚举全局常量,而不是尝试枚举全局常量。

前一段时间,Robert Love有一个非常有趣的想法。 他使用自定义属性和RTTI来指定如何存储和检索.ini文件中的值。

在他的博客中,他对如何运作有了很好的解释:

http://robstechcorner.blogspot.com/2009/10/ini-persistence-rtti-way.html


我在下面的代码中对此进行了扩展:

  • 您现在可以使用除字符串之外的其他类型(字符串,整数,双精度,布尔值)。
  • 您可以在属性中指定默认值。
  • 有一个要继承的基本设置类。你可以在这里为inifile设置一个文件名,它会为你加载和保存。
  • Base AppSettings类.. TAppSettings会自动将设置存储在以下格式的文件中:<yourappname>.config.ini

示例...当我想将数据库设置存储在ini文件中时,我需要做的就是实例化一个TDbSettings。您不需要知道值实际存储的方式和位置,访问速度非常快。

var 
  DbSettings : TDbSettings
begin
  DbSettings := TDbSettings.Create;
  try
    // show some settings
    WriteLn(DbSettings.Host);
    WriteLn(DbSettings.Port);
    // write setting
    DbSettings.UserName := 'Me';
    // store it in the ini file
    DbSettings.Save;
  finally
    DbSettings.Free;
  end;
end;

如果你想指定一组新的设置,那真的很容易。

  TServiceSettings=class(TAppSettings)
  public
    [IniValue('Service','Description','MyServiceDesc')]
    ServiceDescription: String;

    [IniValue('Service','DisplayName','MyServiceName')]
    ServiceDisplayName: String;
  end;

这比直接阅读和编写inifile要简洁得多。罗伯特,如果你读到这个:感谢让我的生活更轻松!

这是更新后的代码:

unit WvN.Configuration.Persist.Ini;
// MIT License
//
// Copyright (c) 2009 - Robert Love
//
// Permission is hereby granted, free of charge, to any person obtaining a copy
// of this software and associated documentation files (the "Software"), to deal
// in the Software without restriction, including without limitation the rights
// to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
// copies of the Software, and to permit persons to whom the Software is
// furnished to do so, subject to the following conditions:
//
// The above copyright notice and this permission notice shall be included in
// all copies or substantial portions of the Software.
//
// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
// AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
// OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
// THE SOFTWARE
//
// Wouter van Nifterick: 2010-11: added TSettings abstract class and some derivatives to load database and cs settings
interface
uses SysUtils,Classes, Rtti,TypInfo;

type
  IniValueAttribute = class(TCustomAttribute)
  private
    FName: string;
    FDefaultValue: string;
    FSection: string;
  public
     constructor Create(const aSection : String;const aName : string;const aDefaultValue : Integer = 0);overload;
     constructor Create(const aSection : String;const aName : string;const aDefaultValue : Double = 0.0);overload;
     constructor Create(const aSection : String;const aName : string;const aDefaultValue : Boolean = false);overload;
     constructor Create(const aSection : String;const aName : string;const aDefaultValue : String = '');overload;
     property Section : string read FSection write FSection;
     property Name : string read FName write FName;
     property DefaultValue : string read FDefaultValue write FDefaultValue;
  end;

  EIniPersist = class(Exception);

  TIniPersist = class (TObject)
  private
    class procedure SetValue(aData : String;var aValue : TValue);
    class function GetValue(var aValue : TValue) : String;
    class function GetIniAttribute(Obj : TRttiObject) : IniValueAttribute;
  public
    class procedure Load(FileName : String;obj : TObject);
    class procedure Save(FileName : String;obj : TObject);
  end;

  TSettings=class abstract(TComponent)
  private
    FOnChange: TNotifyEvent;
    FFileName:String;
    procedure SetOnChange(const Value: TNotifyEvent);
    function GetFileName: String;virtual;
    procedure SetFileName(const Value: String);virtual;
  public
    property FileName:String read GetFileName write SetFileName;
    procedure CreateDefaults;
    procedure Load;virtual;
    procedure Save;virtual;
    constructor Create(AOwner: TComponent); override;
    procedure DoOnChange;
    property OnChange:TNotifyEvent read FOnChange write SetOnChange;
  end;

  TAppSettings=class abstract(TSettings)
    function GetFileName: String;override;
  end;



  TServiceSettings=class(TAppSettings)
  public
    [IniValue('Service','Description','')]
    ServiceDescription: String;

    [IniValue('Service','DisplayName','')]
    ServiceDisplayName: String;
  end;


  TCsSettings=class(TAppSettings)
  public
    [IniValue('CS','SourceAppId',9999)]
    SourceAppId: LongWord;

    [IniValue('CS','SourceCSId',9999)]
    SourceCSId: LongWord;

    [IniValue('CS','Host','Localhost')]
    Host: String;

    [IniValue('CS','Port',42000)]
    Port: LongWord;

    [IniValue('CS','ReconnectInvervalMs',30000)]
    ReconnectInvervalMs: Integer;
  end;

  TFTPSettings=class(TAppSettings)
  public
    [IniValue('FTP','Host','Localhost')]
    Host: String;

    [IniValue('FTP','Port',21)]
    Port: LongWord;

    [IniValue('FTP','RemotePath','/')]
    RemotePath: String;

    [IniValue('FTP','LocalPath','.')]
    LocalPath: String;

    [IniValue('FTP','Username','')]
    Username: String;

    [IniValue('FTP','Password','')]
    Password: String;

    [IniValue('FTP','BlockSize',4096)]
    BlockSize: Cardinal;
  end;


  TDbSettings=class(TAppSettings)
  private
    function GetURL: String;
  public
    [IniValue('DB','Host','Localhost')]
    Host: String;

    [IniValue('DB','Port',3306)]
    Port: LongWord;

    [IniValue('DB','Database','')]
    Database: String;

    [IniValue('DB','Username','root')]
    Username: String;

    [IniValue('DB','Password','')]
    Password: String;

    [IniValue('DB','Protocol','mysql-5')]
    Protocol: String;

    [IniValue('DB','UseSSL',True)]
    UseSSL: Boolean;

    [IniValue('DB','Compress',True)]
    Compress: Boolean;

    [IniValue('DB','TimeOutSec',0)]
    TimeOutSec: Integer;

    [IniValue('DB','SSL_CA','U:\Efkon2\AMM_mysql_cas.crt')]
    SSL_CA: String;

    [IniValue('DB','SSL_CERT','U:\Efkon2\AMM_ARS_mysql_user.pem')]
    SSL_CERT: String;

    [IniValue('DB','SSL_KEY','U:\Efkon2\AMM_ARS_mysql_user_key.pem')]
    SSL_KEY: String;

    property URL:String read GetURL;
  end;

  TPathSettings=class(TAppSettings)
  public

    [IniValue('Paths','StartPath','.')]
    StartPath: String;

    [IniValue('Paths','InPath','In')]
    InPath: String;

    [IniValue('Paths','OutPath','Out')]
    OutPath: String;

    [IniValue('Paths','ErrorPath','Error')]
    ErrorPath: String;
  end;


implementation

uses IniFiles;

{ TIniValue }

constructor IniValueAttribute.Create(const aSection, aName, aDefaultValue: String);
begin
  FSection := aSection;
  FName := aName;
  FDefaultValue := aDefaultValue;
end;

{ TIniPersist }

class function TIniPersist.GetIniAttribute(Obj: TRttiObject): IniValueAttribute;
var
  Attr: TCustomAttribute;
begin
  for Attr in Obj.GetAttributes do
  begin
    if Attr is IniValueAttribute then
    begin
      exit(IniValueAttribute(Attr));
    end;
  end;
  result := nil;
end;

class procedure TIniPersist.Load(FileName: String; obj: TObject);
var
  ctx     : TRttiContext;
  objType : TRttiType;
  Field   : TRttiField;
  Prop    : TRttiProperty;
  Value   : TValue;
  IniValue: IniValueAttribute;
  Ini     : TIniFile;
  Data    : string;
begin
  ctx := TRttiContext.Create;
  try
    Ini := TIniFile.Create(FileName);
    try
      objType := ctx.GetType(Obj.ClassInfo);
      for Prop in objType.GetProperties do
      begin
        IniValue := GetIniAttribute(Prop);
        if Assigned(IniValue) then
        begin
          Data  := Ini.ReadString(IniValue.Section, IniValue.Name, IniValue.DefaultValue);
          Value := Prop.GetValue(Obj);
          SetValue(Data, Value);
          Prop.SetValue(Obj, Value);
        end;
      end;
      for Field in objType.GetFields do
      begin
        IniValue := GetIniAttribute(Field);
        if Assigned(IniValue) then
        begin
          Data  := Ini.ReadString(IniValue.Section, IniValue.Name, IniValue.DefaultValue);
          Value := Field.GetValue(Obj);
          SetValue(Data, Value);
          Field.SetValue(Obj, Value);
        end;
      end;
    finally
      Ini.Free;
    end;
  finally
    ctx.Free;
  end;
end;

class procedure TIniPersist.SetValue(aData: String;var aValue: TValue);
var
  I : Integer;
begin
 case aValue.Kind of
   tkWChar,
   tkLString,
   tkWString,
   tkString,
   tkChar,
   tkUString : aValue := aData;
   tkInteger,
   tkInt64  : aValue := StrToInt(aData);
   tkFloat  : aValue := StrToFloat(aData);
   tkEnumeration:  aValue := TValue.FromOrdinal(aValue.TypeInfo,GetEnumValue(aValue.TypeInfo,aData));
   tkSet: begin
             i :=  StringToSet(aValue.TypeInfo,aData);
             TValue.Make(@i, aValue.TypeInfo, aValue);
          end;
   else raise EIniPersist.Create('Type not Supported');
 end;
end;

class procedure TIniPersist.Save(FileName: String; obj: TObject);
var
  ctx     : TRttiContext;
  objType : TRttiType;
  Field   : TRttiField;
  Prop    : TRttiProperty;
  Value   : TValue;
  IniValue: IniValueAttribute;
  Ini     : TIniFile;
  Data    : string;
begin
  ctx := TRttiContext.Create;
  try
    Ini := TIniFile.Create(FileName);
    try
      objType := ctx.GetType(Obj.ClassInfo);
      for Prop in objType.GetProperties do
      begin
        IniValue := GetIniAttribute(Prop);
        if Assigned(IniValue) then
        begin
          Value := Prop.GetValue(Obj);
          Data  := GetValue(Value);
          Ini.WriteString(IniValue.Section, IniValue.Name, Data);
        end;
      end;
      for Field in objType.GetFields do
      begin
        IniValue := GetIniAttribute(Field);
        if Assigned(IniValue) then
        begin
          Value := Field.GetValue(Obj);
          Data  := GetValue(Value);
          Ini.WriteString(IniValue.Section, IniValue.Name, Data);
        end;
      end;
    finally
      Ini.Free;
    end;
  finally
    ctx.Free;
  end;
end;

class function TIniPersist.GetValue(var aValue: TValue): string;
begin
  if aValue.Kind in [tkWChar, tkLString, tkWString, tkString, tkChar, tkUString,
    tkInteger, tkInt64, tkFloat, tkEnumeration, tkSet] then
    result := aValue.ToString
  else
    raise EIniPersist.Create('Type not Supported');
end;

constructor IniValueAttribute.Create(const aSection, aName: string;
  const aDefaultValue: Integer);
begin
  FSection := aSection;
  FName := aName;
  FDefaultValue := IntToStr(aDefaultValue);
end;

constructor IniValueAttribute.Create(const aSection, aName: string;
  const aDefaultValue: Double);
begin
  FSection := aSection;
  FName := aName;
  FDefaultValue := FloatToStr(aDefaultValue);
end;

constructor IniValueAttribute.Create(const aSection, aName: string;
  const aDefaultValue: Boolean);
begin
  FSection := aSection;
  FName := aName;
  FDefaultValue := BoolToStr(aDefaultValue);
end;

{ TAppSettings }


procedure TSettings.CreateDefaults;
begin
  Load;
  Save;
end;

procedure TSettings.DoOnChange;
begin
  if Assigned(FOnChange) then
    FOnChange(Self)
end;


procedure TSettings.SetOnChange(const Value: TNotifyEvent);
begin
  FOnChange := Value;
end;

{ TAppSettings }

function TAppSettings.GetFileName: String;
begin
  Result := ChangeFileExt(ParamStr(0),'.config.ini')
end;

{ TSettings }

constructor TSettings.Create(AOwner: TComponent);
begin
  inherited;

end;

function TSettings.GetFileName: String;
begin
  Result := FFileName
end;

procedure TSettings.Load;
begin
  TIniPersist.Load(FileName,Self);
  DoOnChange;
end;

procedure TSettings.Save;
begin
  TIniPersist.Save(FileName,Self);
end;

procedure TSettings.SetFileName(const Value: String);
begin
  FFileName := Value
end;


{ TDbSettings }

function TDbSettings.GetURL: String;
begin
  Result := Format('%s://%s:%s@%s:%d/%s?compress=%s&timeout=%d',
  [
    self.Protocol,
    self.Username,
    self.Password,
    self.Host,
    self.Port,
    self.Database,
    booltostr(self.Compress),
    self.TimeOutSec
  ]);
end;

end.