XML配置文件读取类[DELPHI]

发现用INI做配置的话，实在有太多的东西难以描述，所以自己做了一个XML的配置文件存取类。

需要的同学可以直接拿去用，但希望尊重劳动成果，保留版权信息。

废话不多说，上代码！

unit XMLConfig;
{----------------------------------------------------------------------------}
{ 这个单元用来处理XML配置文件，对配置文件格式有默认要求                             }
{ 格式为，只允许有一个root，然后root下对应配置文件，                               }
{ 所有配置，均使用xml属性存取配置，属性中必须存在Name属性，                         }
{ 不得单独使用下级Node                                                         }
{ PS: 使用NativeXML库作为XML取数基本集，NativeXML请自行获取                      }
{ By Raymond.Zhang @ 2012.07.12 Mail: Acni.ray@gmail.com                     }
{ Tebs Work Group                                                            }
{----------------------------------------------------------------------------}
interface
uses
  NativeXml, System.Classes, System.SysUtils, CommLib,
  System.Generics.Collections;

type

  //为了自动释放的特性，使用接口
  {$REGION 'Interface'}
  IConfigNode = interface
    ['{67323F7D-9E6C-420B-BF1C-92457D829380}']
    function EnmuConfigNames: TStringList;
    function EnmuConfigValues: TStringList;
    function GetName: string;
    function GetValueByConfig(AConfig: string): string;
    function ValueWithDefault(AConfig: string; ADefualt: string):string;
    procedure DeleteConfig(const AConfig: string);
    procedure SetValueByConfig(AConfig: string; const Value: string);
    property Value[AConfig: string]: string read GetValueByConfig write SetValueByConfig; default;
    property Name: string read GetName;
  end;

  IConfigNodes = interface
    ['{56DBB6F5-BD64-4F07-A949-300877B1B787}']
    function AddConfigNode(AName: string): IConfigNode;
    function EnmuConfigNodes: TStringList;
    function GetConfigNodeByIndex(AIndex: Integer): IConfigNode;
    function GetConfigNodeByName(AName: string): IConfigNode;
    function GetConfigNodeCount: Integer;
    procedure DeleteConfig(AName: string);
    property ConfigNode[AName: string]: IConfigNode read GetConfigNodeByName; default;
    property Count: Integer read GetConfigNodeCount;
    property Nodes[AIndex: Integer]: IConfigNode read GetConfigNodeByIndex;
  end;

  IRootNode = interface
    ['{65213F85-0804-4FE1-A726-CFC0F082AC93}']
    function GetConfigsByType(AType: string): IConfigNodes;
    property Configs[AType: string]: IConfigNodes read GetConfigsByType; default;
  end;
  {$ENDREGION}

  TConfigNode = class(TInterfacedObject, IConfigNode)
  private
    FXMLNode: TXmlNode;
    function GetName: string;
  protected
    function GetValueByConfig(AConfig: string): string;
    procedure SetValueByConfig(AConfig: string; const Value: string);
  public
    constructor Create(AXmlNode: TXmlNode);
    destructor Destroy; override;
    function EnmuConfigNames: TStringList;
    function EnmuConfigValues: TStringList;
    function ValueWithDefault(AConfig: string; ADefualt: string):string;
    procedure DeleteConfig(const AConfig: string);
    property Value[AConfig: string]: string read GetValueByConfig write SetValueByConfig; default;
    property Name: string read GetName;
  end;

  TConfigNodes = class(TInterfacedObject, IConfigNodes)
  private
    FType: string;
    FRootNode: TXmlNode;
    FXmlNodes: TList<TXmlNode>;
  protected
    function GetConfigNodeByIndex(AIndex: Integer): IConfigNode;
    function GetConfigNodeByName(AName: string): IConfigNode;
    function GetConfigNodeCount: Integer;
  public
    constructor Create(const ARootNode: TXmlNode; const AType: string);
    destructor Destroy; override;
    function AddConfigNode(AName: string): IConfigNode;
    function EnmuConfigNodes: TStringList;
    procedure DeleteConfig(AName: string);
    property ConfigNode[AName: string]: IConfigNode read GetConfigNodeByName; default;
    property Count: Integer read GetConfigNodeCount;
    property Nodes[AIndex: Integer]: IConfigNode read GetConfigNodeByIndex;
  end;

  TRootNode = class(TInterfacedObject, IRootNode)
  private
    FRootNode: TXmlNode;
  public
    constructor Create(AXmlNode: TXmlNode);
    destructor Destroy; override;
    function GetConfigsByType(AType: string): IConfigNodes;
  end;

  TXMLConfig = class(TObject)
  private
    FAutoSave: Boolean;
    FConfig: TNativeXml;
    FConfigName: string;
    FConfigPath: string;
  protected
    function GetRoot:IRootNode;
  public
    class function RegisterFileInfo(AFileInfo: IFileInfo): Boolean;
    constructor Create(ConfigName: string);
    destructor Destroy; override;
    procedure Save;
    property Root: IRootNode read GetRoot;
    property AutoSave: Boolean read FAutoSave write FAutoSave;
  end;

