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.
· 浏览器原生「磁吸」效果!Anchor Positioning 锚点定位神器解析
· 没有源码,如何修改代码逻辑?
· 一个奇形怪状的面试题:Bean中的CHM要不要加volatile?
· [.NET]调用本地 Deepseek 模型
· 一个费力不讨好的项目,让我损失了近一半的绩效!
· 全网最简单!3分钟用满血DeepSeek R1开发一款AI智能客服,零代码轻松接入微信、公众号、小程
· .NET 10 首个预览版发布,跨平台开发与性能全面提升
· 《HelloGitHub》第 107 期
· 全程使用 AI 从 0 到 1 写了个小工具
· 从文本到图像:SSE 如何助力 AI 内容实时呈现?(Typescript篇)
2019-08-12 Delphi实现树型结构具体实例
2019-08-12 学习 TTreeView [15] - 连接数据库 (作为给 "丁永其" 和 "DELPHI万岁" 两位朋友的回复)
2019-08-12 delphi中Treeview的使用介绍
2019-08-12 按下F2编辑dxDBTreeView的节点
2019-08-12 dbtreeview
2019-08-12 我的dbtreeview–treeview直接连接数据表_delphi教程
2019-08-12 SqlDbx连接oracle(可用)