-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathOmniXMLProperties.pas
1308 lines (1178 loc) · 42 KB
/
OmniXMLProperties.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
(*:XML helper unit. Contains a class to simplify creation of node-wrapper
classes (classes that contain properties that map directly to the child nodes
of some XML node).
@author Primoz Gabrijelcic
@desc <pre>
(c) 2010 Primoz Gabrijelcic
Free for personal and commercial use. No rights reserved.
Author : Primoz Gabrijelcic
Creation date : 2001-06-17
Last modification : 2010-01-22
Version : 2.02b
</pre>*)(*
History:
2.02b: 2010-01-22
- TGpXMLDoc.LoadFromString can be passed an empty string.
2.02a: 2009-07-15
- Bug fixed: If TGpXMLDoc.LoadFromString failed, internal XML document got corrupted.
2.02: 2005-04-27
- [Miha Vrhovnik] Added WideString functions: GetXMLPropCDataWide,
SetXMLPropCDataWide, GetXMLPropCDataOrTextWide, GetXMLPropCDataOrText.
2.01: 2004-08-13
- Added WideString accessors GetXMLAttrPropWide, GetXMLPropWide,
SetXMLAttrPropWide, and SetXMLPropWide to the TGpXMLData class.
2.0a: 2004-03-01
- Adapted for OmniXMLUtils 1.19.
2.0: 2003-12-12
- Major modifications to allow reading of RSS files (and other XML
documents, of course).
- TGpXMLDoc is now a TGpXMLData, too.
- *List classes can now drop the 'listTag' in the constructor. Root
class node will be used as a list wrapper in this case.
- Added indexed property Items[] to both *List classes.
- Added Get/SetXMLAttrProp* to the TGpXMLData class.
- Added Get/SetXMLPropCDATA to the TGpXMLData class.
1.09: 2003-11-27
- Renamed CreateChildren method into RecreateChildren to serve as a
visual reminder that it may be called when children are already created
(in which case old instances must be destroyed first).
1.08b: 2003-04-20
- Bug fixed: Clearing TGpXMLList did not clear associated nodes.
1.08a: 2003-01-16
- Fixed range check error in SetXMLPropDWORD.
1.08: 2003-01-13
- Removed processing of default values in SetXMLProp* setters - it was
causing a confusion when used in conjunction with the Assign method.
1.07: 2003-01-13
- Added TGpXMLData.InitChildNodes that greatly simplifies data node
initialization.
- Fixed saving - volatile/private markers are now not saved in the
document element node anymore.
1.06a: 2003-01-08
- Standalone AsString fixed to work with volatile nodes.
- TGpXMLDoc.AsString fixed to twork with volatile nodes.
1.06: 2003-01-07
- Added TGpXMLVolatileData class. It is only returned as a part of the
AsString result and is _not_ saved in the TGpXMLDoc.SaveTo* methods.
1.05: 2002-12-26
- Added '_' support to the TGpXMLData class.
- Added parameterless constructor to the TGpXMLData class.
- Added 'load from string' constructor to the TGpXMLData class.
- Added property AsString to the TGpXMLData class.
1.04: 2002-12-22
- Added property AsString to the TGpXMLDoc class.
1.03: 2002-12-09
- MSXML compatible (define USE_MSXML).
1.02: 2002-10-01
- TXMLData now implements Text property allowing for text-only nodes.
1.01a: 2002-05-15
- Fixed bug in TGpXMLList.Delete.
1.01: 2001-12-01
- Added functions LoadFromString, LoadFromRegistry, SaveToString,
SaveToRegistry to the TGpXMLDoc class.
- Added parameter outputFormat to TGpXMLDoc.SaveToFile and
TGpXMLDoc.SaveToStream.
- New class TGpXMLDocList.
1.0: 2001-10-24
- Created by extracting database-related functionality from unit GpXML.
- Implemented TGpXMLDoc.LoadFromStream and TGpXMLDoc.SaveToStream.
*)
unit OmniXMLProperties;
interface
{$I OmniXML.inc}
uses
{$IFDEF MSWINDOWS}
Windows,
{$ENDIF}
{$IFDEF LINUX}
Types, // declares DWORD
{$ENDIF}
Classes,
Contnrs,
TypInfo,
{$IFDEF HAS_UNIT_VARIANTS}
Variants,
{$ENDIF}
OmniXML
{$IFDEF USE_MSXML}
, OmniXML_MSXML
{$ENDIF}
;
// TODO 3 -oPrimoz Gabrijelcic: Convert Load/Save routines to use mr_XML error reporting system.
type
TGpXMLList = class;
{:Base class that handles most functionality of getting and setting XML-based
properties. Derived class typically only has to declare indexed properties
and initialize xmlChildNodeDefaults and xmlChildNodeTags arrays in the
overridden constructor.
Note that Int64 is not compatible with Variant. If you want to set the
default value for a Int64 property, specify it as a string. GetXMLPropInt64
will use StrToInt64 to convert default value into a number.
}
TGpXMLData = class
private
xmlList: TGpXMLList;
xmlNode: IXMLNode;
protected
xmlChildNodeDefaults: array of Variant;
xmlChildNodeTags : array of string;
xmlXMLDoc : IXMLDocument;
procedure FilterNodes(node: IXMLNode; var canProcess: boolean); virtual;
procedure FilterPrivateNodes(node: IXMLNode; var canProcess: boolean); virtual;
function GetAsString: string; virtual;
function GetText: string; virtual;
function GetXMLAttrProp(index: integer): string; virtual;
function GetXMLAttrPropBool(index: integer): boolean; virtual;
function GetXMLAttrPropCardinal(index: integer): cardinal; virtual;
function GetXMLAttrPropDate(index: integer): TDateTime; virtual;
function GetXMLAttrPropDateTime(index: integer): TDateTime; virtual;
function GetXMLAttrPropDWORD(index: integer): DWORD; virtual;
function GetXMLAttrPropInt(index: integer): integer; virtual;
function GetXMLAttrPropInt64(index: integer): int64; virtual;
function GetXMLAttrPropReal(index: integer): real; virtual;
function GetXMLAttrPropTime(index: integer): TDateTime; virtual;
function GetXMLAttrPropWide(index: integer): WideString; virtual;
function GetXMLProp(index: integer): string; virtual;
function GetXMLPropBool(index: integer): boolean; virtual;
function GetXMLPropCardinal(index: integer): cardinal; virtual;
function GetXMLPropCData(index: integer): string; virtual;
function GetXMLPropCDataWide(index: integer): WideString; virtual;
function GetXMLPropCDataOrTextWide(index: integer): WideString; virtual;
function GetXMLPropCDataOrText(index: integer): string; virtual;
function GetXMLPropDate(index: integer): TDateTime; virtual;
function GetXMLPropDateTime(index: integer): TDateTime; virtual;
function GetXMLPropDWORD(index: integer): DWORD; virtual;
function GetXMLPropInt(index: integer): integer; virtual;
function GetXMLPropInt64(index: integer): int64; virtual;
function GetXMLPropReal(index: integer): real; virtual;
function GetXMLPropTime(index: integer): TDateTime; virtual;
function GetXMLPropWide(index: integer): WideString; virtual;
procedure InitChildNodes(tags: array of string; defaults: array of Variant); virtual;
procedure SetAsString(const Value: string); virtual;
procedure SetText(const Value: string); virtual;
procedure SetXMLAttrProp(const index: integer; const value: string); virtual;
procedure SetXMLAttrPropBool(const index: integer; const value: boolean); virtual;
procedure SetXMLAttrPropCardinal(const index: integer; const value: cardinal); virtual;
procedure SetXMLAttrPropDate(const index: integer; const value: TDateTime); virtual;
procedure SetXMLAttrPropDateTime(const index: integer; const value: TDateTime); virtual;
procedure SetXMLAttrPropDWORD(const index: integer; const value: DWORD); virtual;
procedure SetXMLAttrPropInt(const index: integer; const value: integer); virtual;
procedure SetXMLAttrPropInt64(const index: integer; const value: int64); virtual;
procedure SetXMLAttrPropReal(const index: integer; const value: real); virtual;
procedure SetXMLAttrPropTime(const index: integer; const value: TDateTime); virtual;
procedure SetXMLAttrPropWide(const index: integer; const value: WideString); virtual;
procedure SetXMLProp(const index: integer; const value: string); virtual;
procedure SetXMLPropBool(const index: integer; const value: boolean); virtual;
procedure SetXMLPropCardinal(const index: integer; const value: cardinal); virtual;
procedure SetXMLPropCData(const index: integer; const value: string); virtual;
procedure SetXMLPropCDataWide(const index: integer; const value: WideString); virtual;
procedure SetXMLPropDate(const index: integer; const value: TDateTime); virtual;
procedure SetXMLPropDateTime(const index: integer; const value: TDateTime); virtual;
procedure SetXMLPropDWORD(const index: integer; const value: DWORD); virtual;
procedure SetXMLPropInt(const index: integer; const value: integer); virtual;
procedure SetXMLPropInt64(const index: integer; const value: int64); virtual;
procedure SetXMLPropReal(const index: integer; const value: real); virtual;
procedure SetXMLPropTime(const index: integer; const value: TDateTime); virtual;
procedure SetXMLPropWide(const index: integer; const value: WideString); virtual;
property OwnerList: TGpXMLList read xmlList write xmlList;
public
constructor Create(node: IXMLNode); overload; virtual; // use this constructor in most cases
constructor Create(nodeData: string); overload; virtual; // do other constructors need to be public?
constructor Create(parentNode: IXMLNode; nodeTag: string); overload; virtual;
constructor Create; overload; virtual;
procedure Assign(dataNode: TGpXMLData);
procedure AssignNonvolatile(dataNode: TGpXMLData);
property AsString: string read GetAsString write SetAsString;
property Node: IXMLNode read xmlNode;
property Text: string read GetText write SetText;
end; { TGpXMLData }
TGpXMLDataClass = class of TGpXMLData;
{:Data class that is stringable but not persistent.
@since 2003-01-06
}
TGpXMLVolatileData = class(TGpXMLData)
protected
procedure MarkVolatile; virtual;
public
constructor Create(node: IXMLNode); overload; override;
constructor Create; overload; override;
end; { TGpXMLVolatileData }
{:Data class that is not streamable - it cannot be stored or extracted as a
string.
OK, that is a lie, you can do the XMLSaveToString(TGpXMLList.XMLDoc), but
you are not supposed to.
@since 2003-01-09
}
TGpXMLPrivateData = class(TGpXMLData)
protected
procedure MarkPrivate; virtual;
public
constructor Create(node: IXMLNode); overload; override;
constructor Create; overload; override;
end; { TGpXMLPrivateData }
{:Base class handling list of twisty little TGpXMLData objects, all alike.
Contains _no_ default indexed property - it should be created in derived
classes.
}
TGpXMLList = class
private
xmlChildClass: TGpXMLDataClass;
xmlChildTag : string;
xmlChildNodes: TObjectList; // of TGpXMLData
xmlNode : IXMLNode;
protected
function CreateStandalone: TGpXMLData;
function Get(idx: integer): TGpXMLData;
public
constructor Create(parentNode: IXMLNode; nodeTag, childTag: string;
childClass: TGpXMLDataClass); virtual;
destructor Destroy; override;
function Add: TGpXMLData; virtual;
procedure Clear; virtual;
function Count: integer; virtual;
procedure Delete(childNode: TGpXMLData); virtual;
function IndexOf(childNode: TGpXMLData): integer;
property Items[idxItem: integer]: TGpXMLData read Get;
property Node: IXMLNode read xmlNode;
end; { TGpXMLList }
{:Encapsulation of the XML document containing methods for loading and
saving state. Derived classes will typically want to override
RecreateChildren to create owned objects.
}
TGpXMLDoc = class(TGpXMLData)
private
xmlLastError: string;
xmlRootTag : string;
protected
function CreatePersistentClone: IXMLDocument; virtual;
function GetAsString: string; override;
function GetXMLRoot: IXMLElement; virtual;
procedure SetAsString(const Value: string); override;
public
constructor Create(rootTag: string); reintroduce;
constructor Clone(doc: TGpXMLDoc); virtual;
procedure CreateRootNode; virtual;
function LoadFromFile(const fileName: string): boolean; virtual;
{$IFDEF MSWINDOWS}
function LoadFromRegistry(rootKey: HKEY; const key, value: string): boolean; virtual;
function SaveToRegistry(rootKey: HKEY; const key, value: string; outputFormat: TOutputFormat = ofNone): boolean; virtual;
{$ENDIF}
function LoadFromStream(stream: TStream): boolean; virtual;
function LoadFromString(const dataString: string): boolean; virtual;
procedure RecreateChildren; virtual;
procedure Reset; virtual;
function SaveToFile(const fileName: string; outputFormat: TOutputFormat = ofNone): boolean; virtual;
function SaveToStream(stream: TStream; outputFormat: TOutputFormat = ofNone): boolean; virtual;
function SaveToString(var dataString: string; outputFormat: TOutputFormat = ofNone): boolean; virtual;
property AsString: string read GetAsString write SetAsString;
property LastError: string read xmlLastError;
property RootTag: string read xmlRootTag;
property XMLDoc: IXMLDocument read xmlXMLDoc;
property XMLRoot: IXMLElement read GetXMLRoot;
end; { TGpXMLDoc }
{:XML document containing only a list of nodes with the same structure.
}
TGpXMLDocList = class(TGpXMLDoc)
private
xmlChildClass: TGpXMLDataClass;
xmlChildTag : string;
xmlList : TGpXMLList;
xmlListTag : string;
protected
function Get(idx: integer): TGpXMLData;
function GetNode: IXMLNode; virtual;
public
constructor Create(rootTag, listTag, childTag: string;
childClass: TGpXMLDataClass); reintroduce; virtual;
destructor Destroy; override;
function Add: TGpXMLData; virtual;
procedure Clear; virtual;
function Count: integer; virtual;
procedure Delete(childNode: TGpXMLData); virtual;
function IndexOf(childNode: TGpXMLData): integer;
procedure RecreateChildren; override;
property Items[idxItem: integer]: TGpXMLData read Get;
property Node: IXMLNode read GetNode;
end; { TGpXMLDocList }
implementation
uses
SysUtils,
{$IFDEF MSWINDOWS}
Registry,
{$ENDIF}
OmniXMLUtils;
resourcestring
sXMLfileIsCorrupt = 'XML file is corrupt.';
const
CContainsPrivateAttr = 'ContainsPrivateNodes';
CContainsVolatileAttr = 'ContainsVolatileNodes';
CIsPrivateAttr = 'Private';
CIsVolatileAttr = 'Volatile';
{ TGpXMLData }
{:Assign contents of another data object.
@since 2002-12-26
}
procedure TGpXMLData.Assign(dataNode: TGpXMLData);
begin
CopyNode(dataNode.Node, xmlNode, true);
end; { TGpXMLData.Assign }
{:Assign nonvolatile contents of another data object.
@since 2003-01-07
}
procedure TGpXMLData.AssignNonvolatile(dataNode: TGpXMLData);
begin
CopyNode(dataNode.Node, xmlNode, true, FilterNodes);
end; { TGpXMLData.AssignNonvolatile }
{:Create object and remember XML node. Derived classes should inherit from this
constructor and initialize xmlChildNodeDefaults and xmlChildNodeTags arrays.
@param node XML node containing object data.
}
constructor TGpXMLData.Create(node: IXMLNode);
begin
Assert(assigned(node), 'Node is not assigned in TGpXMLData.Create');
xmlNode := node;
end; { TGpXMLData.Create }
{:Create object in named child node. If child node doesn't exist, it will be
created.
@param parentNode Parent XML node.
@param nodeTag Child node tag.
}
constructor TGpXMLData.Create(parentNode: IXMLNode; nodeTag: string);
var
myNode: IXMLNode;
begin
myNode := EnsureNode(parentNode, nodeTag);
Create(myNode);
end; { TGpXMLData.Create }
{:Create object in standalone mode.
}
constructor TGpXMLData.Create;
begin
xmlXMLDoc := CreateXMLDoc;
Create(EnsureNode(xmlXMLDoc,'_'));
end; { TGpXMLData.Create }
{:Create an object in standalone mode and load its contents from a string.
@since 2002-12-26
}
constructor TGpXMLData.Create(nodeData: string);
begin
Create;
AsString := nodeData;
end; { TGpXMLData.Create }
{:Triggered on each node during the AssignNonvolatile operation. Filters out
volatile and private nodes.
@since 2003-01-06
}
procedure TGpXMLData.FilterNodes(node: IXMLNode;
var canProcess: boolean);
begin
canProcess :=
(not (GetNodeAttrBool(node, CIsVolatileAttr, false) or
GetNodeAttrBool(node, CIsPrivateAttr, false)));
end; { TGpXMLData.FilterNodes }
{:Filter out private nodes during the AsString get.
@since 2003-01-09
}
procedure TGpXMLData.FilterPrivateNodes(node: IXMLNode;
var canProcess: boolean);
begin
canProcess := (not GetNodeAttrBool(node, CIsPrivateAttr, false));
end; { TGpXMLData.FilterPrivateNodes }
{:Serialize contents of an object.
@since 2002-12-25
}
function TGpXMLData.GetAsString: string;
var
p : integer;
tmpDoc : IXMLDocument;
xmlStandalone: TGpXMLData;
begin
if assigned(xmlXMLDoc) then begin
if GetNodeAttrBool(xmlXMLDoc, CContainsPrivateAttr, false) then
tmpDoc := CloneDocument(xmlXMLDoc, FilterPrivateNodes)
else
tmpDoc := xmlXMLDoc;
Result := XMLSaveToString(tmpDoc);
Delete(Result, 1, Pos('>', Result));
p := LastDelimiter('<', Result);
Delete(Result, p, Length(Result)-p+1);
end
else if not assigned(xmlList) then
raise Exception.Create('TGpXMLData.GetAsString: OwnerList is not set')
else begin
xmlStandalone := xmlList.CreateStandalone;
try
xmlStandalone.Assign(Self);
Result := xmlStandalone.AsString;
finally FreeAndNil(xmlStandalone); end;
end;
end; { TGpXMLData.GetAsString }
function TGpXMLData.GetText: string;
begin
Result := Node.Text;
end; { TGpXMLData.GetText }
function TGpXMLData.GetXMLAttrProp(index: integer): string;
begin
Result := GetNodeAttrStr(xmlNode, xmlChildNodeTags[index],
WideString(xmlChildNodeDefaults[index]));
end; { TGpXMLData.GetXMLAttrProp }
function TGpXMLData.GetXMLAttrPropBool(index: integer): boolean;
begin
Result := GetNodeAttrBool(xmlNode, xmlChildNodeTags[index],
xmlChildNodeDefaults[index]);
end; { TGpXMLData.GetXMLAttrPropBool }
function TGpXMLData.GetXMLAttrPropCardinal(index: integer): cardinal;
begin
Result := cardinal(GetXMLAttrPropInt64(index));
end; { TGpXMLData.GetXMLAttrPropCardinal }
function TGpXMLData.GetXMLAttrPropDate(index: integer): TDateTime;
begin
Result := GetNodeAttrDate(xmlNode, xmlChildNodeTags[index],
xmlChildNodeDefaults[index]);
end; { TGpXMLData.GetXMLAttrPropDate }
function TGpXMLData.GetXMLAttrPropDateTime(index: integer): TDateTime;
begin
Result := GetNodeAttrDateTime(xmlNode, xmlChildNodeTags[index],
xmlChildNodeDefaults[index]);
end; { TGpXMLData.GetXMLAttrPropDateTime }
function TGpXMLData.GetXMLAttrPropDWORD(index: integer): DWORD;
begin
Result := DWORD(GetXMLAttrPropInt(index));
end; { TGpXMLData.GetXMLAttrPropDWORD }
function TGpXMLData.GetXMLAttrPropInt(index: integer): integer;
begin
Result := GetNodeAttrInt(xmlNode, xmlChildNodeTags[index],
xmlChildNodeDefaults[index]);
end; { TGpXMLData.GetXMLAttrPropInt }
function TGpXMLData.GetXMLAttrPropInt64(index: integer): int64;
begin
Result := GetNodeAttrInt64(xmlNode, xmlChildNodeTags[index],
StrToIntDef(xmlChildNodeDefaults[index], 0));
end; { TGpXMLData.GetXMLAttrPropInt64 }
function TGpXMLData.GetXMLAttrPropReal(index: integer): real;
begin
Result := GetNodeAttrReal(xmlNode, xmlChildNodeTags[index],
xmlChildNodeDefaults[index]);
end; { TGpXMLData.GetXMLAttrPropReal }
function TGpXMLData.GetXMLAttrPropTime(index: integer): TDateTime;
begin
Result := GetNodeAttrTime(xmlNode, xmlChildNodeTags[index],
xmlChildNodeDefaults[index]);
end; { TGpXMLData.GetXMLAttrPropTime }
function TGpXMLData.GetXMLAttrPropWide(index: integer): WideString;
begin
Result := GetNodeAttrStr(xmlNode, xmlChildNodeTags[index],
WideString(xmlChildNodeDefaults[index]));
end; { TGpXMLData.GetXMLAttrPropWide }
function TGpXMLData.GetXMLProp(index: integer): string;
begin
Result := GetNodeTextStr(xmlNode, xmlChildNodeTags[index],
WideString(xmlChildNodeDefaults[index]));
end; { TGpXMLData.GetXMLProp }
function TGpXMLData.GetXMLPropBool(index: integer): boolean;
begin
Result := GetNodeTextBool(xmlNode, xmlChildNodeTags[index],
xmlChildNodeDefaults[index]);
end; { TGpXMLData.GetXMLPropBool }
function TGpXMLData.GetXMLPropCardinal(index: integer): cardinal;
begin
Result := cardinal(GetXMLPropInt64(index));
end; { TGpXMLData.GetXMLPropCardinal }
function TGpXMLData.GetXMLPropCData(index: integer): string;
begin
Result := GetNodeCData(xmlNode, xmlChildNodeTags[index],
WideString(xmlChildNodeDefaults[index]));
end; { TGpXMLData.GetXMLPropCData }
function TGpXMLData.GetXMLPropCDataWide(index: integer): WideString;
begin
Result := GetNodeCData(xmlNode, xmlChildNodeTags[index],
WideString(xmlChildNodeDefaults[index]));
end; { TGpXMLData.GetXMLPropCDataWide }
function TGpXMLData.GetXMLPropCDataOrTextWide(index: integer): WideString;
begin
Result := GetNodeCData(xmlNode, xmlChildNodeTags[index], '');
if Result = '' then
Result := GetNodeTextStr(xmlNode, xmlChildNodeTags[index], '');
if Result = '' then
Result := WideString(xmlChildNodeDefaults[index]);
end; { TGpXMLData.GetXMLPropCDataOrTextWide }
function TGpXMLData.GetXMLPropCDataOrText(index: integer): string;
begin
Result := GetNodeCData(xmlNode, xmlChildNodeTags[index], '');
if Result = '' then
Result := GetNodeTextStr(xmlNode, xmlChildNodeTags[index], '');
if Result = '' then
Result := WideString(xmlChildNodeDefaults[index]);
end; { TGpXMLData.GetXMLPropCDataOrText }
function TGpXMLData.GetXMLPropDate(index: integer): TDateTime;
begin
Result := GetNodeTextDate(xmlNode, xmlChildNodeTags[index],
xmlChildNodeDefaults[index]);
end; { TGpXMLData.GetXMLPropDate }
function TGpXMLData.GetXMLPropDateTime(index: integer): TDateTime;
begin
Result := GetNodeTextDateTime(xmlNode, xmlChildNodeTags[index],
xmlChildNodeDefaults[index]);
end; { TGpXMLData.GetXMLPropDateTime }
function TGpXMLData.GetXMLPropDWORD(index: integer): DWORD;
begin
Result := DWORD(GetXMLPropInt(index));
end; { TGpXMLData.GetXMLPropDWORD }
function TGpXMLData.GetXMLPropInt(index: integer): integer;
begin
Result := GetNodeTextInt(xmlNode, xmlChildNodeTags[index],
xmlChildNodeDefaults[index]);
end; { TGpXMLData.GetXMLPropInt }
function TGpXMLData.GetXMLPropInt64(index: integer): int64;
begin
Result := GetNodeTextInt64(xmlNode, xmlChildNodeTags[index],
StrToIntDef(xmlChildNodeDefaults[index], 0));
end; { TGpXMLData.GetXMLPropInt64 }
function TGpXMLData.GetXMLPropReal(index: integer): real;
begin
Result := GetNodeTextReal(xmlNode, xmlChildNodeTags[index],
xmlChildNodeDefaults[index]);
end; { TGpXMLData.GetXMLPropReal }
function TGpXMLData.GetXMLPropTime(index: integer): TDateTime;
begin
Result := GetNodeTextTime(xmlNode, xmlChildNodeTags[index],
xmlChildNodeDefaults[index]);
end; { TGpXMLData.GetXMLPropTime }
function TGpXMLData.GetXMLPropWide(index: integer): WideString;
begin
Result := GetNodeTextStr(xmlNode, xmlChildNodeTags[index],
WideString(xmlChildNodeDefaults[index]));
end; { TGpXMLData.GetXMLPropWide }
{:Init 'tags' and 'defaults' arrays.
@since 2003-01-13
}
procedure TGpXMLData.InitChildNodes(tags: array of string;
defaults: array of Variant);
var
iNode: integer;
begin
if Length(tags) <> Length(defaults) then
raise Exception.Create('TGpXMLData.InitChildNodes: Size of ''tags'' and ''defaults'' arrays doesn''t match');
SetLength(xmlChildNodeTags, Length(tags));
SetLength(xmlChildNodeDefaults, Length(tags));
for iNode := 0 to Length(tags)-1 do begin
xmlChildNodeTags[iNode] := tags[iNode];
xmlChildNodeDefaults[iNode] := defaults[iNode];
end; //for
end; { TGpXMLData.InitChildNodes }
{:Set contents of an object.
@since 2002-12-25
}
procedure TGpXMLData.SetAsString(const Value: string);
var
xmlStandalone: TGpXMLData;
begin
if assigned(xmlXMLDoc) then begin
XMLLoadFromString(xmlXMLDoc, '<standalone>'+Value+'</standalone>');
xmlNode := xmlXMLDoc.DocumentElement;
end
else if not assigned(xmlList) then
raise Exception.Create('TGpXMLData.SetAsString: OwnerList is not set')
else begin
xmlStandalone := xmlList.CreateStandalone;
try
xmlStandalone.AsString := Value;
Assign(xmlStandalone);
finally FreeAndNil(xmlStandalone); end;
end;
end; { TGpXMLData.SetAsString }
procedure TGpXMLData.SetText(const Value: string);
begin
xmlNode.Text := Value;
end; { TGpXMLData.SetText }
procedure TGpXMLData.SetXMLAttrProp(const index: integer;
const value: string);
begin
SetNodeAttrStr(xmlNode, xmlChildNodeTags[index], value);
end; { TGpXMLData.SetXMLAttrProp }
procedure TGpXMLData.SetXMLAttrPropBool(const index: integer;
const value: boolean);
begin
SetNodeAttrBool(xmlNode, xmlChildNodeTags[index], value);
end; { TGpXMLData.SetXMLAttrPropBool }
procedure TGpXMLData.SetXMLAttrPropCardinal(const index: integer;
const value: cardinal);
begin
SetXMLAttrPropInt64(index, value);
end; { TGpXMLData.SetXMLAttrPropCardinal }
procedure TGpXMLData.SetXMLAttrPropDate(const index: integer;
const value: TDateTime);
begin
SetNodeAttrDate(xmlNode, xmlChildNodeTags[index], value);
end; { TGpXMLData.SetXMLAttrPropDate }
procedure TGpXMLData.SetXMLAttrPropDateTime(const index: integer;
const value: TDateTime);
begin
SetNodeAttrDateTime(xmlNode, xmlChildNodeTags[index], value);
end; { TGpXMLData.SetXMLAttrPropDateTime }
procedure TGpXMLData.SetXMLAttrPropDWORD(const index: integer;
const value: DWORD);
begin
SetXMLAttrPropInt(index, integer(value));
end; { TGpXMLData.SetXMLAttrPropDWORD }
procedure TGpXMLData.SetXMLAttrPropInt(const index, value: integer);
begin
SetNodeAttrInt(xmlNode, xmlChildNodeTags[index], value);
end; { TGpXMLData.SetXMLAttrPropInt }
procedure TGpXMLData.SetXMLAttrPropInt64(const index: integer;
const value: int64);
begin
SetNodeAttrInt64(xmlNode, xmlChildNodeTags[index], value);
end; { TGpXMLData.SetXMLAttrPropInt64 }
procedure TGpXMLData.SetXMLAttrPropReal(const index: integer;
const value: real);
begin
SetNodeAttrReal(xmlNode, xmlChildNodeTags[index], value);
end; { TGpXMLData.SetXMLAttrPropReal }
procedure TGpXMLData.SetXMLAttrPropTime(const index: integer;
const value: TDateTime);
begin
SetNodeAttrTime(xmlNode, xmlChildNodeTags[index], value);
end; { TGpXMLData.SetXMLAttrPropTime }
procedure TGpXMLData.SetXMLAttrPropWide(const index: integer;
const value: WideString);
begin
SetNodeAttrStr(xmlNode, xmlChildNodeTags[index], value);
end; { TGpXMLData.SetXMLAttrPropWide }
procedure TGpXMLData.SetXMLProp(const index: integer; const value: string);
begin
SetNodeTextStr(xmlNode, xmlChildNodeTags[index], value);
end; { TGpXMLData.SetXMLProp }
procedure TGpXMLData.SetXMLPropBool(const index: integer;
const value: boolean);
begin
SetNodeTextBool(xmlNode, xmlChildNodeTags[index], value);
end; { TGpXMLData.SetXMLPropBool }
procedure TGpXMLData.SetXMLPropCardinal(const index: integer;
const value: cardinal);
begin
SetXMLPropInt64(index, value);
end; { TGpXMLData.SetXMLPropCardinal }
procedure TGpXMLData.SetXMLPropCData(const index: integer;
const value: string);
begin
SetNodeCData(xmlNode, xmlChildNodeTags[index], value);
end; { TGpXMLData.SetXMLPropCData }
procedure TGpXMLData.SetXMLPropCDataWide(const index: integer;
const value: WideString);
begin
SetNodeCData(xmlNode, xmlChildNodeTags[index], value);
end; { TGpXMLData.SetXMLPropCDataWide }
procedure TGpXMLData.SetXMLPropDate(const index: integer;
const value: TDateTime);
begin
SetNodeTextDate(xmlNode, xmlChildNodeTags[index], value);
end; { TGpXMLData.SetXMLPropDate }
procedure TGpXMLData.SetXMLPropDateTime(const index: integer;
const value: TDateTime);
begin
SetNodeTextDateTime(xmlNode, xmlChildNodeTags[index], value);
end; { TGpXMLData.SetXMLPropDateTime }
procedure TGpXMLData.SetXMLPropDWORD(const index: integer;
const value: DWORD);
begin
SetXMLPropInt(index, integer(value));
end; { TGpXMLData.SetXMLPropDWORD }
procedure TGpXMLData.SetXMLPropInt(const index, value: integer);
begin
SetNodeTextInt(xmlNode, xmlChildNodeTags[index], value);
end; { TGpXMLData.SetXMLPropInt }
procedure TGpXMLData.SetXMLPropInt64(const index: integer;
const value: int64);
begin
SetNodeTextInt64(xmlNode, xmlChildNodeTags[index], value);
end; { TGpXMLData.SetXMLPropInt64 }
procedure TGpXMLData.SetXMLPropReal(const index: integer;
const value: real);
begin
SetNodeTextReal(xmlNode,xmlChildNodeTags[index],value);
end; { TGpXMLData.SetXMLPropReal }
procedure TGpXMLData.SetXMLPropTime(const index: integer;
const value: TDateTime);
begin
SetNodeTextTime(xmlNode,xmlChildNodeTags[index],value);
end; { TGpXMLData.SetXMLPropTime }
procedure TGpXMLData.SetXMLPropWide(const index: integer; const value: WideString);
begin
SetNodeTextStr(xmlNode, xmlChildNodeTags[index], value);
end; { TGpXMLData.SetXMLPropWide }
{ TGpXMLVolatileData }
constructor TGpXMLVolatileData.Create(node: IXMLNode);
begin
inherited Create(node);
MarkVolatile;
end; { TGpXMLVolatileData.Create }
constructor TGpXMLVolatileData.Create;
begin
inherited Create;
MarkVolatile;
end; { TGpXMLVolatileData.Create }
{:Mark XML node as volatile.
@since 2003-01-06
}
procedure TGpXMLVolatileData.MarkVolatile;
begin
SetNodeAttrBool(xmlNode, CIsVolatileAttr, true);
SetNodeAttrBool(xmlNode.OwnerDocument.DocumentElement, CContainsVolatileAttr, true);
end; { TGpXMLVolatileData.MarkVolatile }
{ TGpXMLPrivateData }
constructor TGpXMLPrivateData.Create(node: IXMLNode);
begin
inherited Create(node);
MarkPrivate;
end; { TGpXMLPrivateData.Create }
constructor TGpXMLPrivateData.Create;
begin
inherited Create(node);
MarkPrivate;
end; { TGpXMLPrivateData.Create }
procedure TGpXMLPrivateData.MarkPrivate;
begin
SetNodeAttrBool(xmlNode, CIsPrivateAttr, true);
SetNodeAttrBool(xmlNode.OwnerDocument.DocumentElement, CContainsPrivateAttr, true);
end; { TGpXMLPrivateData.MarkPrivate }
{ TGpXMLList }
{:Create new child node and add it to the list.
@returns New child node.
}
function TGpXMLList.Add: TGpXMLData;
var
newNode: IXMLNode;
begin
Assert(assigned(Node),'Node is not assigned in TGpXMLList.Add');
newNode := xmlNode.OwnerDocument.CreateElement(xmlChildTag);
Assert(assigned(newNode),'Child node is not assigned in TGpXMLList.Add');
xmlNode.AppendChild(newNode);
Result := xmlChildClass.Create(newNode);
Result.OwnerList := Self;
xmlChildNodes.Add(Result);
end; { TGpXMLList.Add }
{:Clear the node list.
}
procedure TGpXMLList.Clear;
begin
xmlChildNodes.Clear;
DeleteAllChildren(xmlNode);
end; { TGpXMLList.Clear }
{:Get number of nodes in the list.
@returns Number of nodes in the list.
}
function TGpXMLList.Count: integer;
begin
Result := xmlChildNodes.Count;
end; { TGpXMLList.Count }
{:Create list of equally named nodes.
@param parentNode Parent XML node.
@param nodeTag Tag of the node containing child nodes.
@param childTag Child nodes' tag.
@param childClass Class of the child nodes.
}
constructor TGpXMLList.Create(parentNode: IXMLNode; nodeTag, childTag: string;
childClass: TGpXMLDataClass);
var
childNode: TGpXMLData;
csList : IXMLNodeList;
csNode : IXMLNode;
begin
Assert(assigned(parentNode), 'Parent node is not assigned in TGpXMLList.Create');
if nodeTag = '' then
xmlNode := parentNode
else begin
xmlNode := parentNode.SelectSingleNode(nodeTag);
if not assigned(xmlNode) then begin
xmlNode := parentNode.OwnerDocument.CreateElement(nodeTag);
parentNode.AppendChild(xmlNode);
end;
end;
xmlChildClass := childClass;
xmlChildTag := childTag;
xmlChildNodes := TObjectList.Create(true);
csList := xmlNode.SelectNodes(childTag);
csList.Reset;
repeat
csNode := csList.NextNode;
if assigned(csNode) then begin
childNode := childClass.Create(csNode);
childNode.OwnerList := Self;
xmlChildNodes.Add(childNode);
end;
until not assigned(csNode);
end; { TGpXMLList.Create }
{:Create standalone data object.
@since 2002-12-26
}
function TGpXMLList.CreateStandalone: TGpXMLData;
begin
Result := xmlChildClass.Create;
end; { TGpXMLList.CreateStandalone }
{:Delete node from the list.
@param childNode Child node to be deleted.
}
procedure TGpXMLList.Delete(childNode: TGpXMLData);
var
idx: integer;
begin
idx := IndexOf(childNode);
Assert(idx >= 0, 'Idx is <= 0 in TGpXMLList.Delete');
if idx >= 0 then begin
xmlNode.RemoveChild((xmlChildNodes[idx] as xmlChildClass).Node);
xmlChildNodes.Delete(idx);
end;
end; { TGpXMLList.Delete }
{:Destroy list.
}
destructor TGpXMLList.Destroy;
begin
FreeAndNil(xmlChildNodes);
end; { TGpXMLList.Destroy }
{:Get idx-th child.
@param idx Index (0-based) of a child to be retrieved.
@returns Child object.
}
function TGpXMLList.Get(idx: integer): TGpXMLData;
begin
//Gp, 2002-12-26: I think this casting is not necessary as Get is only used from indexed accessors in derived classes which add this casting nevertheless
Result := TGpXMLData(xmlChildNodes[idx]{ as xmlChildClass});
end; { TGpXMLList.Get }
{:Locate child node in the list.
@param childNode Child node to be located.
@returns Index of the child node (0 based) or -1 if not found.
}
function TGpXMLList.IndexOf(childNode: TGpXMLData): integer;
var
iChild: integer;
begin
Result := -1;
for iChild := 0 to Count-1 do begin
if xmlChildNodes[iChild] = childNode then begin
Result := iChild;
break; //for
end;
end; //for
end; { TGpXMLList.IndexOf }
{ TGpXMLDoc }
{:Create a copy of the document.
@param doc Existing XML document object.
}
constructor TGpXMLDoc.Clone(doc: TGpXMLDoc);
begin
Create(doc.RootTag);
xmlXMLDoc.LoadXML(doc.XMLDoc.XML);
CreateRootNode;
RecreateChildren;
end; { TGpXMLDoc.Clone }
{:Create XML document object.
@param rootTag Name of the root tag.
}
constructor TGpXMLDoc.Create(rootTag: string);
begin
xmlRootTag := rootTag;
Reset;
end; { TGpXMLDoc.Create }
{:Create representation of the document that contains only persistent data.
@since 2003-01-06
}
function TGpXMLDoc.CreatePersistentClone: IXMLDocument;
begin
if GetNodeAttrBool(xmlXMLDoc, CContainsVolatileAttr, false) or
GetNodeAttrBool(xmlXMLDoc, CContainsPrivateAttr, false) then
begin
Result := CloneDocument(xmlXMLDoc, FilterNodes);
Result.DocumentElement.Attributes.Clear;
end
else
Result := xmlXMLDoc;
end; { TGpXMLDoc.CreatePersistentClone }
{:Create root node of the document if it doesn't already exist.
}
procedure TGpXMLDoc.CreateRootNode;
begin
if not assigned(xmlXMLDoc.DocumentElement) then