implementation
var
  AppFileInfo: IFileInfo = nil;
const
  ConfigExt: string = '.config';
  UnRegFileInfo: string = '文件接口未注册，无法获取配置文件路径！';

{ TXMLConfig }

constructor TXMLConfig.Create(ConfigName: string);
begin
  if Assigned(AppFileInfo) then
  begin
    inherited Create;
    FConfigName := ConfigName;
    FConfigPath := AppFileInfo.ConfigPath + ConfigName + ConfigExt;
    FConfig := TNativeXml.Create(nil);
    FConfig.Charset := 'utf-8';
    FConfig.XmlFormat := xfReadable;
    FAutoSave := True;
    if FileExists(FConfigPath) then
      FConfig.LoadFromFile(FConfigPath)
    else begin
      FConfig.VersionString := '1.0';
      FConfig.Root.Name := 'ConfigData';
      Save;
    end;
  end else
    raise ERayException.Create(UnRegFileInfo);
end;

destructor TXMLConfig.Destroy;
begin
  if FAutoSave then Save;
  FreeAndNil(FConfig);
  inherited;
end;

function TXMLConfig.GetRoot: IRootNode;
begin
  Result := TRootNode.Create(FConfig.Root);
end;

class function TXMLConfig.RegisterFileInfo(AFileInfo: IFileInfo): Boolean;
begin
  Result := Supports(AFileInfo, IFileInfo, AppFileInfo);
end;

procedure TXMLConfig.Save;
begin
  FConfig.SaveToFile(FConfigPath);
end;

{ TConfigNode }

constructor TConfigNode.Create(AXmlNode: TXmlNode);
begin
  inherited Create();
  FXMLNode := AXmlNode;
end;

procedure TConfigNode.DeleteConfig(const AConfig: string);
begin
  FXMLNode.AttributeByName[UTF8Encode(AConfig)].Delete;
end;

destructor TConfigNode.Destroy;
begin
  //这里不能释放Node，需要配合整个XML一起释放，若单独释放，会有意想不到的问题
  FXMLNode := nil;
  inherited;
end;

function TConfigNode.EnmuConfigNames: TStringList;
var
  I: Integer;
begin
  Result := TStringList.Create;
  for I := 0 to FXMLNode.AttributeCount - 1 do
  begin
    Result.Add(FXMLNode.Attributes[i].NameUnicode);
  end;
end;

function TConfigNode.EnmuConfigValues: TStringList;
var
  I: Integer;
begin
  Result := TStringList.Create;
  for I := 0 to FXMLNode.AttributeCount - 1 do
  begin
    Result.Add(FXMLNode.Attributes[i].ValueUnicode);
  end;
end;

function TConfigNode.GetName: string;
begin
  Result := FXMLNode.AttributeValueByNameWide['Name'];
end;

function TConfigNode.GetValueByConfig(AConfig: string): string;
begin
  Result := FXMLNode.AttributeValueByNameWide[UTF8Encode(AConfig)];
end;

procedure TConfigNode.SetValueByConfig(AConfig: string; const Value: string);
var
  AAttribute: TsdAttribute;
begin
  AAttribute := FXMLNode.AttributeByName[UTF8Encode(AConfig)];
  if Assigned(AAttribute) then
  begin
    AAttribute.ValueUnicode := Value;
  end else
  begin
    FXMLNode.AttributeAdd(UTF8Encode(AConfig), UTF8Encode(Value));
  end;
  AAttribute := nil;
end;

function TConfigNode.ValueWithDefault(AConfig, ADefualt: string): string;
begin
  Result := Value[AConfig];
  if Result = EmptyStr then
  begin
    Value[AConfig] := ADefualt;
    Result := ADefualt;
  end;
