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>

 

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                                                            }{----------------------------------------------------------------------------}interfaceuses  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;
implementationvar  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.