发现用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;