end;

{ TConfigNodes }

function TConfigNodes.AddConfigNode(AName: string): IConfigNode;
var
  AXmlNode: TXmlNode;
begin
  Result := GetConfigNodeByName(AName);
  if Result = nil then
  begin
    AXmlNode := FRootNode.NodeNew(UTF8Encode(FType));
    AXmlNode.AttributeAdd('Name',UTF8Encode(AName));
    FXmlNodes.Add(AXmlNode);
    Result := TConfigNode.Create(AXmlNode);
  end;
  AXmlNode := nil;
end;

constructor TConfigNodes.Create(const ARootNode: TXmlNode; const AType: string);
var
  I: Integer;
begin
  inherited Create();
  FRootNode := ARootNode;
  FXmlNodes := TList<TXmlNode>.Create;
  FType := AType;
  for I := 0 to ARootNode.ElementCount - 1 do
  begin
    if ARootNode.Elements[i].NameUnicode = AType then
    begin
      FXmlNodes.Add(ARootNode.Elements[i]);
    end;
  end;
end;

procedure TConfigNodes.DeleteConfig(AName: string);
var
  I: Integer;
begin
  for I := 0 to FXmlNodes.Count - 1 do
  begin
    if FXmlNodes[i].AttributeValueByNameWide['Name'] = AName then
    begin
      FXmlNodes[i].Delete;
      FXmlNodes.Delete(i);
      Exit;
    end;
  end;
end;

destructor TConfigNodes.Destroy;
begin
  FreeAndNil(FXmlNodes);
  inherited;
end;

function TConfigNodes.EnmuConfigNodes: TStringList;
var
  I: Integer;
begin
  Result := TStringList.Create;
  for I := 0 to FXmlNodes.Count - 1 do
  begin
    Result.Add(FXmlNodes[i].AttributeValueByNameWide['Name']);
  end;
end;

function TConfigNodes.GetConfigNodeByIndex(AIndex: Integer): IConfigNode;
begin
  Result := TConfigNode.Create(FXmlNodes[AIndex]);
end;

function TConfigNodes.GetConfigNodeByName(AName: string): IConfigNode;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to FXmlNodes.Count - 1 do
  begin
    if FXmlNodes[i].AttributeValueByNameWide['Name'] = AName then
    begin
      Result := TConfigNode.Create(FXmlNodes[i]);
      Exit;
    end;
  end;
end;

function TConfigNodes.GetConfigNodeCount: Integer;
begin
  Result := FXmlNodes.Count;
end;

{ TRootNode }

constructor TRootNode.Create(AXmlNode: TXmlNode);
begin
  inherited Create();
  FRootNode := AXmlNode;
end;

destructor TRootNode.Destroy;
begin
  // 不能释放，等待随主类释放
  FRootNode := nil;
  inherited;
end;

function TRootNode.GetConfigsByType(AType: string): IConfigNodes;
begin
  Result := TConfigNodes.Create(FRootNode, AType);
end;

end.

因为项目特性，里面有注册FILEINFO的接口，这是我自己项目中的一个全局文件管理类。若大家不需要的话，直接更换成自己的配置文件目录就好了。

调用例子：

procedure TFrm1.Btn1Click(Sender: TObject);
var
  AServerList : TStrings ;
  ILoginInfo: IConfigNode;
begin
  //获取服务器列表
  AServerList := AppServerConfig.Root['AppServer'].EnmuConfigNodes;
  CbxServer.Properties.Items.AddStrings(AServerList);
  FreeAndNil(AServerList);
  ILoginInfo := UserConfig.Root['LoginInfo'].AddConfigNode('Default');
  //读取上次登录的用户名
  TxtUserName.Text := ILoginInfo['LastUser'];
  //读取上次登录的服务器名
  CbxServer.Text := ILoginInfo['LastServer'];
  ILoginInfo := nil;
end;

配置文件样式：

<?xml encoding="utf-8" version="1.0"?>
<ConfigData>
    <LoginInfo Name="Default" LastUser="Test" LastServer="Test" LastRole=""/>
    <ReportDlgCfg Name="Default" ShowPrintDlg="0" ShowExportDlg="0" AutoCreateDir="0" OpenFile="0" LastPrinter="Microsoft XPS Document Writer"/>
</ConfigData>