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
|
'encoding UTF-8 Do not remove or change this line!
'**************************************************************************
'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
'*
'* Copyright 2008 by Sun Microsystems, Inc.
'*
'* OpenOffice.org - a multi-platform office productivity suite
'*
'* $RCSfile: t_xml1.inc,v $
'*
'* $Revision: 1.1 $
'*
'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:09 $
'*
'* This file is part of OpenOffice.org.
'*
'* OpenOffice.org is free software: you can redistribute it and/or modify
'* it under the terms of the GNU Lesser General Public License version 3
'* only, as published by the Free Software Foundation.
'*
'* OpenOffice.org is distributed in the hope that it will be useful,
'* but WITHOUT ANY WARRANTY; without even the implied warranty of
'* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
'* GNU Lesser General Public License version 3 for more details
'* (a copy is included in the LICENSE file that accompanied this code).
'*
'* You should have received a copy of the GNU Lesser General Public License
'* version 3 along with OpenOffice.org. If not, see
'* <http://www.openoffice.org/license.html>
'* for a copy of the LGPLv3 License.
'*
'/************************************************************************
'*
'* Owner : helge.delfs@sun.com
'*
'* short description : simple XML-Parser for XML-Files from Registration-Database and Routines to work with SAX-Parser in Testtool
'*
'***********************************************************************************
' #1 hXMLGotoElement
' #1 hXMLGetFirstCharsForElement
' #1 ExtractSections
' #1 GetXMLValue
' #1 GetXMLTagValue
' #1 GetXMLValueList
' #1 GetXMLValueType
' #1 GetXMLValueLine
' #1 GetXMLValueGlobal
' #1 GetExtractXMLValue
' #1 GetExtractXMLValueList
' #1 GetExtractXMLValueFromList
' #1 hXMLSeekElementInTree
'\**********************************************************************************
function hXMLGotoElement ( sElementLine as String, optional bSilent as boolean) as boolean
'/// uses SAX Interface in testtool ///'
'///hXMLGotoElement ( sElementLine as String )
'///+Input : sElementLine => the tree in DOM as one string seperated with ';'
'///+ - - - - - to be more exact, the Attribute Values to 'oor:name' ///'
'///+ - - - -: bSilent => print warnings? ///'
'///+Output : --
'///+Return : was the Element found?
'///- you can jump directly to the correct entry in the DOM-tree
Dim sList (50) as String
Dim i as Integer
Dim x as Integer
Dim y as Integer
Dim n as Integer
dim iMax as integer
dim bFound as boolean
dim bFoundCollect as boolean
dim iAttrCount as integer
dim bLocalSilent as boolean
if (isMissing(bSilent)) then
bLocalSilent = FALSE
else
bLocalSilent = bSilent
endif
bFoundCollect = TRUE
ExtractSections ( sElementLine, sList () )
for i=1 to ListCount ( sList () ) ' for every Section
iMax = SAXGetChildCount()
x = 0
bFound = FALSE
' ' ------------ debug start ----------------------
' for n = 1 to iMax
' SAXSeekElement (n)
' Printlog " " + i + ":(" + n + "/" + iMax + "): '" + SAXGetElementName
' iAttrCount = SAXGetAttributeCount
' for y = 1 to iAttrCount
' Printlog " " + i + ":" + n + ":(" + y + "/" + iAttrCount + "): '"+SAXGetAttributeName (y) +"' : '"+SAXGetAttributeValue (y) +"' "
' next y
' SAXSeekElement (0)
' next n
' ' ------------- debug end -----------------------
while ((bFound = FALSE) AND (x < iMax)) ' compare the VALUE for the ATTRIBUTE 'oor:name' with the wanted ITEM
inc(x) ' do it until it fits; else print warnlog
SAXSeekElement (x)
if (SAXGetAttributeValue ("oor:name") <> sList (i)) then
SAXSeekElement (0)
else
bFound = TRUE
endif
wend
if ((bFound = FALSE) AND (bSilent = FALSE)) then
Warnlog "hXMLGotoElement::ERROR! Element " + i + ": '" + sList (i) + "' not found :-("
endif
bFoundCollect = bFound AND bFoundCollect
next i
hXMLGotoElement = bFoundCollect
end function
'
'-------------------------------------------------------------------------------
'
function hXMLGetFirstCharsForElement ( sElementLine as String, optional sXMLFile as String, optional bClose as Boolean ) as String
'/// uses SAX Interface in testtool ///'
Dim bCloseLocal as Boolean
'///hXMLGetFirstCharsForElement ( sElementLine as String, optional sXMLFile as String, optional bClose as Boolean ) as String
'///+Input : sElementLine => the tree in DOM as one string seperated with ';'
'///+- sXMLFile => ( optional ) if you want to open the DOM for a file you can set here the filename
'///+- bClose => ( optional ) if you want to close the DOM after getting the char, you can set this to TRUE ( default is FALSE )
'///+Output : --
'///+Return : the string for the element
'///- you can jump directly to the correct entry in the DOM-tree and get the char for that entry
'///- the DOM is closed after this return
if IsMissing( sXMLFile ) = FALSE then
SAXReadFile ( sXMLFile )
end if
if IsMissing( bClose ) = TRUE then
bCloseLocal = FALSE
else
bCloseLocal = bClose
end if
hXMLGotoElement ( sElementLine )
SAXSeekElement ( 1 )
if SAXGetNodeType = NodeTypeCharacter then
hXMLGetFirstCharsForElement = SAXGetChars
else
Warnlog "hXMLGetFirstCharsForElement : the element " + sElementLine + " has no chars"
hXMLGetFirstCharsForElement = ""
end if
if bCloseLocal = TRUE then SAXRelease
end function
'
'-------------------------------------------------------------------------------
'
function ExtractSections ( sInput as String, lsXMLsections() as String ) as Integer
'///Input : - sInput => a full section seperated with ';'
'///+- lsXMLsections => an empty list
'///+Output : the list ( lxXMLsections ) with seperated sectionnames
'///+Return : number of sections
Dim ii, iLen as Integer
Dim iList ( 50 ) as String
Dim bFirstEntry as Boolean
Dim Dummy as String
dim sTemp as string
lsXMLsections(0) = 0
iList (0) = 0
iLen = len ( sInput )
bFirstEntry = TRUE
for ii=1 to ( iLen )
Dummy = mid ( sInput, ii, 1 )
if ( mid ( sInput, ii, 1 ) ) = ";" then ListAppend ( iList(), Str ( ii ) )
next ii
for ii=1 to ( ListCount ( iList () ) )
if bFirstEntry = TRUE then
ListAppend ( lsXMLsections(), Left ( sInput, Val(iList(1))-1 ) )
bFirstEntry = FALSE
end if
Dummy = mid ( sInput, Val(iList(ii))+1, Val(iList(ii+1))-Val(iList(ii))-1 )
ListAppend ( lsXMLsections(), Dummy )
next ii
sTemp = ListCount ( lsXMLsections() )
ExtractSections = sTemp
if (sTemp = 0) then
ListAppend (lsXMLsections(), sInput)
ExtractSections = 1
end if
end function
'
'-------------------------------------------------------------------------------
'
function GetXMLValue ( sXMLfile as String, sXMLsectionMaster as String, sXMLsection as String, optional bSilent as Boolean ) as String
'/// Input : - sXMLfile => Filename with full path ///
'///+ - - - - - sXMLsectionMaster => the master-section ( mostly in StarOffice the filename without extension ) ///
'///+ - - - - - sXMLsection => full way to the item ///
'///+ Output : - - ///
'///+ Return : - the value ///
'/// wraper for GetXMLValueGlobal ///'
if IsMIssing ( bSilent ) <> TRUE then
GetXMLValue = GetXMLValueGlobal ( sXMLfile, sXMLsectionMaster, sXMLsection, , , , bSilent )
else
GetXMLValue = GetXMLValueGlobal ( sXMLfile, sXMLsectionMaster, sXMLsection, , , , )
end if
end function
function GetXMLTagValue ( sXMLfile as String, sXMLsectionMaster as String, sXMLsection as String, sValue as String ) as String
'/// Input : - sXMLfile => Filename with full path ///
'///+ - - - - - sXMLsectionMaster => the master-section ( mostly in StarOffice the filename without extension ) ///
'///+ - - - - - sXMLsection => full way to the item ///
'///+ Output : - - ///
'///+ Return : - the value ///
'/// wraper for GetXMLValueGlobal ///'
GetXMLTagValue = GetXMLValueGlobal ( sXMLfile, sXMLsectionMaster, sXMLsection, ,sValue , , )
end function
function GetXMLValueList ( lsXMLValue() as String, sXMLfile as String, sXMLsectionMaster as String, sXMLsection as String ) as String
'/// Input : - sXMLfile => Filename with full path ///
'///+ - - - - - sXMLsectionMaster => the master-section ( mostly in StarOffice the filename without extension ) ///
'///+ - - - - - sXMLsection => full way to the item ///
'///+ Output : - - ///
'///+ Return : - the value ///
'/// wraper for GetXMLValueGlobal ///'
Dim sLine, sLine1 as String
Dim i, iCounter as Integer
sLine = GetXMLValueGlobal ( sXMLfile, sXMLsectionMaster, sXMLsection, ,"cfg:value" , TRUE, )
if sLine = "" then
GetXMLValueList = ""
else
GetXMLValueList = GetExtractXMLValueList ( lsXMLValue(), sLine, , )
end if
end function
'
'-------------------------------------------------------------------------------
'
function GetXMLValueType ( sXMLfile as String, sXMLsectionMaster as String, sXMLsection as String, optional sType ) as String
'/// Input : - sXMLfile => Filename with full path ///
'///+ - - - - - sXMLsectionMaster => the master-section ( mostly in StarOffice the filename without extension ) ///
'///+ - - - - - sXMLsection => full way to the item ///
'///+ Output : - - ///
'///+ Return : - the value ///
'/// wraper for GetXMLValueGlobal ///'
Dim sDummy as String
if IsMissing ( sType ) = TRUE then
sDummy = "type"
else
sDummy = sType
end if
GetXMLValueGlobal ( sXMLfile, sXMLsectionMaster, sXMLsection, sDummy, , , )
GetXMLValueType = sDummy
end function
function GetXMLValueLine ( sXMLfile as String, sXMLsectionMaster as String, sXMLsection as String ) as String
'/// Input : - sXMLfile => Filename with full path ///
'///+ - - - - - sXMLsectionMaster => the master-section ( mostly in StarOffice the filename without extension ) ///
'///+ - - - - - sXMLsection => full way to the item ///
'///+ Output : - - ///
'///+ Return : - the value ///
'/// wraper for GetXMLValueGlobal ///'
GetXMLValueLine = GetXMLValueGlobal ( sXMLfile, sXMLsectionMaster, sXMLsection,,, TRUE, )
end function
'
'-------------------------------------------------------------------------------
'
function GetXMLValueGlobal ( sXMLfile as String, sXMLsectionMaster as String, sXMLsection as String, optional sXMLType, optional sXMLTag, optional biWholeLine, optional bSil as Boolean ) as String
'/// uses no SAX Parser : just text search in the file ///'
'/// You can get the value of an item in a XML-file. The value of the item must be set between <value> and <value/>. ///
'///+ The item can be written in one line or in more lines. ///
'/// Input : - sXMLfile => Filename with full path ///
'///+ - - - - - sXMLsectionMaster => the master-section ( mostly in StarOffice the filename without extension ) ///
'///+ - - - - - sXMLsection => full way to the item ///'
'///+ - - - - - optional sXMLType => if you want to get the XML-Type this variable must be set ///'
'///+ - - - - - optional sXMLTag => if sXMLTag isn't set, "value" is the tag, else you must set the tag here ///'
'///+ Output : - optional sXMLType => if sXMLType is set, it will be returned the Type of the value as string ///'
'///+ Return : - the value of the searched item ///'
' Dim FileNum as Integer
Dim Pos, iSec, i, j, iDum as Integer
Dim MasterSecOK, MasterSecEnd, SecOK, SecEnd, bThrough, bWholeLine as Boolean
Dim xmlZeile, xmlZeile2, sVariable, sDummy, sDummy2 as String
Dim lsSecList ( 1000 ) as String
Dim lsInterim ( 1000 ) as String
Dim textin as object, sfa as object, xInput as object
Dim bSilent as Boolean
if ( IsMissing ( bSil ) ) = TRUE then
bSilent = FALSE
else
bSilent = TRUE
end if
if ( IsMissing ( biWholeLine ) ) = TRUE then
bWholeLine = FALSE
else
bWholeLine = TRUE
end if
if Dir( sXMLfile ) = "" then
if bSilent = FALSE then Warnlog "GetXMLValueGlobal(...) : " + sXMLfile + " is missing!"
exit function
end if
MasterSecOK = FALSE : MasterSecEND = FALSE
SecOK=FALSE : SecEND=FALSE
bThrough = FALSE
Pos = 1
GetXMLValueGlobal = ""
lsSecList (0) = 0
lsInterim (0) = 0
iSec = ExtractSections ( sXMLsection, lsSecList () )
sVariable = lsSecList (iSec)
ListDelete ( lsSecList(), iSec )
iSec = iSec-1
if iSec = 0 then ListAppend ( lsSecList(), "" )
textin = createUnoService( "com.sun.star.io.TextInputStream" )
textin.setEncoding("utf8")
sfa = createUnoService( "com.sun.star.ucb.SimpleFileAccess" )
xInput = sfa.openFileRead( sXMLfile )
textin.setInputStream( xInput )
do until textin.isEOF()
xmlZeile = textin.readLine()
xmlZeile = TrimTab ( Trim ( xmlZeile ) )
xmlZeile2 = lCASE( xmlZeile ) ' control case-insensitiv
if MasterSecOK = FALSE then ' master-section ( com.sun.star. ... )
if xmlZeile2= "<" + lCASE( sXMLsectionMaster ) + ">" OR Instr ( xmlZeile2, "<" + lCASE( sXMLsectionMaster ) + " " ) <> 0 then
MasterSecOK = TRUE
else
if xmlZeile2 = "<" + lCASE( sXMLsectionMaster ) + "/>" then
if bSilent = FALSE then warnlog "GetXMLValueGlobal(...) : '" + sXMLsectionMaster + "' -> master-section has no entries!"
exit do
end if
end if
else
if xmlZeile2= "</" + lCASE( sXMLsectionMaster ) + ">" OR xmlZeile2= "<" + lCASE( sXMLsectionMaster ) + "/>" then
if bSilent = FALSE then warnlog "GetXMLValueGlobal(...) : '" + lsSecList (Pos) + "' -> entry could not be found!"
exit do
end if
if ( Instr (xmlZeile2, lCASE ( "<" + lsSecList (Pos)) ) <> 0 AND iSec > 0 ) AND Pos < iSec+1 then
iDum = Instr ( lsSecList (Pos), " " )
if iDum <> 0 then lsSecList(Pos) = Left ( lsSecList(Pos), iDum -1 )
if xmlZeile2 = "<" + lCASE( lsSecList (Pos) ) + "/>" then
if Pos = iSec then
if bSilent = FALSE then Warnlog "GetXMLValueGlobal(...) : '" + svariable + "' -> entry could not be found"
else
if bSilent = FALSE then Warnlog "GetXMLValueGlobal(...) : '" + lsSecList (Pos) + "' -> entry could not be found"
end if
exit do
else
Pos = Pos + 1
end if
else
if Pos > iSec then
sDummy2 = Mid ( xmlZeile2, 2, len ( svariable ) + 1 )
if sDummy2 = lCase ( svariable ) + ">" OR sDummy2 = lCase ( svariable ) + " " OR bThrough = TRUE then
iDum = Instr ( svariable, " " ) ' inserted because an error in GetXMLValueLineExtra 3.11.00 (TZ)
if iDum <> 0 then svariable = Left ( svariable, iDum -1 ) ' inserted because an error in GetXMLValueLineExtra 3.11.00 (TZ)
sDummy = Mid ( xmlZeile2, len ( xmlZeile2 ) - 1 - len ( svariable), len ( svariable)+1 )
if ( bThrough = FALSE AND ( sDummy = "/" + lCase ( svariable ) OR Right (sDummy, 1 ) = "/" ) ) OR ( bThrough = TRUE AND sDummy = "/" + lCase ( svariable ) ) then
if ListCount ( lsInterim () ) = 0 then
if bWholeLine = TRUE then
GetXMLValueGlobal = xmlZeile
else
if ( IsMissing ( sXMLTag ) ) = TRUE then
if ( IsMissing ( sXMLType ) ) = TRUE then
GetXMLValueGlobal = GetExtractXMLValue ( xmlZeile,, )
else
GetXMLValueGlobal = GetExtractXMLValue ( xmlZeile, sXMLType, )
end if
else
if ( IsMissing ( sXMLType ) ) = TRUE then
GetXMLValueGlobal = GetExtractXMLValue ( xmlZeile,, sXMLTag )
else
GetXMLValueGlobal = GetExtractXMLValue ( xmlZeile, sXMLType, sXMLTag )
end if
end if
end if
else
ListAppend ( lsInterim (), xmlZeile2 )
if bWholeLine = TRUE then
for j=1 to ListCount ( lsInterim () )
GetXMLValueGlobal = GetXMLValueGlobal + lsInterim (j)
next j
else
if ( IsMissing ( sXMLTag ) ) = TRUE then
if ( IsMissing ( sXMLType ) ) = TRUE then
GetXMLValueGlobal = GetExtractXMLValueFromList ( lsInterim (),, )
else
GetXMLValueGlobal = GetExtractXMLValueFromList ( lsInterim (), sXMLType, )
end if
else
if ( IsMissing ( sXMLType ) ) = TRUE then
GetXMLValueGlobal = GetExtractXMLValueFromList ( lsInterim (),, sXMLTag )
else
GetXMLValueGlobal = GetExtractXMLValueFromList ( lsInterim (), sXMLType, sXMLTag )
end if
end if
end if
end if
bThrough = FALSE
exit do
else
if xmlZeile2 <> "" then
bThrough = TRUE
ListAppend ( lsInterim (), xmlZeile2 )
end if
end if
end if
end if
end if
end if
loop
xInput.closeInput '* uno-file-close
if bSilent = FALSE then
if MasterSecOK = FALSE then warnlog "GetXMLValueGlobal (...) : '" + sXMLsectionMaster + "' -> Master-section was not found!"
end if
wait 1000
end function
'
'-------------------------------------------------------------------------------
'
function GetExtractXMLValue ( sFullLine as String, optional sXMLType, optional sXMLTag ) as String
'/// Get the value-string, when the text is only in one line. ///'
'/// Input : - sFullLine => the whole line out of XML-File ///'
'/// Output : - optional sXMLType => if sXMLType is set, it will be returned the Type of the value as string ///'
'/// Return : - the text between <value> and <value/> ///'
Dim i, ii, iStart, iEnd as Integer
Dim sInterim, ssTag as String
if ( IsMissing ( sXMLTag ) ) = TRUE then
ssTag = "value"
else
ssTag = sXMLTag
end if
sInterim = lCase ( sFullLine )
if InStr ( sInterim, "<" + ssTag + "/>" ) <> 0 then
GetExtractXMLValue = ""
else
iStart = InStr ( sInterim, "<" + ssTag + ">" )
iEnd = InStr ( sInterim, "</" + ssTag + ">" )
if iStart <> 0 AND iEnd <> 0 then
if iStart + len(ssTag) + 2 = iEnd then
GetExtractXMLValue = ""
else
GetExtractXMLValue = Mid ( sFullLine, iStart + len ( ssTag )+2, iEnd - iStart - len ( ssTag ) - 2 )
end if
end if
end if
if ( IsMissing ( sXMLType ) ) = FALSE then
sXMLType = lcase (sXMLType)
ii = InStr ( sInterim, sXMLType + "=" )
if ii = 0 then ii = InStr ( sInterim, sXMLType + " =" )
if ii = 0 then ii = InStr ( sInterim, sXMLType + " =" )
if ii = 0 then
sXMLType = ""
else
for i=ii to len ( sInterim ) - ii
if Mid ( sInterim, i, 1 ) = chr (34) then
iStart=i
i=1000
end if
next i
for i=(iStart+1) to len ( sInterim ) - (iStart+1)
if Mid ( sInterim, i, 1 ) = chr (34) then
iEnd=i
i=1000
end if
next i
sXMLType = Mid ( sFullLine, iStart+1, iEnd-iStart-1 )
end if
end if
end function
'
'-------------------------------------------------------------------------------
'
function GetExtractXMLValueList ( lsXMLValues (), sFullLine as String, optional sXMLType, optional sXMLTag ) as Integer
'/// Get the value-string, when the text is only in one line ///'
'/// Input : - ///'
'/// Output : - ///'
'/// Return : - ///'
Dim i, ii, iStart, iEnd as Integer
Dim sInterim, ssTag as String
lsXMLValues(0)=0
if ( IsMissing ( sXMLTag ) ) = TRUE then
ssTag = "value"
else
ssTag = sXMLTag
end if
sInterim = lCase ( sFullLine )
ii = len( sInterim ) / len ( ssTag ) ' maximal so viele Wiederholungen, wie es sTags gibt
for i=1 to ii
if InStr ( sInterim, "<" + ssTag + "/>" ) = 0 then
iStart = InStr ( sInterim, "<" + ssTag + ">" )
iEnd = InStr ( sInterim, "</" + ssTag + ">" )
if iStart <> 0 AND iEnd <> 0 then
if iStart + len(ssTag) + 2 = iEnd then
ListAppend ( lsXMLValues(), "" )
sInterim = Mid ( sInterim, iEnd + len (ssTag)+2, len (sInterim) - iEnd - len (ssTag) - 1 - 2 )
else
ListAppend ( lsXMLValues(), Mid ( sInterim, iStart + len(ssTag)+2, iEnd - iStart - len(ssTag)-2 ) )
sInterim = Mid ( sInterim, iEnd + len (ssTag), len (sInterim) - iEnd - len (ssTag) - 1 )
end if
else
i = ii + 1
end if
end if
next i
GetExtractXMLValueList = ListCount ( lsXMLValues() )
if ( IsMissing ( sXMLType ) ) = FALSE then
sXMLType = lcase (sXMLType)
ii = InStr ( sInterim, sXMLType + "=" )
if ii = 0 then ii = InStr ( sInterim, sXMLType + " =" )
if ii = 0 then ii = InStr ( sInterim, sXMLType + " =" )
if ii = 0 then
sXMLType = ""
else
for i=ii to len ( sInterim ) - ii
if Mid ( sInterim, i, 1 ) = chr (34) then
iStart=i
i=1000
end if
next i
for i=(iStart+1) to len ( sInterim ) - (iStart+1)
if Mid ( sInterim, i, 1 ) = chr (34) then
iEnd=i
i=1000
end if
next i
sXMLType = Mid ( sFullLine, iStart+1, iEnd-iStart-1 )
end if
end if
end function
'
'-------------------------------------------------------------------------------
'
function GetExtractXMLValueFromList ( lsList() as String, optional sXMLType, optional sXMLTag ) as String
'/// Get the value-string, when the text is in a list ( when the item is written in more than one line ). ///'
'/// Input : - lsList() => the list of the whole entry of the xml-item ///'
'/// Output : - optional sXMLType => if sXMLType is set, it will be returned the Type of the value as string ///'
'/// Return : - the text between <value> and <value/> ///'
Dim i, ii, iStart, iEnd as Integer
Dim sInterim, sInterim1, ssTag as String
if ( IsMissing ( sXMLTag ) ) = TRUE then
ssTag = "value"
else
ssTag = sXMLTag
end if
for i=1 to ListCount ( lsList() )
sInterim1 = sInterim1 + lsList(i)
next i
sInterim = lCase ( sInterim1 )
if InStr ( sInterim, "<"+ ssTag +"/>" ) <> 0 then
GetExtractXMLValueFromList = ""
else
iStart = InStr ( sInterim, "<" + ssTag + ">" )
iEnd = InStr ( sInterim, "</" + ssTag + ">" )
if iStart <> 0 AND iEnd <> 0 then
if iStart + len(ssTag) + 2 = iEnd then
GetExtractXMLValueFromList = ""
else
GetExtractXMLValueFromList = Mid ( sInterim1, iStart + len ( ssTag )+2, iEnd - iStart - len ( ssTag ) - 2 )
end if
end if
end if
if ( IsMissing ( sXMLType ) ) = FALSE then
sXMLType = lcase (sXMLType)
ii = InStr ( sInterim, sXMLType + "=" )
if ii = 0 then ii = InStr ( sInterim, sXMLType + " =" )
if ii = 0 then ii = InStr ( sInterim, sXMLType + " =" )
if ii = 0 then
sXMLType = ""
else
for i=ii to len ( sInterim ) - ii
if Mid ( sInterim, i, 1 ) = chr (34) then
iStart=i
i=1000
end if
next i
for i=(iStart+1) to len ( sInterim ) - (iStart+1)
if Mid ( sInterim, i, 1 ) = chr (34) then
iEnd=i
i=1000
end if
next i
sXMLType = Mid ( sInterim1, iStart+1, iEnd-iStart-1 )
end if
end if
end function
'
'-----------------------------------------------------------------------------
'
function hXMLSeekElementInTree ( sSeekThisNodeXML as STRING ) as BOOLEAN
hXMLSeekElementInTree = FALSE
' Peter Junge: 2005-07-29
'///<u><b>Recursion to find XML element</b></u>///
'///Input: 'sSeekThisNodeXML' - XML element to seek, e.g. 'foo:bar'///
'///(A XML DOM has to be loaded before)///
'///Seek begins at current XML pointer///
'///Return: TRUE if element was found, else FALSE///
'///BEHAVIOUR: XML pointer is set to 'foo:bar' if found, if not XML pointer is reset to initial element///
'///NOTE: Currently only the first appearence of 'foo:bar' is found.///
'///NOTE: If e.g. the Nth element should be found you have to modify this function///
'///NOTE: There should be further enhancements possible, e.g. find element with specific attribute///
dim iIndex as INTEGER
'///<ul><li>Check if current node matches 'sSeekThisNodeXML'</li>///
if SAXGetElementName() = sSeekThisNodeXML then
'///<li>MATCH: Function returns TRUE</li>///
hXMLSeekElementInTree = TRUE
else
'///<li>NO MATCH: LOOKUP if current node has elements</li>///
for iIndex = 1 to SAXGetChildCount()
'///<li>-> (Loop) Set pointer on child</li>///
SAXSeekElement ( iIndex )
'///<li>-> Check if child is a XML element</li>///
if SAXGetNodeType() = 556 then
'///<li>-> RECURSION: function recalls itself for current element</li>///
if hXMLSeekElementInTree ( sSeekThisNodeXML ) = TRUE then
'///<li>Don't forget to pass back the result TRUE to recursions parent</li>///
hXMLSeekElementInTree = TRUE
'///<li>Exit loop if found</li>///
Exit For
endif
endif
'///<li>NO MATCH: Go back to parent in DOM tree</li></ul>///
SAXSeekElement( 0 )
next iIndex
endif
end function
|