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>


联系电话:
020-00000000
联系电话:
020-00000000
联系电话:
020-12345678