XML配置文件读取类[DELPHI]

原作者: [db:作者] 来自: [db:来源] 收藏邀请

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

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

废话不多说，上代码！

  1 unit XMLConfig;
  2 {----------------------------------------------------------------------------}
  3 { 这个单元用来处理XML配置文件，对配置文件格式有默认要求                             }
  4 { 格式为，只允许有一个root，然后root下对应配置文件，                               }
  5 { 所有配置，均使用xml属性存取配置，属性中必须存在Name属性，                         }
  6 { 不得单独使用下级Node                                                         }
  7 { PS: 使用NativeXML库作为XML取数基本集，NativeXML请自行获取                      }
  8 { By Raymond.Zhang @ 2012.07.12 Mail: [email protected]                     }
  9 { Tebs Work Group                                                            }
 10 {----------------------------------------------------------------------------}
 11 interface
 12 uses
 13   NativeXml, System.Classes, System.SysUtils, CommLib,
 14   System.Generics.Collections;
 15 
 16 type
 17 
 18   //为了自动释放的特性，使用接口
 19   {$REGION 'Interface'}
 20   IConfigNode = interface
 21     ['{67323F7D-9E6C-420B-BF1C-92457D829380}']
 22     function EnmuConfigNames: TStringList;
 23     function EnmuConfigValues: TStringList;
 24     function GetName: string;
 25     function GetValueByConfig(AConfig: string): string;
 26     function ValueWithDefault(AConfig: string; ADefualt: string):string;
 27     procedure DeleteConfig(const AConfig: string);
 28     procedure SetValueByConfig(AConfig: string; const Value: string);
 29     property Value[AConfig: string]: string read GetValueByConfig write SetValueByConfig; default;
 30     property Name: string read GetName;
 31   end;
 32 
 33   IConfigNodes = interface
 34     ['{56DBB6F5-BD64-4F07-A949-300877B1B787}']
 35     function AddConfigNode(AName: string): IConfigNode;
 36     function EnmuConfigNodes: TStringList;
 37     function GetConfigNodeByIndex(AIndex: Integer): IConfigNode;
 38     function GetConfigNodeByName(AName: string): IConfigNode;
 39     function GetConfigNodeCount: Integer;
 40     procedure DeleteConfig(AName: string);
 41     property ConfigNode[AName: string]: IConfigNode read GetConfigNodeByName; default;
 42     property Count: Integer read GetConfigNodeCount;
 43     property Nodes[AIndex: Integer]: IConfigNode read GetConfigNodeByIndex;
 44   end;
 45 
 46   IRootNode = interface
 47     ['{65213F85-0804-4FE1-A726-CFC0F082AC93}']
 48     function GetConfigsByType(AType: string): IConfigNodes;
 49     property Configs[AType: string]: IConfigNodes read GetConfigsByType; default;
 50   end;
 51   {$ENDREGION}
 52 
 53   TConfigNode = class(TInterfacedObject, IConfigNode)
 54   private
 55     FXMLNode: TXmlNode;
 56     function GetName: string;
 57   protected
 58     function GetValueByConfig(AConfig: string): string;
 59     procedure SetValueByConfig(AConfig: string; const Value: string);
 60   public
 61     constructor Create(AXmlNode: TXmlNode);
 62     destructor Destroy; override;
 63     function EnmuConfigNames: TStringList;
 64     function EnmuConfigValues: TStringList;
 65     function ValueWithDefault(AConfig: string; ADefualt: string):string;
 66     procedure DeleteConfig(const AConfig: string);
 67     property Value[AConfig: string]: string read GetValueByConfig write SetValueByConfig; default;
 68     property Name: string read GetName;
 69   end;
 70 
 71   TConfigNodes = class(TInterfacedObject, IConfigNodes)
 72   private
 73     FType: string;
 74     FRootNode: TXmlNode;
 75     FXmlNodes: TList<TXmlNode>;
 76   protected
 77     function GetConfigNodeByIndex(AIndex: Integer): IConfigNode;
 78     function GetConfigNodeByName(AName: string): IConfigNode;
 79     function GetConfigNodeCount: Integer;
 80   public
 81     constructor Create(const ARootNode: TXmlNode; const AType: string);
 82     destructor Destroy; override;
 83     function AddConfigNode(AName: string): IConfigNode;
 84     function EnmuConfigNodes: TStringList;
 85     procedure DeleteConfig(AName: string);
 86     property ConfigNode[AName: string]: IConfigNode read GetConfigNodeByName; default;
 87     property Count: Integer read GetConfigNodeCount;
 88     property Nodes[AIndex: Integer]: IConfigNode read GetConfigNodeByIndex;
 89   end;
 90 
 91   TRootNode = class(TInterfacedObject, IRootNode)
 92   private
 93     FRootNode: TXmlNode;
 94   public
 95     constructor Create(AXmlNode: TXmlNode);
 96     destructor Destroy; override;
 97     function GetConfigsByType(AType: string): IConfigNodes;
 98   end;
 99 
