Delphi：是否可以枚举全局命名空间中记录（~类型化常量）的所有实例？

从我到目前为止所做的研究来看，我已经猜到答案是否定的，只是为了确保。。。（此外，此条目可在提供支持后更新）

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

现在，我想扩展这些记录中的信息，以包括我可以用来自动生成描述这些选项的ADM/ADMX文件（

ifdef

）的元数据

但对于这一点，我需要能够枚举这些常量，除非我添加某种显式的注册机制，这似乎是不必要的重复

理想情况下，我宁愿以属性的形式声明元信息，而不是向记录类型添加额外的字段，但这些属性（尚未？）不能应用于常量。而且，这不会改变首先枚举常量的必要性

假设当前通过RTTI是不可能的，我可能会考虑将元数据放入评论中，并以某种方式解析出来。这可能是另一个问题

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

接下来是很长的答案….:-）

与尝试枚举全局常量不同，您可能希望尝试一种不同的方法来完成所做的工作

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

在他的博客中，他对它的工作原理做了很好的解释：

---

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

• 您现在可以拥有除字符串以外的其他类型（字符串、整数、双精度、布尔值）
• 可以在属性中指定默认值
• 有一个要从中继承的基本设置类。您可以在此处为INI文件设置文件名，它会为您加载和保存
• 基本AppSettings类。。TAppSettings自动将设置以以下格式存储在文件中：

  .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;

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

以下是更新的代码：

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.

---

这里有一个想法：您已经将这些常量传递给了配置框架。让它记住看到了哪些选项，然后它可以在课程结束时给你一份报告。这将为您提供即时注册，还可以让您审核实际使用的选项。@Rob:这确实是一个有趣的想法，但我更愿意将此功能保留在发布版本之外。生成ADM/ADMX文件所需的元数据量很大，在运行时也完全无用。这就是为什么我计划将这些附加字段放在

ifdef

s中，并将包含常量的单元包含在一个单独的项目中，该项目专门用于生成ADM/ADMX文件。这听起来确实是一个很酷的方法，当我决定从头开始为一个新项目重写配置框架时。。。然而，手头的项目已经大量使用了当前的框架，使用您的方法，我不仅要重写框架，还要重写消费应用程序本身的很大一部分……此外，我还要将加载/保存功能移动到一个单独的类，并将设置对象传递给它。这样，我仍然可以在registry/INI/XML/DB/which之间切换存储后端。