XML配置文件读取类[DELPHI]
发现用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: Acni.ray@gmail.com }
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>
- 上一篇 »java常用工具类，三—— 文件读取的操作类
- 下一篇 »php网页读取四种配置文件的代码