testautomation/global/tools/includes/optional/t_xml1.inc

   1 'encoding UTF-8  Do not remove or change this line!
   2 '**************************************************************************
   3 '* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
   4 '*
   5 '* Copyright 2008 by Sun Microsystems, Inc.
   6 '*
   7 '* OpenOffice.org - a multi-platform office productivity suite
   8 '*
   9 '* $RCSfile: t_xml1.inc,v $
  10 '*
  11 '* $Revision: 1.1 $
  12 '*
  13 '* last change: $Author: jsi $ $Date: 2008-06-13 10:27:09 $
  14 '*
  15 '* This file is part of OpenOffice.org.
  16 '*
  17 '* OpenOffice.org is free software: you can redistribute it and/or modify
  18 '* it under the terms of the GNU Lesser General Public License version 3
  19 '* only, as published by the Free Software Foundation.
  20 '*
  21 '* OpenOffice.org is distributed in the hope that it will be useful,
  22 '* but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 '* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 '* GNU Lesser General Public License version 3 for more details
  25 '* (a copy is included in the LICENSE file that accompanied this code).
  26 '*
  27 '* You should have received a copy of the GNU Lesser General Public License
  28 '* version 3 along with OpenOffice.org.  If not, see
  29 '* <http://www.openoffice.org/license.html>
  30 '* for a copy of the LGPLv3 License.
  31 '*
  32 '/************************************************************************
  33 '*
  34 '* Owner : helge.delfs@sun.com
  35 '*
  36 '* short description : simple XML-Parser for XML-Files from Registration-Database and Routines to work with SAX-Parser in Testtool
  37 '*
  38 '***********************************************************************************
  39 ' #1 hXMLGotoElement
  40 ' #1 hXMLGetFirstCharsForElement
  41 ' #1 ExtractSections
  42 ' #1 GetXMLValue
  43 ' #1 GetXMLTagValue
  44 ' #1 GetXMLValueList
  45 ' #1 GetXMLValueType
  46 ' #1 GetXMLValueLine
  47 ' #1 GetXMLValueGlobal
  48 ' #1 GetExtractXMLValue
  49 ' #1 GetExtractXMLValueList
  50 ' #1 GetExtractXMLValueFromList
  51 ' #1 hXMLSeekElementInTree
  52 '\**********************************************************************************
  53
  54 function hXMLGotoElement ( sElementLine as String, optional bSilent as boolean) as boolean
  55 '/// uses SAX Interface in testtool ///'
  56 '///hXMLGotoElement ( sElementLine as String )
  57 '///+Input  : sElementLine  => the tree in DOM as one string seperated with ';'
  58 '///+ - - - - - to be more exact, the Attribute Values to 'oor:name' ///'
  59 '///+ - - - -: bSilent => print warnings? ///'
  60 '///+Output : --
  61 '///+Return : was the Element found?
  62 '///- you can jump directly to the correct entry in the DOM-tree
  63
  64   Dim sList (50) as String
  65   Dim i as Integer
  66   Dim x as Integer
  67   Dim y as Integer
  68   Dim n as Integer
  69   dim iMax as integer
  70   dim bFound as boolean
  71   dim bFoundCollect as boolean
  72   dim iAttrCount as integer
  73   dim bLocalSilent as boolean
  74
  75   if (isMissing(bSilent)) then
  76       bLocalSilent = FALSE
  77   else
  78       bLocalSilent = bSilent
  79   endif
  80
  81   bFoundCollect = TRUE
  82   ExtractSections ( sElementLine, sList () )
  83
  84    for i=1 to ListCount ( sList () ) ' for every Section
  85       iMax = SAXGetChildCount()
  86       x = 0
  87       bFound = FALSE
  88 '      ' ------------ debug start ----------------------
  89 '      for n = 1 to iMax
  90 '         SAXSeekElement (n)
  91 '         Printlog " " + i + ":(" + n + "/" + iMax + "): '" + SAXGetElementName
  92 '         iAttrCount = SAXGetAttributeCount
  93 '         for y = 1 to iAttrCount
  94 '            Printlog "     " + i + ":" + n + ":(" + y + "/" + iAttrCount + "): '"+SAXGetAttributeName (y) +"' : '"+SAXGetAttributeValue (y) +"' "
  95 '         next y
  96 '         SAXSeekElement (0)
  97 '      next n
  98 '      ' ------------- debug end -----------------------
  99       while ((bFound = FALSE) AND (x < iMax)) ' compare the VALUE for the ATTRIBUTE 'oor:name' with the wanted ITEM
 100          inc(x)                               ' do it until it fits; else print warnlog
 101          SAXSeekElement (x)
 102          if (SAXGetAttributeValue ("oor:name") <> sList (i)) then
 103             SAXSeekElement (0)
 104          else
 105             bFound = TRUE
 106          endif
 107       wend
 108       if ((bFound = FALSE) AND (bSilent = FALSE)) then
 109          Warnlog "hXMLGotoElement::ERROR! Element " + i + ": '" + sList (i) + "' not found :-("
 110       endif
 111       bFoundCollect = bFound AND bFoundCollect
 112    next i
 113    hXMLGotoElement = bFoundCollect
 114 end function
 115 '
 116 '-------------------------------------------------------------------------------
 117 '
 118 function hXMLGetFirstCharsForElement ( sElementLine as String, optional sXMLFile as String, optional bClose as Boolean ) as String
 119 '/// uses SAX Interface in testtool ///'
 120   Dim bCloseLocal as Boolean
 121 '///hXMLGetFirstCharsForElement ( sElementLine as String, optional sXMLFile as String, optional bClose as Boolean ) as String
 122 '///+Input  : sElementLine  => the tree in DOM as one string seperated with ';'
 123 '///+-        sXMLFile      => ( optional ) if you want to open the DOM for a file you can set here the filename
 124 '///+-        bClose        => ( optional ) if you want to close the DOM after getting the char, you can set this to TRUE ( default is FALSE )
 125 '///+Output : --
 126 '///+Return : the string for the element
 127 '///- you can jump directly to the correct entry in the DOM-tree and get the char for that entry
 128 '///- the DOM is closed after this return
 129
 130    if IsMissing( sXMLFile ) = FALSE then
 131       SAXReadFile ( sXMLFile )
 132    end if
 133
 134    if IsMissing( bClose ) = TRUE then
 135       bCloseLocal = FALSE
 136    else
 137       bCloseLocal = bClose
 138    end if
 139
 140    hXMLGotoElement ( sElementLine )
 141    SAXSeekElement ( 1 )
 142    if SAXGetNodeType = NodeTypeCharacter then
 143       hXMLGetFirstCharsForElement = SAXGetChars
 144    else
 145       Warnlog "hXMLGetFirstCharsForElement : the element " + sElementLine + " has no chars"
 146       hXMLGetFirstCharsForElement = ""
 147    end if
 148
 149    if bCloseLocal = TRUE then SAXRelease
 150 end function
 151 '
 152 '-------------------------------------------------------------------------------
 153 '
 154 function ExtractSections ( sInput as String, lsXMLsections() as String ) as Integer
 155 '///Input  : - sInput        => a full section seperated with ';'
 156 '///+-         lsXMLsections => an empty list
 157 '///+Output : the list ( lxXMLsections ) with seperated sectionnames
 158 '///+Return : number of sections
 159
 160   Dim ii, iLen as Integer
 161   Dim iList ( 50 ) as String
 162   Dim bFirstEntry as Boolean
 163   Dim Dummy as String
 164   dim sTemp as string
 165
 166    lsXMLsections(0) = 0
 167    iList (0) = 0
 168    iLen = len ( sInput )
 169    bFirstEntry = TRUE
 170
 171    for ii=1 to ( iLen )
 172       Dummy = mid ( sInput, ii, 1 )
 173       if ( mid ( sInput, ii, 1 ) ) = ";" then ListAppend ( iList(), Str ( ii ) )
 174    next ii
 175
 176    for ii=1 to ( ListCount ( iList () ) )
 177       if bFirstEntry = TRUE then
 178          ListAppend ( lsXMLsections(), Left ( sInput, Val(iList(1))-1 ) )
 179          bFirstEntry = FALSE
 180       end if
 181       Dummy = mid ( sInput, Val(iList(ii))+1, Val(iList(ii+1))-Val(iList(ii))-1 )
 182       ListAppend ( lsXMLsections(), Dummy )
 183    next ii
 184
 185    sTemp = ListCount ( lsXMLsections() )
 186    ExtractSections = sTemp
 187    if (sTemp = 0) then
 188       ListAppend (lsXMLsections(), sInput)
 189       ExtractSections = 1
 190    end if
 191 end function
 192 '
 193 '-------------------------------------------------------------------------------
 194 '
 195 function GetXMLValue ( sXMLfile as String, sXMLsectionMaster as String, sXMLsection as String, optional bSilent as Boolean ) as String
 196 '/// Input  : - sXMLfile          => Filename with full path ///
 197 '///+ - - - - - sXMLsectionMaster => the master-section ( mostly in StarOffice the filename without extension ) ///
 198 '///+ - - - - - sXMLsection       => full way to the item ///
 199 '///+ Output : - - ///
 200 '///+ Return : - the value ///
 201 '/// wraper for GetXMLValueGlobal ///'
 202    if IsMIssing ( bSilent ) <> TRUE then
 203       GetXMLValue = GetXMLValueGlobal ( sXMLfile, sXMLsectionMaster, sXMLsection, , , , bSilent )
 204    else
 205       GetXMLValue = GetXMLValueGlobal ( sXMLfile, sXMLsectionMaster, sXMLsection, , , , )
 206    end if
 207 end function
 208
 209 function GetXMLTagValue ( sXMLfile as String, sXMLsectionMaster as String, sXMLsection as String, sValue as String ) as String
 210 '/// Input  : - sXMLfile          => Filename with full path ///
 211 '///+ - - - - - sXMLsectionMaster => the master-section ( mostly in StarOffice the filename without extension ) ///
 212 '///+ - - - - - sXMLsection       => full way to the item ///
 213 '///+ Output : - - ///
 214 '///+ Return : - the value ///
 215 '/// wraper for GetXMLValueGlobal ///'
 216    GetXMLTagValue = GetXMLValueGlobal ( sXMLfile, sXMLsectionMaster, sXMLsection, ,sValue , , )
 217 end function
 218
 219 function GetXMLValueList ( lsXMLValue() as String, sXMLfile as String, sXMLsectionMaster as String, sXMLsection as String ) as String
 220 '/// Input  : - sXMLfile          => Filename with full path ///
 221 '///+ - - - - - sXMLsectionMaster => the master-section ( mostly in StarOffice the filename without extension ) ///
 222 '///+ - - - - - sXMLsection       => full way to the item ///
 223 '///+ Output : - - ///
 224 '///+ Return : - the value ///
 225 '/// wraper for GetXMLValueGlobal ///'
 226    Dim sLine, sLine1 as String
 227    Dim i, iCounter as Integer
 228
 229    sLine = GetXMLValueGlobal ( sXMLfile, sXMLsectionMaster, sXMLsection, ,"cfg:value" , TRUE, )
 230    if sLine = "" then
 231       GetXMLValueList = ""
 232    else
 233       GetXMLValueList = GetExtractXMLValueList ( lsXMLValue(), sLine, , )
 234    end if
 235 end function
 236 '
 237 '-------------------------------------------------------------------------------
 238 '
 239 function GetXMLValueType ( sXMLfile as String, sXMLsectionMaster as String, sXMLsection as String, optional sType ) as String
 240 '/// Input  : - sXMLfile          => Filename with full path ///
 241 '///+ - - - - - sXMLsectionMaster => the master-section ( mostly in StarOffice the filename without extension ) ///
 242 '///+ - - - - - sXMLsection       => full way to the item ///
 243 '///+ Output : - - ///
 244 '///+ Return : - the value ///
 245 '/// wraper for GetXMLValueGlobal ///'
 246  Dim sDummy as String
 247    if IsMissing ( sType ) = TRUE then
 248       sDummy = "type"
 249    else
 250       sDummy = sType
 251    end if
 252
 253    GetXMLValueGlobal ( sXMLfile, sXMLsectionMaster, sXMLsection, sDummy, , , )
 254    GetXMLValueType = sDummy
 255 end function
 256
 257 function GetXMLValueLine ( sXMLfile as String, sXMLsectionMaster as String, sXMLsection as String ) as String
 258 '/// Input  : - sXMLfile          => Filename with full path ///
 259 '///+ - - - - - sXMLsectionMaster => the master-section ( mostly in StarOffice the filename without extension ) ///
 260 '///+ - - - - - sXMLsection       => full way to the item ///
 261 '///+ Output : - - ///
 262 '///+ Return : - the value ///
 263 '/// wraper for GetXMLValueGlobal ///'
 264    GetXMLValueLine = GetXMLValueGlobal ( sXMLfile, sXMLsectionMaster, sXMLsection,,, TRUE, )
 265 end function
 266 '
 267 '-------------------------------------------------------------------------------
 268 '
 269 function GetXMLValueGlobal ( sXMLfile as String, sXMLsectionMaster as String, sXMLsection as String, optional sXMLType, optional sXMLTag, optional biWholeLine, optional bSil as Boolean ) as String
 270 '/// uses no SAX Parser : just text search in the file ///'
 271 '/// You can get the value of an item in a XML-file. The value of the item must be set between &lt;value&gt; and &lt;value/&gt;. ///
 272 '///+ The item can be written in one line or in more lines. ///
 273 '/// Input  : - sXMLfile          => Filename with full path ///
 274 '///+ - - - - - sXMLsectionMaster => the master-section ( mostly in StarOffice the filename without extension ) ///
 275 '///+ - - - - - sXMLsection       => full way to the item ///'
 276 '///+ - - - - - optional sXMLType => if you want to get the XML-Type this variable must be set ///'
 277 '///+ - - - - - optional sXMLTag  => if sXMLTag isn't set, "value" is the tag, else you must set the tag here ///'
 278 '///+ Output : - optional sXMLType => if sXMLType is set, it will be returned the Type of the value as string ///'
 279 '///+ Return : - the value of the searched item ///'
 280 '  Dim FileNum as Integer
 281   Dim Pos, iSec, i, j, iDum as Integer
 282   Dim MasterSecOK, MasterSecEnd, SecOK, SecEnd, bThrough, bWholeLine as Boolean
 283   Dim xmlZeile, xmlZeile2, sVariable, sDummy, sDummy2 as String
 284   Dim lsSecList ( 1000 ) as String
 285   Dim lsInterim ( 1000 ) as String
 286   Dim textin as object, sfa as object, xInput as object
 287   Dim bSilent as Boolean
 288
 289    if ( IsMissing ( bSil ) ) = TRUE then
 290       bSilent = FALSE
 291    else
 292       bSilent = TRUE
 293    end if
 294
 295    if ( IsMissing ( biWholeLine ) ) = TRUE then
 296       bWholeLine = FALSE
 297    else
 298       bWholeLine = TRUE
 299    end if
 300
 301    if Dir( sXMLfile ) = "" then
 302       if bSilent = FALSE then Warnlog "GetXMLValueGlobal(...) : " + sXMLfile + " is missing!"
 303       exit function
 304    end if
 305
 306    MasterSecOK = FALSE : MasterSecEND = FALSE
 307    SecOK=FALSE : SecEND=FALSE
 308    bThrough = FALSE
 309    Pos = 1
 310    GetXMLValueGlobal = ""
 311
 312    lsSecList (0) = 0
 313    lsInterim (0) = 0
 314
 315    iSec = ExtractSections ( sXMLsection, lsSecList () )
 316    sVariable = lsSecList (iSec)
 317    ListDelete ( lsSecList(), iSec )
 318    iSec = iSec-1
 319    if iSec = 0 then ListAppend ( lsSecList(), "" )
 320
 321    textin = createUnoService( "com.sun.star.io.TextInputStream" )
 322    textin.setEncoding("utf8")
 323    sfa = createUnoService( "com.sun.star.ucb.SimpleFileAccess" )
 324    xInput = sfa.openFileRead( sXMLfile )
 325    textin.setInputStream( xInput )
 326
 327    do until textin.isEOF()
 328       xmlZeile = textin.readLine()
 329
 330       xmlZeile = TrimTab ( Trim ( xmlZeile ) )
 331       xmlZeile2 = lCASE( xmlZeile )                                      ' control case-insensitiv
 332
 333       if MasterSecOK = FALSE then                                    ' master-section ( com.sun.star. ... )
 334          if xmlZeile2= "<" + lCASE( sXMLsectionMaster ) + ">" OR Instr ( xmlZeile2, "<" + lCASE( sXMLsectionMaster ) + " " ) <> 0 then
 335             MasterSecOK = TRUE
 336          else
 337             if xmlZeile2 = "<" + lCASE( sXMLsectionMaster ) + "/>" then
 338                if bSilent = FALSE then warnlog "GetXMLValueGlobal(...) : '" + sXMLsectionMaster + "'  -> master-section has no entries!"
 339                exit do
 340             end if
 341          end if
 342       else
 343          if xmlZeile2= "</" + lCASE( sXMLsectionMaster ) + ">" OR xmlZeile2= "<" + lCASE( sXMLsectionMaster ) + "/>" then
 344             if bSilent = FALSE then warnlog "GetXMLValueGlobal(...) : '" + lsSecList (Pos) + "'  -> entry could not be found!"
 345             exit do
 346          end if
 347
 348          if ( Instr (xmlZeile2, lCASE ( "<" + lsSecList (Pos)) ) <> 0 AND iSec > 0 ) AND Pos < iSec+1 then
 349             iDum = Instr ( lsSecList (Pos), " " )
 350             if iDum <> 0 then lsSecList(Pos) = Left ( lsSecList(Pos), iDum -1 )
 351             if xmlZeile2 = "<" + lCASE( lsSecList (Pos) ) + "/>" then
 352                if Pos = iSec then
 353                   if bSilent = FALSE then Warnlog "GetXMLValueGlobal(...) : '" + svariable + "'  -> entry could not be found"
 354                else
 355                   if bSilent = FALSE then Warnlog "GetXMLValueGlobal(...) : '" + lsSecList (Pos) + "'  -> entry could not be found"
 356                end if
 357                exit do
 358             else
 359                Pos = Pos + 1
 360             end if
 361          else
 362             if Pos > iSec then
 363                sDummy2 = Mid ( xmlZeile2, 2, len ( svariable ) + 1 )
 364                if sDummy2 = lCase ( svariable ) + ">" OR sDummy2 = lCase ( svariable ) + " " OR bThrough = TRUE then
 365                   iDum = Instr ( svariable, " " )                                 ' inserted because an error in GetXMLValueLineExtra 3.11.00 (TZ)
 366                   if iDum <> 0 then svariable = Left ( svariable, iDum -1 )       ' inserted because an error in GetXMLValueLineExtra 3.11.00 (TZ)
 367                   sDummy = Mid ( xmlZeile2, len ( xmlZeile2 ) - 1 - len ( svariable), len ( svariable)+1 )
 368                   if ( bThrough = FALSE AND ( sDummy = "/" + lCase ( svariable ) OR Right (sDummy, 1 ) = "/" ) ) OR ( bThrough = TRUE AND sDummy = "/" + lCase ( svariable ) ) then
 369                      if ListCount  (  lsInterim () ) = 0 then
 370                         if bWholeLine = TRUE then
 371                            GetXMLValueGlobal = xmlZeile
 372                         else
 373                            if ( IsMissing ( sXMLTag ) ) = TRUE then
 374                               if ( IsMissing ( sXMLType ) ) = TRUE then
 375                                  GetXMLValueGlobal = GetExtractXMLValue ( xmlZeile,, )
 376                               else
 377                                  GetXMLValueGlobal = GetExtractXMLValue ( xmlZeile, sXMLType, )
 378                               end if
 379                            else
 380                               if ( IsMissing ( sXMLType ) ) = TRUE then
 381                                  GetXMLValueGlobal = GetExtractXMLValue ( xmlZeile,, sXMLTag )
 382                               else
 383                                  GetXMLValueGlobal = GetExtractXMLValue ( xmlZeile, sXMLType, sXMLTag )
 384                               end if
 385                            end if
 386                         end if
 387                      else
 388                         ListAppend ( lsInterim (), xmlZeile2 )
 389                         if bWholeLine = TRUE then
 390                            for j=1 to ListCount ( lsInterim () )
 391                                GetXMLValueGlobal = GetXMLValueGlobal + lsInterim (j)
 392                            next j
 393                         else
 394                            if ( IsMissing ( sXMLTag ) ) = TRUE then
 395                               if ( IsMissing ( sXMLType ) ) = TRUE then
 396                                  GetXMLValueGlobal = GetExtractXMLValueFromList ( lsInterim (),, )
 397                               else
 398                                  GetXMLValueGlobal = GetExtractXMLValueFromList ( lsInterim (), sXMLType, )
 399                               end if
 400                            else
 401                               if ( IsMissing ( sXMLType ) ) = TRUE then
 402                                  GetXMLValueGlobal = GetExtractXMLValueFromList ( lsInterim (),, sXMLTag )
 403                               else
 404                                  GetXMLValueGlobal = GetExtractXMLValueFromList ( lsInterim (), sXMLType, sXMLTag )
 405                               end if
 406                            end if
 407                         end if
 408                      end if
 409                      bThrough = FALSE
 410                      exit do
 411                   else
 412                      if xmlZeile2 <> "" then
 413                         bThrough = TRUE
 414                         ListAppend ( lsInterim (), xmlZeile2 )
 415                      end if
 416                   end if
 417                end if
 418             end if
 419          end if
 420       end if
 421    loop
 422
 423    xInput.closeInput                                                       '* uno-file-close
 424
 425    if bSilent = FALSE then
 426       if MasterSecOK = FALSE then warnlog "GetXMLValueGlobal (...) : '" + sXMLsectionMaster + "'  -> Master-section was not found!"
 427    end if
 428    wait 1000
 429 end function
 430 '
 431 '-------------------------------------------------------------------------------
 432 '
 433 function GetExtractXMLValue ( sFullLine as String, optional sXMLType, optional sXMLTag ) as String
 434 '/// Get the value-string, when the text is only in one line. ///'
 435 '/// Input  : - sFullLine          => the whole line out of XML-File ///'
 436 '/// Output : - optional sXMLType => if sXMLType is set, it will be returned the Type of the value as string ///'
 437 '/// Return : - the text between <value> and <value/> ///'
 438   Dim i, ii, iStart, iEnd as Integer
 439   Dim sInterim, ssTag as String
 440
 441    if ( IsMissing ( sXMLTag ) ) = TRUE then
 442       ssTag = "value"
 443    else
 444       ssTag = sXMLTag
 445    end if
 446
 447    sInterim = lCase ( sFullLine )
 448
 449    if InStr ( sInterim, "<" + ssTag + "/>" ) <> 0 then
 450       GetExtractXMLValue = ""
 451    else
 452       iStart = InStr ( sInterim, "<" + ssTag + ">" )
 453       iEnd = InStr ( sInterim, "</" + ssTag + ">" )
 454       if iStart <> 0 AND iEnd <> 0 then
 455          if iStart + len(ssTag) + 2  = iEnd then
 456             GetExtractXMLValue = ""
 457          else
 458             GetExtractXMLValue = Mid ( sFullLine, iStart + len ( ssTag )+2, iEnd - iStart - len ( ssTag ) - 2 )
 459          end if
 460       end if
 461   end if
 462
 463   if ( IsMissing ( sXMLType ) ) = FALSE then
 464       sXMLType = lcase (sXMLType)
 465       ii = InStr ( sInterim, sXMLType + "=" )
 466       if ii = 0 then ii = InStr ( sInterim, sXMLType + " =" )
 467       if ii = 0 then ii = InStr ( sInterim, sXMLType + "  =" )
 468
 469       if ii = 0 then
 470          sXMLType = ""
 471       else
 472          for i=ii to len ( sInterim ) - ii
 473             if Mid ( sInterim, i, 1 ) = chr (34) then
 474                iStart=i
 475                i=1000
 476             end if
 477          next i
 478          for i=(iStart+1) to len ( sInterim ) - (iStart+1)
 479             if Mid ( sInterim, i, 1 ) = chr (34) then
 480                iEnd=i
 481                i=1000
 482             end if
 483          next i
 484          sXMLType = Mid ( sFullLine, iStart+1, iEnd-iStart-1 )
 485       end if
 486   end if
 487
 488 end function
 489 '
 490 '-------------------------------------------------------------------------------
 491 '
 492 function GetExtractXMLValueList ( lsXMLValues (), sFullLine as String, optional sXMLType, optional sXMLTag ) as Integer
 493 '/// Get the value-string, when the text is only in one line ///'
 494 '/// Input  : - ///'
 495 '/// Output : - ///'
 496 '/// Return : - ///'
 497   Dim i, ii, iStart, iEnd as Integer
 498   Dim sInterim, ssTag as String
 499
 500    lsXMLValues(0)=0
 501
 502    if ( IsMissing ( sXMLTag ) ) = TRUE then
 503       ssTag = "value"
 504    else
 505       ssTag = sXMLTag
 506    end if
 507
 508    sInterim = lCase ( sFullLine )
 509    ii = len( sInterim ) / len ( ssTag )                           ' maximal so viele Wiederholungen, wie es sTags gibt
 510
 511    for i=1 to ii
 512       if InStr ( sInterim, "<" + ssTag + "/>" ) = 0 then
 513          iStart = InStr ( sInterim, "<" + ssTag + ">" )
 514          iEnd = InStr ( sInterim, "</" + ssTag + ">" )
 515          if iStart <> 0 AND iEnd <> 0 then
 516             if iStart + len(ssTag) + 2  = iEnd then
 517                ListAppend ( lsXMLValues(), "" )
 518                sInterim = Mid ( sInterim, iEnd + len (ssTag)+2, len (sInterim) - iEnd - len (ssTag) - 1 - 2 )
 519             else
 520                ListAppend ( lsXMLValues(), Mid ( sInterim, iStart + len(ssTag)+2, iEnd - iStart - len(ssTag)-2  ) )
 521                sInterim = Mid ( sInterim, iEnd + len (ssTag), len (sInterim) - iEnd - len (ssTag) - 1 )
 522             end if
 523          else
 524             i = ii + 1
 525          end if
 526       end if
 527    next i
 528    GetExtractXMLValueList = ListCount ( lsXMLValues() )
 529
 530    if ( IsMissing ( sXMLType ) ) = FALSE then
 531       sXMLType = lcase (sXMLType)
 532       ii = InStr ( sInterim, sXMLType + "=" )
 533       if ii = 0 then ii = InStr ( sInterim, sXMLType + " =" )
 534       if ii = 0 then ii = InStr ( sInterim, sXMLType + "  =" )
 535
 536       if ii = 0 then
 537          sXMLType = ""
 538       else
 539          for i=ii to len ( sInterim ) - ii
 540             if Mid ( sInterim, i, 1 ) = chr (34) then
 541                iStart=i
 542                i=1000
 543             end if
 544          next i
 545          for i=(iStart+1) to len ( sInterim ) - (iStart+1)
 546             if Mid ( sInterim, i, 1 ) = chr (34) then
 547                iEnd=i
 548                i=1000
 549             end if
 550          next i
 551          sXMLType = Mid ( sFullLine, iStart+1, iEnd-iStart-1 )
 552       end if
 553   end if
 554
 555 end function
 556 '
 557 '-------------------------------------------------------------------------------
 558 '
 559 function GetExtractXMLValueFromList ( lsList() as String, optional sXMLType, optional sXMLTag ) as String
 560 '/// Get the value-string, when the text is in a list ( when the item is written in more than one line ). ///'
 561 '/// Input  : - lsList()          => the list of the whole entry of the xml-item ///'
 562 '/// Output : - optional sXMLType => if sXMLType is set, it will be returned the Type of the value as string ///'
 563 '/// Return : - the text between <value> and <value/> ///'
 564   Dim i, ii, iStart, iEnd as Integer
 565   Dim sInterim, sInterim1, ssTag as String
 566
 567    if ( IsMissing ( sXMLTag ) ) = TRUE then
 568       ssTag = "value"
 569    else
 570       ssTag = sXMLTag
 571    end if
 572
 573    for i=1 to ListCount ( lsList() )
 574       sInterim1 = sInterim1 + lsList(i)
 575    next i
 576
 577    sInterim = lCase ( sInterim1 )
 578
 579    if InStr ( sInterim, "<"+ ssTag +"/>" ) <> 0 then
 580       GetExtractXMLValueFromList = ""
 581    else
 582       iStart = InStr ( sInterim, "<" + ssTag + ">" )
 583       iEnd = InStr ( sInterim, "</" + ssTag + ">" )
 584       if iStart <> 0 AND iEnd <> 0 then
 585          if iStart + len(ssTag) + 2 = iEnd then
 586             GetExtractXMLValueFromList = ""
 587          else
 588             GetExtractXMLValueFromList = Mid ( sInterim1, iStart + len ( ssTag )+2, iEnd - iStart - len ( ssTag ) - 2 )
 589          end if
 590       end if
 591   end if
 592
 593   if ( IsMissing ( sXMLType ) ) = FALSE then
 594       sXMLType = lcase (sXMLType)
 595       ii = InStr ( sInterim, sXMLType + "=" )
 596       if ii = 0 then ii = InStr ( sInterim, sXMLType + " =" )
 597       if ii = 0 then ii = InStr ( sInterim, sXMLType + "  =" )
 598
 599       if ii = 0 then
 600          sXMLType = ""
 601       else
 602          for i=ii to len ( sInterim ) - ii
 603             if Mid ( sInterim, i, 1 ) = chr (34) then
 604                iStart=i
 605                i=1000
 606             end if
 607          next i
 608          for i=(iStart+1) to len ( sInterim ) - (iStart+1)
 609             if Mid ( sInterim, i, 1 ) = chr (34) then
 610                iEnd=i
 611                i=1000
 612             end if
 613          next i
 614          sXMLType = Mid ( sInterim1, iStart+1, iEnd-iStart-1 )
 615       end if
 616   end if
 617 end function
 618 '
 619 '-----------------------------------------------------------------------------
 620 '
 621 function hXMLSeekElementInTree ( sSeekThisNodeXML as STRING ) as BOOLEAN
 622          hXMLSeekElementInTree = FALSE
 623 ' Peter Junge: 2005-07-29
 624 '///<u><b>Recursion to find XML element</b></u>///
 625 '///Input: 'sSeekThisNodeXML' - XML element to seek, e.g. 'foo:bar'///
 626 '///(A XML DOM has to be loaded before)///
 627 '///Seek begins at current XML pointer///
 628 '///Return: TRUE if element was found, else FALSE///
 629 '///BEHAVIOUR: XML pointer is set to 'foo:bar' if found, if not XML pointer is reset to initial element///
 630 '///NOTE: Currently only the first appearence of 'foo:bar' is found.///
 631 '///NOTE: If e.g. the Nth element should be found you have to modify this function///
 632 '///NOTE: There should be further enhancements possible, e.g. find element with specific attribute///
 633     dim iIndex as INTEGER
 634     '///<ul><li>Check if current node matches 'sSeekThisNodeXML'</li>///
 635     if SAXGetElementName() = sSeekThisNodeXML then
 636         '///<li>MATCH: Function returns TRUE</li>///
 637         hXMLSeekElementInTree = TRUE
 638     else
 639         '///<li>NO MATCH: LOOKUP if current node has elements</li>///
 640         for iIndex = 1 to SAXGetChildCount()
 641             '///<li>-> (Loop) Set pointer on child</li>///
 642             SAXSeekElement ( iIndex )
 643             '///<li>-> Check if child is a XML element</li>///
 644             if SAXGetNodeType() = 556 then
 645                 '///<li>-> RECURSION: function recalls itself for current element</li>///
 646                 if hXMLSeekElementInTree ( sSeekThisNodeXML ) = TRUE then
 647                    '///<li>Don't forget to pass back the result TRUE to recursions parent</li>///
 648                    hXMLSeekElementInTree = TRUE
 649                    '///<li>Exit loop if found</li>///
 650                    Exit For
 651                 endif
 652              endif
 653              '///<li>NO MATCH: Go back to parent in DOM tree</li></ul>///
 654              SAXSeekElement( 0 )
 655         next iIndex
 656     endif
 657 end function
 658