diff options
Diffstat (limited to 'testautomation/global/tools/includes/optional/t_xml1.inc')
| -rw-r--r-- | testautomation/global/tools/includes/optional/t_xml1.inc | 652 |
1 files changed, 652 insertions, 0 deletions
diff --git a/testautomation/global/tools/includes/optional/t_xml1.inc b/testautomation/global/tools/includes/optional/t_xml1.inc new file mode 100644 index 000000000000..5afd05cbb22f --- /dev/null +++ b/testautomation/global/tools/includes/optional/t_xml1.inc @@ -0,0 +1,652 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +' DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +' +' Copyright 2000, 2010 Oracle and/or its affiliates. +' +' OpenOffice.org - a multi-platform office productivity suite +' +' 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@oracle.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 + |