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

Question

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

从研究,我已经做了,到目前为止,我已经猜的答案是否定的,但只是为了确保...(也,此内容可以更新一次支持这是可用).

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

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

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

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

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

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

Answer 1

Wou*_*ick 4

_{长答案即将到来......:-)}

您可能不想尝试枚举全局常量，而是想尝试一种不同的方法来完成您正在做的事情。

不久前，罗伯特·洛夫（Robert Love）有一个非常有趣的想法。他使用自定义属性和 RTTI 来指定如何存储和检索 .ini 文件中的值。

在他的博客中，他对其工作原理进行了很好的解释：

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

我在下面的代码中对此进行了一些扩展：

现在，您可以拥有除字符串之外的其他类型（字符串、整数、双精度、布尔值）。
您可以在属性中指定默认值。
有一个基设置类可以继承。您可以在此处为 ini 文件设置文件名，它会为您加载和保存。
基本 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;

Run Code Online (Sandbox Code Playgroud)

如果您想指定一组新的设置，这非常简单。

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

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

Run Code Online (Sandbox Code Playgroud)

这比直接读写ini文件要干净得多。罗伯特，如果你读到这篇文章：感谢你让我的生活变得更加轻松！

这是更新后的代码：

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.

Run Code Online (Sandbox Code Playgroud)

归档时间：	14 年，9 月前
查看次数：	583 次
最近记录：	14 年，8 月前