-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathOmniXMLUtils.pas
2818 lines (2529 loc) · 90.8 KB
/
OmniXMLUtils.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 routines to convert data, retrieve/set data of
different types, manipulate nodes, load/save XML documents.
@author Primoz Gabrijelcic
@desc <pre>
(c) 2011 Primoz Gabrijelcic
Free for personal and commercial use. No rights reserved.
Author : Primoz Gabrijelcic
Creation date : 2001-10-25
Last modification : 2011-03-01
Version : 1.30
</pre>*)(*
History:
1.30: 2011-03-01
- Convert EFOpenError exception in XMLLoadFromFile to function result.
1.29: 2011-02-07
- Fixed possible accvio in SelectNode.
1.29: 2010-07-06
- Overloaded SelectNode.
1.28: 2010-07-05
- GetNodeText works when nil is passed as the 'parentNode' parameter.
1.27: 2010-05-27
- (ia) Added handling of boolean strings 'true' and 'false'
1.26: 2009-12-25
- (mr) Base64 code optimization.
- (mr) Overloaded Base64Encode, Base64Decode to work with buffer.
1.25: 2008-04-09
- Implemented enumerator XMLEnumNodes. Now you can do:
for nodePassword in XMLEnumNodes(xmlConfig, '//*/PasswordHash') do
SetTextChild(nodePassword, '(removed)');
1.24: 2007-01-09
- Added two additional overloads for Base64Encode and one for Base64Decode.
1.23b: 2004-07-29
- Updated GetNodeText to handle a case when #text subnode doesn't exist.
1.23a: 2004-04-21
- Updated GetNodeText, GetNodeCData to use .NodeValue instead of .Text internally.
1.23: 2004-04-07
- Added functions GetNodeTextFont and SetNodeTextFont.
1.22a: 2004-04-07
- Modified XMLBinaryToStr to always process entire stream.
- Modified XMLStrToBinary to clear output stream at beginning.
1.22: 2004-04-05
- Added overloaded versions of GetNodeText and GetNodeCData.
1.21: 2004-03-27
- Added function AppendNode.
1.20a: 2004-03-25
- Fixed broken format strings (used for error reporting) in various XMLStrTo*
functions.
1.20: 2004-03-23
- Added two more variants of Base64Encode and Base64Decode.
1.19: 2004-03-01
- GetNodeText*, GetNodeAttr*, and XMLStrTo* families extended with overloaded
versions without a default value, raising exception on invalid/missing XML node.
1.18: 2004-01-16
- Functions OwnerDocument and DocumentElement made public.
1.17: 2004-01-05
- Remove some unnecessary 'overload' directives.
- Added functions XMLStrToCurrency, XMLStrToCurrencyDef, XMLVariantToStr,
and XMLCurrencyToStr.
- Added function FindProcessingInstruction.
- Added functions XMLSaveToAnsiString, XMLLoadFromAnsiString.
- Fixed XMLSaveToString which incorrectly returned UTF8 string instead of
UTF16.
1.16: 2003-12-12
- GetTextChild and SetTextChild made public.
- New functions GetCDataChild and SetCDataChild.
- New functions GetNodeCData and SetNodeCData.
- New functions MoveNode and RenameNode.
- Added functions XMLStrToExtended, XMLStrToExtendedDef, and
XMLExtendedToStr.
1.15b: 2003-10-01
- Fixed another bug in SelectNode and EnsureNode (broken since 1.15).
1.15a: 2003-09-22
- Fixed bug in SelectNode and EnsureNode (broken since 1.15).
1.15: 2003-09-21
- Added function SelectNode.
1.14: 2003-05-08
- Overloaded Base64Encode, Base64Decode to work with strings too.
1.13: 2003-04-01
- Filter* and Find* routines modified to skip all non-ELEMENT_NODE nodes.
1.12b: 2003-01-15
- Safer implementation of some internal functions.
1.12a: 2003-01-13
- Adapted for latest fixes in OmniXML 2002-01-13.
1.12: 2003-01-13
- CopyNode, and CloneDocument made MS XML compatible.
- Automatic DocumentElement dereferencing now works with MS XML.
1.11: 2003-01-13
- Fixed buggy GetNode(s)Text*/SetNode(s)Text* functions.
- Fixed buggy CopyNode and CloneDocument.
1.10a: 2003-01-09
- Fixed filterProc support in the CopyNode.
1.10: 2003-01-07
- Added functions XMLLoadFromRegistry and XMLSaveToRegistry.
- Added function CloneDocument.
- Added parameter filterProc to the CopyNode procedure.
- Smarter GetNodeAttr (automatically dereferences DocumentElement if
root xml node is passed to it).
1.09: 2002-12-26
- Added procedure CopyNode that copies contents of one node into another.
- Modified DeleteAllChildren to preserve Text property.
1.08: 2002-12-21
- Smarter GetNodeText (automatically dereferences DocumentElement if
root xml node is passed to it).
1.07a: 2002-12-10
- Bug fixed in XMLSaveToString (broken since 1.06).
1.07: 2002-12-09
- Added XMLLoadFromFile and XMLSaveToFile.
- Small code cleanup.
1.06: 2002-12-09
- MSXML compatible (define USE_MSXML).
1.05a: 2002-11-23
- Fixed bug in Base64Decode.
1.05: 2002-11-05
- Added function ConstructXMLDocument.
1.04: 2002-10-03
- Added function EnsureNode.
1.03: 2002-09-24
- Added procedure SetNodesText.
1.02: 2002-09-23
- SetNode* familiy of procedures changed into functions returning the
modified node.
1.01: 2001-11-07
- (mr) Added function XMLDateTimeToStrEx.
- (mr) ISODateTime2DateTime enhanced.
- (mr) Bug fixed in Str2Time.
1.0: 2001-10-25
- Created by extracting common utilities from unit GpXML.
*)
unit OmniXMLUtils;
interface
{$I OmniXML.inc}
{$IFDEF CONDITIONALEXPRESSIONS}
{$IF (CompilerVersion >= 17)} //Delphi 2005 or newer
{$DEFINE OmniXmlUtils_Enumerators}
{$IFEND}
{$IF CompilerVersion >= 20} // Delphi 2009 or newer
{$DEFINE OmniXmlUtils_Base64UsePointerMath}
{$IFEND}
{$IF CompilerVersion >= 23} // Delphi XE2 or newer
{$DEFINE OmniXmlUtils_UseUITypes}
{$IFEND}
{$ENDIF}
uses
{$IFDEF MSWINDOWS}
Windows,
{$ENDIF}
SysUtils,
Classes,
Graphics,
OmniXML_Types,
OmniXML
{$IFDEF USE_MSXML}
,OmniXML_MSXML
{$ENDIF USE_MSXML}
{$IFDEF HAS_UNIT_VARIANTS}
,Variants
{$ENDIF DELPHI6_UP}
{$IFDEF OmniXmlUtils_UseUITypes}
,UITypes
{$ENDIF OmniXmlUtils_UseUITypes}
;
type
{:Base class for OmniXMLUtils exceptions.
@since 2004-03-01
}
EOmniXMLUtils = class(Exception);
{:Delete the specified node.
}
procedure DeleteNode(parentNode: IXMLNode; nodeTag: string);
{:Delete all/some children of the specified node.
}
procedure DeleteAllChildren(parentNode: IXMLNode; pattern: string = '');
{:Retrive text child of the specified node.
}
function GetTextChild(node: IXMLNode): IXMLNode;
{:Retrive CDATA child of the specified node.
}
function GetCDataChild(node: IXMLNode): IXMLNode;
{:Returns CDATA value of the specified node.
}
function GetNodeCData(parentNode: IXMLNode; nodeTag: string;
defaultValue: XmlString): XmlString; overload;
{:Returns CDATA value of the specified node.
}
function GetNodeCData(node: IXMLNode): XmlString; overload;
{:Returns text of the specified node. Result is True if node exists, False
otherwise.
}
function GetNodeText(parentNode: IXMLNode; nodeTag: string;
var nodeText: XmlString): boolean; overload;
{:Returns text of the specified node. Result is True if node exists, False
otherwise.
}
function GetNodeText(node: IXMLNode): XmlString; overload;
{:Returns texts of all child nodes into the string list. Text for each child
is trimmed before it is stored in the list. Caller must create result list
in advance.
}
procedure GetNodesText(parentNode: IXMLNode; nodeTag: string;
{var} nodesText: TStrings); overload;
{:Returns texts of all child nodes as a CRLF-delimited string.
}
procedure GetNodesText(parentNode: IXMLNode; nodeTag: string;
var nodesText: string); overload;
{:A family of functions that will return node text reformatted into another
type or default value if node doesn't exist or if node text is not in a
proper format. Basically they all call GetNodeText and convert the result.
}
function GetNodeTextStr(parentNode: IXMLNode; nodeTag: string; defaultValue: XmlString): XmlString; overload;
function GetNodeTextReal(parentNode: IXMLNode; nodeTag: string; defaultValue: real): real; overload;
function GetNodeTextInt(parentNode: IXMLNode; nodeTag: string; defaultValue: integer): integer; overload;
function GetNodeTextInt64(parentNode: IXMLNode; nodeTag: string; defaultValue: int64): int64; overload;
function GetNodeTextBool(parentNode: IXMLNode; nodeTag: string; defaultValue: boolean): boolean; overload;
function GetNodeTextDateTime(parentNode: IXMLNode; nodeTag: string; defaultValue: TDateTime): TDateTime; overload;
function GetNodeTextDate(parentNode: IXMLNode; nodeTag: string; defaultValue: TDateTime): TDateTime; overload;
function GetNodeTextTime(parentNode: IXMLNode; nodeTag: string; defaultValue: TDateTime): TDateTime; overload;
function GetNodeTextBinary(parentNode: IXMLNode; nodeTag: string; value: TStream): boolean;
function GetNodeTextFont(parentNode: IXMLNode; nodeTag: string; value: TFont): boolean;
{:A family of functions that will return node text reformatted into another
type or raise exception if node doesn't exist or if node text is not in a
proper format. Basically they all call GetNodeText and convert the result.
}
function GetNodeTextStr(parentNode: IXMLNode; nodeTag: string): XmlString; overload;
function GetNodeTextReal(parentNode: IXMLNode; nodeTag: string): real; overload;
function GetNodeTextInt(parentNode: IXMLNode; nodeTag: string): integer; overload;
function GetNodeTextInt64(parentNode: IXMLNode; nodeTag: string): int64; overload;
function GetNodeTextBool(parentNode: IXMLNode; nodeTag: string): boolean; overload;
function GetNodeTextDateTime(parentNode: IXMLNode; nodeTag: string): TDateTime; overload;
function GetNodeTextDate(parentNode: IXMLNode; nodeTag: string): TDateTime; overload;
function GetNodeTextTime(parentNode: IXMLNode; nodeTag: string): TDateTime; overload;
{:Returns value of the specified attribute. Result is True if attribute
exists, False otherwise.
}
function GetNodeAttr(parentNode: IXMLNode; attrName: string;
var value: XmlString): boolean;
{:A family of functions that will return attribute value reformatted into
another type or default value if attribute doesn't exist or if attribute
is not in a proper format. Basically they all call GetNodeAttr and
convert the result.
}
function GetNodeAttrStr(parentNode: IXMLNode; attrName: string; defaultValue: XmlString): XmlString; overload;
function GetNodeAttrReal(parentNode: IXMLNode; attrName: string; defaultValue: real): real; overload;
function GetNodeAttrInt(parentNode: IXMLNode; attrName: string; defaultValue: integer): integer; overload;
function GetNodeAttrInt64(parentNode: IXMLNode; attrName: string; defaultValue: int64): int64; overload;
function GetNodeAttrBool(parentNode: IXMLNode; attrName: string; defaultValue: boolean): boolean; overload;
function GetNodeAttrDateTime(parentNode: IXMLNode; attrName: string; defaultValue: TDateTime): TDateTime; overload;
function GetNodeAttrDate(parentNode: IXMLNode; attrName: string; defaultValue: TDateTime): TDateTime; overload;
function GetNodeAttrTime(parentNode: IXMLNode; attrName: string; defaultValue: TDateTime): TDateTime; overload;
{:A family of functions that will return attribute value reformatted into
another type or raise exception if attribute doesn't exist or if attribute
is not in a proper format. Basically they all call GetNodeAttr and
convert the result.
}
function GetNodeAttrStr(parentNode: IXMLNode; attrName: string): XmlString; overload;
function GetNodeAttrReal(parentNode: IXMLNode; attrName: string): real; overload;
function GetNodeAttrInt(parentNode: IXMLNode; attrName: string): integer; overload;
function GetNodeAttrInt64(parentNode: IXMLNode; attrName: string): int64; overload;
function GetNodeAttrBool(parentNode: IXMLNode; attrName: string): boolean; overload;
function GetNodeAttrDateTime(parentNode: IXMLNode; attrName: string): TDateTime; overload;
function GetNodeAttrDate(parentNode: IXMLNode; attrName: string): TDateTime; overload;
function GetNodeAttrTime(parentNode: IXMLNode; attrName: string): TDateTime; overload;
{:A family of functions used to convert string to some other value according
to the conversion rules used in this unit. Used in Get* functions above.
}
function XMLStrToReal(nodeValue: XmlString; var value: real): boolean; overload;
function XMLStrToReal(nodeValue: XmlString): real; overload;
function XMLStrToRealDef(nodeValue: XmlString; defaultValue: real): real;
function XMLStrToExtended(nodeValue: XmlString; var value: extended): boolean; overload;
function XMLStrToExtended(nodeValue: XmlString): extended; overload;
function XMLStrToExtendedDef(nodeValue: XmlString; defaultValue: extended): extended;
function XMLStrToCurrency(nodeValue: XmlString; var value: Currency): boolean; overload;
function XMLStrToCurrency(nodeValue: XmlString): Currency; overload;
function XMLStrToCurrencyDef(nodeValue: XmlString; defaultValue: Currency): Currency;
function XMLStrToInt(nodeValue: XmlString; var value: integer): boolean; overload;
function XMLStrToInt(nodeValue: XmlString): integer; overload;
function XMLStrToIntDef(nodeValue: XmlString; defaultValue: integer): integer;
function XMLStrToInt64(nodeValue: XmlString; var value: int64): boolean; overload;
function XMLStrToInt64(nodeValue: XmlString): int64; overload;
function XMLStrToInt64Def(nodeValue: XmlString; defaultValue: int64): int64;
function XMLStrToBool(nodeValue: XmlString; var value: boolean): boolean; overload;
function XMLStrToBool(nodeValue: XmlString): boolean; overload;
function XMLStrToBoolDef(nodeValue: XmlString; defaultValue: boolean): boolean;
function XMLStrToDateTime(nodeValue: XmlString; var value: TDateTime): boolean; overload;
function XMLStrToDateTime(nodeValue: XmlString): TDateTime; overload;
function XMLStrToDateTimeDef(nodeValue: XmlString; defaultValue: TDateTime): TDateTime;
function XMLStrToDate(nodeValue: XmlString; var value: TDateTime): boolean; overload;
function XMLStrToDate(nodeValue: XmlString): TDateTime; overload;
function XMLStrToDateDef(nodeValue: XmlString; defaultValue: TDateTime): TDateTime;
function XMLStrToTime(nodeValue: XmlString; var value: TDateTime): boolean; overload;
function XMLStrToTime(nodeValue: XmlString): TDateTime; overload;
function XMLStrToTimeDef(nodeValue: XmlString; defaultValue: TDateTime): TDateTime;
function XMLStrToBinary(nodeValue: XmlString; const value: TStream): boolean;
{:Creates the node if it doesn't exist, then sets node CDATA to the specified
value.
}
function SetNodeCData(parentNode: IXMLNode; nodeTag: string;
value: XmlString): IXMLNode;
{:Creates the node if it doesn't exist, then sets node text to the specified
value.
}
function SetNodeText(parentNode: IXMLNode; nodeTag: string;
value: XmlString): IXMLNode;
{:Sets texts for many child nodes. All nodes are created anew.
}
procedure SetNodesText(parentNode: IXMLNode; nodeTag: string;
nodesText: TStrings); overload;
{:Sets texts for many child nodes. All nodes are created anew.
@param nodesText Contains CRLF-delimited text list.
}
procedure SetNodesText(parentNode: IXMLNode; nodeTag: string;
nodesText: string); overload;
{:A family of functions that will first check that the node exists (creating
it if necessary) and then set node text to the properly formatted value.
Basically they all reformat the value to the string and then call
SetNodeText.
}
function SetNodeTextStr(parentNode: IXMLNode; nodeTag: string;
value: XmlString): IXMLNode;
function SetNodeTextReal(parentNode: IXMLNode; nodeTag: string;
value: real): IXMLNode;
function SetNodeTextInt(parentNode: IXMLNode; nodeTag: string;
value: integer): IXMLNode;
function SetNodeTextInt64(parentNode: IXMLNode; nodeTag: string;
value: int64): IXMLNode;
function SetNodeTextBool(parentNode: IXMLNode; nodeTag: string;
value: boolean): IXMLNode;
function SetNodeTextDateTime(parentNode: IXMLNode; nodeTag: string;
value: TDateTime): IXMLNode;
function SetNodeTextDate(parentNode: IXMLNode; nodeTag: string;
value: TDateTime): IXMLNode;
function SetNodeTextTime(parentNode: IXMLNode; nodeTag: string;
value: TDateTime): IXMLNode;
function SetNodeTextBinary(parentNode: IXMLNode; nodeTag: string;
const value: TStream): IXMLNode;
function SetNodeTextFont(parentNode: IXMLNode; nodeTag: string;
value: TFont): IXMLNode;
{:Set the value of the text child and return its interface.
}
function SetTextChild(node: IXMLNode; value: XmlString): IXMLNode;
{:Set the value of the CDATA child and return its interface.
}
function SetCDataChild(node: IXMLNode; value: XmlString): IXMLNode;
{:Creates the attribute if it doesn't exist, then sets it to the specified
value.
}
procedure SetNodeAttr(parentNode: IXMLNode; attrName: string;
value: XmlString);
{:A family of functions that will first check that the attribute exists
(creating it if necessary) and then set attribute's value to the properly
formatted value. Basically they all reformat the value to the string and
then call SetNodeAttr.
}
procedure SetNodeAttrStr(parentNode: IXMLNode; attrName: string;
value: XmlString);
procedure SetNodeAttrReal(parentNode: IXMLNode; attrName: string;
value: real);
procedure SetNodeAttrInt(parentNode: IXMLNode; attrName: string;
value: integer);
procedure SetNodeAttrInt64(parentNode: IXMLNode; attrName: string;
value: int64);
procedure SetNodeAttrBool(parentNode: IXMLNode; attrName: string;
value: boolean);
procedure SetNodeAttrDateTime(parentNode: IXMLNode; attrName: string;
value: TDateTime);
procedure SetNodeAttrDate(parentNode: IXMLNode; attrName: string;
value: TDateTime);
procedure SetNodeAttrTime(parentNode: IXMLNode; attrName: string;
value: TDateTime);
{:A family of functions used to convert value to string according to the
conversion rules used in this unit. Used in Set* functions above.
}
function XMLRealToStr(value: real; precision: byte = 15): XmlString;
function XMLExtendedToStr(value: extended): XmlString;
function XMLCurrencyToStr(value: Currency): XmlString;
function XMLIntToStr(value: integer): XmlString;
function XMLInt64ToStr(value: int64): XmlString;
function XMLBoolToStr(value: boolean; useBoolStrs: boolean = false): XmlString;
function XMLDateTimeToStr(value: TDateTime): XmlString;
function XMLDateTimeToStrEx(value: TDateTime): XmlString;
function XMLDateToStr(value: TDateTime): XmlString;
function XMLTimeToStr(value: TDateTime): XmlString;
function XMLBinaryToStr(value: TStream): XmlString;
function XMLVariantToStr(value: Variant): XmlString;
{$IFNDEF USE_MSXML}
{:Select specified child nodes. Can filter on subnode name and text.
}
function FilterNodes(parentNode: IXMLNode; matchesName: string;
matchesText: string = ''): IXMLNodeList; overload;
{:Select specified child nodes. Can filter on subnode name, subnode text and
on grandchildren names.
}
function FilterNodes(parentNode: IXMLNode; matchesName, matchesText: string;
matchesChildNames: array of string): IXMLNodeList; overload;
{:Select specified child nodes. Can filter on subnode name, subnode text and
on grandchildren names and text.
}
function FilterNodes(parentNode: IXMLNode; matchesName, matchesText: string;
matchesChildNames, matchesChildText: array of string): IXMLNodeList; overload;
{$ENDIF USE_MSXML}
{:Select first child node that satisfies the criteria. Can filter on subnode
name and text.
}
function FindNode(parentNode: IXMLNode; const matchesName: string;
const matchesText: string = ''): IXMLNode; overload;
{:Select first child node that satisfies the criteria. Can filter on subnode
name, subnode text and on grandchildren names.
}
function FindNode(parentNode: IXMLNode; const matchesName, matchesText: string;
matchesChildNames: array of string): IXMLNode; overload;
{:Select first child node that satisfies the criteria. Can filter on subnode
name, subnode text and on grandchildren names and text.
}
function FindNode(parentNode: IXMLNode; const matchesName, matchesText: string;
matchesChildNames, matchesChildText: array of string): IXMLNode; overload;
{:Select first child with a specified attribute name, value pair.
}
function FindNodeByAttr(parentNode: IXMLNode; const matchesName, attributeName: string;
const attributeValue: string = ''): IXMLNode;
{:Returns 'processing instruction' node if it exists, nil otherwise.
}
function FindProcessingInstruction(
xmlDocument: IXMLDocument): IXMLProcessingInstruction;
{:Returns owner document interface of the specified node.
}
function OwnerDocument(node: IXMLNode): IXMLDocument;
{:Returns document element node.
}
function DocumentElement(node: IXMLNode): IXMLElement;
{$IFDEF MSWINDOWS}
{:Load XML document from the named RCDATA resource and return interface to it.
}
function XMLLoadFromResource(xmlDocument: IXMLDocument;
const resourceName: string): boolean;
{$ENDIF}
{:Load XML document from a wide string.
}
function XMLLoadFromString(xmlDocument: IXMLDocument;
const xmlData: XmlString): boolean;
{:Load XML document from an ansi string.
}
function XMLLoadFromAnsiString(xmlDocument: IXMLDocument;
const xmlData: AnsiString): boolean;
{:Save XML document to a wide string.
}
function XMLSaveToString(xmlDocument: IXMLDocument;
outputFormat: TOutputFormat = ofNone): XmlString;
{:Save XML document to an ansi string, automatically adding UTF8 processing
instruction if required.
}
function XMLSaveToAnsiString(xmlDocument: IXMLDocument;
outputFormat: TOutputFormat = ofNone): AnsiString;
{:Load XML document from a stream.
}
function XMLLoadFromStream(xmlDocument: IXMLDocument;
const xmlStream: TStream): boolean;
{:Save XML document to a stream.
}
procedure XMLSaveToStream(xmlDocument: IXMLDocument;
const xmlStream: TStream; outputFormat: TOutputFormat = ofNone);
{:Load XML document from a file.
}
function XMLLoadFromFile(xmlDocument: IXMLDocument;
const xmlFileName: string): boolean;
{:Save XML document to a file.
}
procedure XMLSaveToFile(xmlDocument: IXMLDocument;
const xmlFileName: string; outputFormat: TOutputFormat = ofNone);
{$IFDEF MSWINDOWS}
{:Load XML document from the registry.
}
function XMLLoadFromRegistry(xmlDocument: IXMLDocument; rootKey: HKEY;
const key, value: string): boolean;
{:Save XML document to the registry.
}
function XMLSaveToRegistry(xmlDocument: IXMLDocument; rootKey: HKEY;
const key, value: string; outputFormat: TOutputFormat): boolean;
{$ENDIF}
{:Select single node possibly more than one level below.
@since 2003-09-21
}
function SelectNode(parentNode: IXMLNode; const nodeTag: string): IXMLNode; overload;
function SelectNode(parentNode: IXMLNode; const nodeTag: string; var childNode: IXMLNode): boolean; overload;
{:Ensure that the node exists and return its interface.
}
function EnsureNode(parentNode: IXMLNode; nodeTag: string): IXMLNode;
{:Append new child node to the parent.
@since 2004-03-27
}
function AppendNode(parentNode: IXMLNode; nodeTag: string): IXMLNode;
{:Constructs XML document from given data.
}
function ConstructXMLDocument(const documentTag: string;
const nodeTags, nodeValues: array of string): IXMLDocument; overload;
{:Constructs XML document containing only documentelement node.
}
function ConstructXMLDocument(const documentTag: string): IXMLDocument; overload;
type
TFilterXMLNodeEvent = procedure(node: IXMLNode; var canProcess: boolean) of object;
{:Copies contents of one node into another. Some (sub)nodes can optionally be
filtered out during the copy operation.
}
procedure CopyNode(sourceNode, targetNode: IXMLNode;
copySubnodes: boolean = true; filterProc: TFilterXMLNodeEvent = nil);
{:Copies contents of one node into another, then removes source node. Some
(sub)nodes can optionally be filtered out during the copy operation.
}
procedure MoveNode(sourceNode, targetNode: IXMLNode;
copySubnodes: boolean = true; filterProc: TFilterXMLNodeEvent = nil);
{:Generates a copy of old node with new name, removes old node, and returns
interface of the new node.
}
function RenameNode(node: IXMLNode; const newName: string): IXMLNode;
{:Creates a copy of a XML document. Some nodes can optionally be filtered out
during the copy operation.
@since 2003-01-06
}
function CloneDocument(sourceDoc: IXMLDocument;
filterProc: TFilterXMLNodeEvent = nil): IXMLDocument;
{:Decode base64-encoded buffer.
}
function Base64Decode(Encoded, Decoded: Pointer; EncodedSize: Integer; var DecodedSize: Integer): Boolean; overload;
{:Decode base64-encoded stream.
}
function Base64Decode(const encoded, decoded: TStream): boolean; overload;
{:Decode base64-encoded string.
}
function Base64Decode(const encoded: string; decoded: TStream): boolean; overload;
{:Decode base64-encoded string.
}
function Base64Decode(const encoded: string; var decoded: string): boolean; overload;
{:Decode base64-encoded string.
}
function Base64Decode(const encoded: string): string; overload;
{:Encode a buffer into base64 form.
}
function Base64Encode(Decoded, Encoded: Pointer; Size: Integer): Integer; overload;
{:Encode a stream into base64 form.
}
procedure Base64Encode(const decoded, encoded: TStream); overload;
{:Encode a stream into base64 form.
}
procedure Base64Encode(decoded: TStream; var encoded: string); overload;
{:Encode a stream into base64 form.
}
function Base64Encode(decoded: TStream): string; overload;
{:Encode a stream into base64 form.
}
function Base64Encode(const decoded: string): string; overload;
{:Encode a string into base64 form.
}
procedure Base64Encode(const decoded: string; var encoded: string); overload;
{$IFDEF OmniXmlUtils_Enumerators}
type
XMLEnumerator = class
strict private
xeCurrent : IXMLNode;
xeNodeList: IXMLNodeList;
public
constructor Create(nodeList: IXMLNodeList);
function GetCurrent: IXMLNode; inline;
function MoveNext: boolean; inline;
property Current: IXMLNode read GetCurrent;
end; { XMLEnumerator }
XMLEnumeratorFactory = record
strict private
xefNodeList: IXMLNodeList;
xefPattern : string;
xefRootNode: IXMLNode;
public
constructor Create(rootNode: IXMLNode; const pattern: string); overload;
constructor Create(nodeList: IXMLNodeList); overload;
function GetEnumerator: XMLEnumerator;
end; { XMLEnumeratorFactory }
function XMLEnumNodes(xmlDocument: IXMLDocument; pattern: string): XMLEnumeratorFactory; overload;
function XMLEnumNodes(xmlNode: IXMLNode; pattern: string): XMLEnumeratorFactory; overload;
function XMLEnumNodes(xmlNodeList: IXMLNodeList) : XMLEnumeratorFactory; overload;
{$ENDIF OmniXmlUtils_Enumerators}
implementation
{$IFDEF MSWINDOWS}
uses
Registry;
{$ENDIF}
const
DEFAULT_DECIMALSEPARATOR = '.'; // don't change!
DEFAULT_TRUE = '1'; // don't change!
DEFAULT_TRUE_STR = 'S'; // don't change!
DEFAULT_FALSE = '0'; // don't change!
DEFAULT_FALSE_STR = 'N'; // don't change!
DEFAULT_DATETIMESEPARATOR = 'T'; // don't change!
DEFAULT_DATESEPARATOR = '-'; // don't change!
DEFAULT_TIMESEPARATOR = ':'; // don't change!
DEFAULT_MSSEPARATOR = '.'; // don't change!
function DecimalSeparator: char;
begin
{$IFDEF Unicode}
Result := FormatSettings.DecimalSeparator;
{$ELSE}
Result := SysUtils.DecimalSeparator;
{$ENDIF Unicode}
end; { DecimalSeparator }
{:Convert time from string (ISO format) to TDateTime.
}
function Str2Time(s: string): TDateTime;
var
hour : word;
minute: word;
msec : word;
p : integer;
second: word;
begin
s := Trim(s);
if s = '' then
Result := 0
else begin
p := Pos(DEFAULT_TIMESEPARATOR,s);
hour := StrToInt(Copy(s,1,p-1));
Delete(s,1,p);
p := Pos(DEFAULT_TIMESEPARATOR,s);
minute := StrToInt(Copy(s,1,p-1));
Delete(s,1,p);
p := Pos(DEFAULT_MSSEPARATOR,s);
if p > 0 then begin
msec := StrToInt(Copy(s,p+1,Length(s)-p));
Delete(s,p,Length(s)-p+1);
end
else
msec := 0;
second := StrToInt(s);
Result := EncodeTime(hour,minute,second,msec);
end;
end; { Str2Time }
{:Convert date/time from string (ISO format) to TDateTime.
}
function ISODateTime2DateTime (const ISODT: String): TDateTime;
var
day : word;
month : word;
p : integer;
sDate : string;
sTime : string;
year : word;
begin
p := Pos (DEFAULT_DATETIMESEPARATOR,ISODT);
// detect all known date/time formats
if (p = 0) and (Pos(DEFAULT_DATESEPARATOR, ISODT) > 0) then
p := Length(ISODT) + 1;
sDate := Trim(Copy(ISODT,1,p-1));
sTime := Trim(Copy(ISODT,p+1,Length(ISODT)-p));
Result := 0;
if sDate <> '' then begin
p := Pos (DEFAULT_DATESEPARATOR,sDate);
year := StrToInt(Copy(sDate,1,p-1));
Delete(sDate,1,p);
p := Pos (DEFAULT_DATESEPARATOR,sDate);
month := StrToInt(Copy(sDate,1,p-1));
day := StrToInt(Copy(sDate,p+1,Length(sDate)-p));
Result := EncodeDate(year,month,day);
end;
Result := Result + Frac(Str2Time(sTime));
end; { ISODateTime2DateTime }
{ Base64 code }
{$IFOPT R+} {$DEFINE OmniXMLUtils_Base64_EnableRangeChecking} {$ENDIF}
{$R-}
{$IFOPT Q+} {$DEFINE OmniXMLUtils_Base64_EnableOverflowChecking} {$ENDIF}
{$Q-}
{$IFOPT O-} {$DEFINE OmniXMLUtils_Base64_DisableOptimization} {$ENDIF}
{$O+}
const
CB64DecodedBufferSize = 52488;
CB64EncodedBufferSize = 69984;
CB64InvalidData = $FF;
CB64PaddingZero = $FE;
var
B64EncodeTable: array[0..63] of Byte;
B64DecodeTable: array[0..255] of Byte;
procedure Base64Setup;
var
i: Integer;
begin
// build encode table
for i := 0 to 25 do
begin
B64EncodeTable[i] := i + Ord('A');
B64EncodeTable[i+26] := i + Ord('a');
end;
for i := 0 to 9 do
B64EncodeTable[i+52] := i + Ord('0');
B64EncodeTable[62] := Ord('+');
B64EncodeTable[63] := Ord('/');
// build decode table
for i := 0 to 255 do
begin
case i of
Ord('A')..Ord('Z'): B64DecodeTable[i] := i - Ord('A');
Ord('a')..Ord('z'): B64DecodeTable[i] := i - Ord('a') + 26;
Ord('0')..Ord('9'): B64DecodeTable[i] := i - Ord('0') + 52;
Ord('+'): B64DecodeTable[i] := 62;
Ord('/'): B64DecodeTable[i] := 63;
Ord('='): B64DecodeTable[i] := CB64PaddingZero;
else
B64DecodeTable[i] := CB64InvalidData;
end;
end;
end;
{$IFDEF OmniXmlUtils_Base64UsePointerMath}
function Base64EncodeOptimized(Decoded, Encoded: PByte; Size: Integer): Integer; overload;
begin
Result := ((Size + 2) div 3) * 4;
while Size >= 3 do
begin
Encoded[0] := B64EncodeTable[Decoded[0] shr 2];
Encoded[1] := B64EncodeTable[((Decoded[0] and $03) shl 4) or (Decoded[1] shr 4)];
Encoded[2] := B64EncodeTable[((Decoded[1] and $0f) shl 2) or (Decoded[2] shr 6)];
Encoded[3] := B64EncodeTable[Decoded[2] and $3f];
Inc(Decoded, 3);
Inc(Encoded, 4);
Dec(Size, 3);
end;
if Size = 1 then
begin
Encoded[0] := B64EncodeTable[Decoded[0] shr 2];
Encoded[1] := B64EncodeTable[(Decoded[0] and $03) shl 4];
Encoded[2] := Ord('=');
Encoded[3] := Ord('=');
end
else if Size = 2 then
begin
Encoded[0] := B64EncodeTable[Decoded[0] shr 2];
Encoded[1] := B64EncodeTable[((Decoded[0] and $03) shl 4) or (Decoded[1] shr 4)];
Encoded[2] := B64EncodeTable[(Decoded[1] and $0f) shl 2];
Encoded[3] := Ord('=');
end;
end;
{$ELSE}
function Base64EncodeOptimized(Decoded, Encoded: Pointer; Size: Integer): Integer; overload;
var
B1, B2, B3: Byte;
AD: PByte;
AE: PByte;
begin
Result := ((Size + 2) div 3) * 4;
AD := PByte(Decoded);
AE := PByte(Encoded);
while Size >= 3 do
begin
B1 := AD^;
Inc(AD);
B2 := AD^;
Inc(AD);
B3 := AD^;
Inc(AD);
AE^ := B64EncodeTable[B1 shr 2];
Inc(AE);
AE^ := B64EncodeTable[((B1 and $03) shl 4) or (B2 shr 4)];
Inc(AE);
AE^ := B64EncodeTable[((B2 and $0f) shl 2) or (B3 shr 6)];
Inc(AE);
AE^ := B64EncodeTable[B3 and $3f];
Inc(AE);
Dec(Size, 3);
end;
if Size = 1 then
begin
B1 := AD^;
AE^ := B64EncodeTable[B1 shr 2];
Inc(AE);
AE^ := B64EncodeTable[(B1 and $03) shl 4];
Inc(AE);
AE^ := Ord('=');
Inc(AE);
AE^ := Ord('=');
end
else if Size = 2 then
begin
B1 := AD^;
Inc(AD);
B2 := AD^;
AE^ := B64EncodeTable[B1 shr 2];
Inc(AE);
AE^ := B64EncodeTable[((B1 and $03) shl 4) or (B2 shr 4)];
Inc(AE);
AE^ := B64EncodeTable[(B2 and $0f) shl 2];
Inc(AE);
AE^ := Ord('=');
end;
end;
{$ENDIF} // OmniXmlUtils_Base64UsePointerMath
function Base64Encode(Decoded, Encoded: Pointer; Size: Integer): Integer; overload;
begin
Result := Base64EncodeOptimized(Decoded, Encoded, Size);
end;
procedure Base64Encode(const decoded, encoded: TStream); overload;
var
DecBuffer: Pointer;
EncBuffer: Pointer;
DecSize: Integer;
EncSize: Integer;
begin
if decoded.Size = 0 then
Exit;
GetMem(DecBuffer, CB64DecodedBufferSize);
try
GetMem(EncBuffer, CB64EncodedBufferSize);
try
repeat
DecSize := decoded.Read(DecBuffer^, CB64DecodedBufferSize);
EncSize := Base64Encode(DecBuffer, EncBuffer, DecSize);
encoded.Write(EncBuffer^, EncSize);
until DecSize <> CB64DecodedBufferSize;
finally
FreeMem(EncBuffer);
end;
finally
FreeMem(DecBuffer);
end;
end;
function Base64Decode(Encoded, Decoded: Pointer; EncodedSize: Integer; var DecodedSize: Integer): Boolean; overload;
var
AE: PByte;
AD: PByte;
QData: array[0..3] of Byte;
QIndex: Integer;
begin
Result := True;
if (EncodedSize mod 4) <> 0 then
begin
Result := False;
Exit;
end;
DecodedSize := (EncodedSize div 4) * 3;
AE := PByte(Encoded);
AD := PByte(Decoded);
while EncodedSize > 0 do
begin
for QIndex := 0 to 3 do
begin
QData[QIndex] := B64DecodeTable[AE^];
case QData[QIndex] of
CB64InvalidData:
begin
Result := False;
Exit;
end;
CB64PaddingZero: Dec(DecodedSize);
end;
Inc(AE);
end;
AD^ := Byte((QData[0] shl 2) or (QData[1] shr 4));
Inc(AD);
if (QData[2] <> CB64PaddingZero) and (QData[3] = CB64PaddingZero) then
begin
AD^ := Byte((QData[1] shl 4) or (QData[2] shr 2));
Inc(AD);
end
else if (QData[2] <> CB64PaddingZero) then
begin
AD^ := Byte((QData[1] shl 4) or (QData[2] shr 2));
Inc(AD);
AD^ := Byte((QData[2] shl 6) or (QData[3]));
Inc(AD);
end;
Dec(EncodedSize, 4);
end;
end;
function Base64Decode(const encoded, decoded: TStream): Boolean; overload;
var
EncBuffer: Pointer;
DecBuffer: Pointer;
EncSize: Integer;
DecSize: Integer;
begin
Result := True;
GetMem(EncBuffer, CB64EncodedBufferSize);
try
GetMem(DecBuffer, CB64DecodedBufferSize);
try
repeat
EncSize := encoded.Read(EncBuffer^, CB64EncodedBufferSize);
if Base64Decode(EncBuffer, DecBuffer, EncSize, DecSize) then