100   TXMLConfig = class(TObject)
101   private
102     FAutoSave: Boolean;
103     FConfig: TNativeXml;
104     FConfigName: string;
105     FConfigPath: string;
106   protected
107     function GetRoot:IRootNode;
108   public
109     class function RegisterFileInfo(AFileInfo: IFileInfo): Boolean;
110     constructor Create(ConfigName: string);
111     destructor Destroy; override;
112     procedure Save;
113     property Root: IRootNode read GetRoot;
114     property AutoSave: Boolean read FAutoSave write FAutoSave;
115   end;
116 
117 implementation
118 var
119   AppFileInfo: IFileInfo = nil;
120 const
121   ConfigExt: string = '.config';
122   UnRegFileInfo: string = '文件接口未注册，无法获取配置文件路径！';
123 
124 { TXMLConfig }
125 
126 constructor TXMLConfig.Create(ConfigName: string);
127 begin
128   if Assigned(AppFileInfo) then
129   begin
130     inherited Create;
131     FConfigName := ConfigName;
132     FConfigPath := AppFileInfo.ConfigPath + ConfigName + ConfigExt;
133     FConfig := TNativeXml.Create(nil);
134     FConfig.Charset := 'utf-8';
135     FConfig.XmlFormat := xfReadable;
136     FAutoSave := True;
137     if FileExists(FConfigPath) then
138       FConfig.LoadFromFile(FConfigPath)
139     else begin
140       FConfig.VersionString := '1.0';
141       FConfig.Root.Name := 'ConfigData';
142       Save;
143     end;
144   end else
145     raise ERayException.Create(UnRegFileInfo);
146 end;
147 
148 destructor TXMLConfig.Destroy;
149 begin
150   if FAutoSave then Save;
151   FreeAndNil(FConfig);
152   inherited;
153 end;
154 
155 function TXMLConfig.GetRoot: IRootNode;
156 begin
157   Result := TRootNode.Create(FConfig.Root);
158 end;
159 
160 class function TXMLConfig.RegisterFileInfo(AFileInfo: IFileInfo): Boolean;
161 begin
162   Result := Supports(AFileInfo, IFileInfo, AppFileInfo);
163 end;
164 
165 procedure TXMLConfig.Save;
166 begin
167   FConfig.SaveToFile(FConfigPath);
168 end;
169 
170 { TConfigNode }
171 
172 constructor TConfigNode.Create(AXmlNode: TXmlNode);
173 begin
174   inherited Create();
175   FXMLNode := AXmlNode;
176 end;
177 
178 procedure TConfigNode.DeleteConfig(const AConfig: string);
179 begin
180   FXMLNode.AttributeByName[UTF8Encode(AConfig)].Delete;
181 end;
182 
183 destructor TConfigNode.Destroy;
184 begin
185   //这里不能释放Node，需要配合整个XML一起释放，若单独释放，会有意想不到的问题
186   FXMLNode := nil;
187   inherited;
188 end;
189 
190 function TConfigNode.EnmuConfigNames: TStringList;
191 var
192   I: Integer;
193 begin
194   Result := TStringList.Create;
195   for I := 0 to FXMLNode.AttributeCount - 1 do
196   begin
197     Result.Add(FXMLNode.Attributes[i].NameUnicode);
198   end;
199 end;
200 
201 function TConfigNode.EnmuConfigValues: TStringList;
202 var
203   I: Integer;
204 begin
205   Result := TStringList.Create;
206   for I := 0 to FXMLNode.AttributeCount - 1 do
207   begin
208     Result.Add(FXMLNode.Attributes[i].ValueUnicode);
209   end;
210 end;
211 
212 function TConfigNode.GetName: string;
213 begin
214   Result := FXMLNode.AttributeValueByNameWide['Name'];
215 end;
216 
217 function TConfigNode.GetValueByConfig(AConfig: string): string;
218 begin
219   Result := FXMLNode.AttributeValueByNameWide[UTF8Encode(AConfig)];
220 end;
221 
222 procedure TConfigNode.SetValueByConfig(AConfig: string; const Value: string);
223 var
224   AAttribute: TsdAttribute;
225 begin
226   AAttribute := FXMLNode.AttributeByName[UTF8Encode(AConfig)];
227   if Assigned(AAttribute) then
228   begin
229     AAttribute.ValueUnicode := Value;
230   end else
231   begin
232     FXMLNode.AttributeAdd(UTF8Encode(AConfig), UTF8Encode(Value));
233   end;
234   AAttribute := nil;
235 end;
236 
237 function TConfigNode.ValueWithDefault(AConfig, ADefualt: string): string;
238 begin
239   Result := Value[AConfig];
240   if Result = EmptyStr then
241   begin
242     Value[AConfig] := ADefualt;
243     Result := ADefualt;
244   end;
245 end;
246 
247 { TConfigNodes }
248 
249 function TConfigNodes.AddConfigNode(AName: string): IConfigNode;
250 var
251   AXmlNode: TXmlNode;
252 begin
253   Result := GetConfigNodeByName(AName);
254   if Result = nil then
255   begin
256     AXmlNode := FRootNode.NodeNew(UTF8Encode(FType));
257     AXmlNode.AttributeAdd('Name',UTF8Encode(AName));
258     FXmlNodes.Add(AXmlNode);
259     Result := TConfigNode.Create(AXmlNode);
260   end;
261   AXmlNode := nil;
262 end;
263 
264 constructor TConfigNodes.Create(const ARootNode: TXmlNode; const AType: string);
265 var
266   I: Integer;
267 begin
268   inherited Create();
269   FRootNode := ARootNode;
270   FXmlNodes := TList<TXmlNode>.Create;
271   FType := AType;
272   for I := 0 to ARootNode.ElementCount - 1 do
273   begin
274     if ARootNode.Elements[i].NameUnicode = AType then
275     begin
276       FXmlNodes.Add(ARootNode.Elements[i]);
277     end;
278   end;
279 end;
280 
281 procedure TConfigNodes.DeleteConfig(AName: string);
282 var
283   I: Integer;
284 begin
285   for I := 0 to FXmlNodes.Count - 1 do
286   begin
287     if FXmlNodes[i].AttributeValueByNameWide['Name'] = AName then
288     begin
289       FXmlNodes[i].Delete;
290       FXmlNodes.Delete(i);
291       Exit;
292     end;
293   end;
294 end;
295 
296 destructor TConfigNodes.Destroy;
297 begin
298   FreeAndNil(FXmlNodes);
299   inherited;
300 end;
301 
302 function TConfigNodes.EnmuConfigNodes: TStringList;
303 var
304   I: Integer;
305 begin
306   Result := TStringList.Create;
307   for I := 0 to FXmlNodes.Count - 1 do
308   begin
309     Result.Add(FXmlNodes[i].AttributeValueByNameWide['Name']);
310   end;
311 end;
312 
313 function TConfigNodes.GetConfigNodeByIndex(AIndex: Integer): IConfigNode;
314 begin
315   Result := TConfigNode.Create(FXmlNodes[AIndex]);
316 end;
317 
318 function TConfigNodes.GetConfigNodeByName(AName: string): IConfigNode;
319 var
320   I: Integer;
321 begin
322   Result := nil;
323   for I := 0 to FXmlNodes.Count - 1 do
324   begin
325     if FXmlNodes[i].AttributeValueByNameWide['Name'] = AName then
326     begin
327       Result := TConfigNode.Create(FXmlNodes[i]);
328       Exit;
329     end;
330   end;
331 end;
332 
333 function TConfigNodes.GetConfigNodeCount: Integer;
334 begin
335   Result := FXmlNodes.Count;
336 end;
337 
338 { TRootNode }
339 
340 constructor TRootNode.Create(AXmlNode: TXmlNode);
341 begin
342   inherited Create();
343   FRootNode := AXmlNode;
344 end;
345 
346 destructor TRootNode.Destroy;
347 begin
348   // 不能释放，等待随主类释放
349   FRootNode := nil;
350   inherited;
351 end;
352 
353 function TRootNode.GetConfigsByType(AType: string): IConfigNodes;
354 begin
355   Result := TConfigNodes.Create(FRootNode, AType);
356 end;
357 
358 end.

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

调用例子：

 1 procedure TFrm1.Btn1Click(Sender: TObject);
 2 var
 3   AServerList : TStrings ;
 4   ILoginInfo: IConfigNode;
 5 begin
 6   //获取服务器列表
 7   AServerList := AppServerConfig.Root['AppServer'].EnmuConfigNodes;
 8   CbxServer.Properties.Items.AddStrings(AServerList);
 9   FreeAndNil(AServerList);
10   ILoginInfo := UserConfig.Root['LoginInfo'].AddConfigNode('Default');
11   //读取上次登录的用户名
12   TxtUserName.Text := ILoginInfo['LastUser'];
13   //读取上次登录的服务器名
14   CbxServer.Text := ILoginInfo['LastServer'];
15   ILoginInfo := nil;
16 end;

配置文件样式：

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