Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Best way to parse XML
Message
General information
Forum:
Visual FoxPro
Category:
XML, XSD
Environment versions
Visual FoxPro:
VFP 9 SP2
OS:
Vista
Network:
Windows 2008 Server
Database:
MS SQL Server
Miscellaneous
Thread ID:
01361685
Message ID:
01362624
Views:
35
>Hi everyone.
>
>I've never parsed an xml file using VFP.
>I'm downloading an xml file from a vendor. I need to know the best way to convert this xml file to DBF Data.
>
>Any suggestion would be helpful.
>
>Thanks.
* Call : "DO utDBFDOM with "MyAlias"
* DO utDBFDOM with cAliasName, transmitmemos,transmitautos
* PARAMETERS ucDBF,llIgnoreMemos,llIgnoreAutos
PARAMETERS ucDBF
PUBLIC lcUpdate
ON ERROR DO errhand WITH ERROR( ), MESSAGE( ), MESSAGE(1), PROGRAM( ), LINENO( )
?[START utDBFDOM: ]+TIME()
********************************************************************
** XML Packager - Builds vfp Replacement command,cursor structure **
** and XML Data roes                                              **
********************************************************************
llIgnoreMemos=.t. && Don't parse memos
llIgnoreAutos=.t. && Don't parse AutoIncrements
CLOSE DATABASES ALL 
* XML Store = the XML string will store in strXML
CREATE CURSOR curXML (strXML m)
* The File to be converted to an XML Packa
USE (ucDBF) IN 0
SELECT (ucDBF)
lcStructureHandle=SYS(2015)
lcdelStructureHandle=lcStructureHandle+[.*]
* There may be a better way to access the DBF header 
COPY STRUCTURE EXTENDED TO (lcStructureHandle)
USE (lcStructureHandle) IN 0
SELECT (lcStructureHandle)
IF llIgnoreMemos && Delete the memo fields from the structure
   DELETE ALL FOR ALLTRIM(field_type)$[G,M];
                  OR ALLTRIM(field_type)=[C] AND field_nocp
   PACK
ELSE 
ENDIF
IF llIgnoreAutos && Delete the memo fields from the structure
   DELETE ALL FOR ALLTRIM(field_type)$[I] AND field_next+field_step>0
   PACK
ELSE 
ENDIF
GO TOP 
* The cursor structure to be sent to the XML Receiver so that
* an EXECSCRIPT can create the cursors
lcTransmitStructure=[CREATE CURSOR curReceived (] 
* lcDBF_TO_XMLTags is used to convert the DBF being transmitted to
* a string for each record of field ptrs and values
lcDBF_TO_XMLTags=["<row>"]
* lcReplaceReceivedWith = will be used to update the cursor
* in the XML Receiver with the data inside the <row> tags
lcReplaceReceivedWith=[]
* Build the Transmit Cusor Structure, The DBF 2 XML Parser
DO WHILE !EOF() &&Create a cursor create string from passed alias
                && Alias structure
* Build cursor structure 
lcTransmitStructure=lcTransmitStructure;
                  +ALLTRIM(field_name)+[ ]+ALLTRIM(field_type)+[(];
                  +TRANSFORM(field_len)+IIF([B]$field_type,[)],[,]+TRANSFORM(field_dec)+[)])
* Build DBF To XML Parser
lcDBF_TO_XMLTags=lcDBF_TO_XMLTags;
                +[+"<F]+TRANSFORM(RECNO())+[>"+ALLTRIM(TRANSFORM(]+ALLTRIM(field_name)+[));
                +"</F]+TRANSFORM(RECNO())+[>"]
* Build Replacement String for curReceived
*lcReplaceReceivedWith=lcReplaceReceivedWith+ALLTRIM(field_name)+[ with ]
if ALLTRIM(field_type)$[YLFNBI]
   * use EVALUATE for logical and numeric
   lcFieldOp=[<F]+TRANSFORM(RECNO())+[>EVALUATE(oRow.childNodes(]+TRANSFORM(RECNO()-1)+[).text)]
ELSE 
if ALLTRIM(field_type)$[D]
   * CTOD for Date types
   lcFieldOp=[<F]+TRANSFORM(RECNO())+[>CTOD(oRow.childNodes(]+TRANSFORM(RECNO()-1)+[).text)]
ELSE
if ALLTRIM(field_type)$[T]
   * CTOT for date times
   lcFieldOp=[<F]+TRANSFORM(RECNO())+[>CTOT(oRow.childNodes(]+TRANSFORM(RECNO()-1)+[).text)]
ELSE
   * FOr all others just the text
   lcFieldOp=[<F]+TRANSFORM(RECNO())+[>oRow.childNodes(]+TRANSFORM(RECNO()-1)+[).text]
ENDIF &&ALLTRIM(field_type)$[T] // Else
ENDIF &&ALLTRIM(field_type)$[D]
ENDIF &&ALLTRIM(field_type)$[YLFNBI]
lcReplaceReceivedWith=lcReplaceReceivedWith+lcFieldOp+[</F]+TRANSFORM(RECNO())+[>]
SKIP
IF EOF()
   lcTransmitStructure=lcTransmitStructure+[)]
   lcDBF_TO_XMLTags=lcDBF_TO_XMLTags+[+"</row>"]
   lcReplaceReceivedWith=lcReplaceReceivedWith+[ IN curReceived]
ELSE
   lcTransmitStructure=lcTransmitStructure+[,]
   lcReplaceReceivedWith=lcReplaceReceivedWith+[,]
ENDIF
ENDDO
USE && close lcStructHandle
ERASE (lcdelStructureHandle)
lcXML=[<?xml version="1.0"?><dbf2xml>];
     +[<cursor>]+lcTransmitStructure+[</cursor>];
     +[<update>]+lcReplaceReceivedWith+[</update><rows>]
SELECT (ucDBF)
GO TOP 
?[START DBF TO XML: ]+TIME()
DO WHILE !EOF()
lcXML=lcXML+EVALUATE(lcDBF_TO_XMLTags)
SKIP
ENDDO
?[END DBF TO XML: ]+TIME()
lcXML=lcXML+[</rows></dbf2xml>]
SELECT curXML
APPEND BLANK
* Our XML string is in a memo/notes field. An XML Message
* (HTTP GET) can retrieve from a foxISAPI MTDLL or ASP
?[START Ampersand :]+TIME()
REPLACE strXML WITH STRTRAN(lcXML,[&],[&amp;]) IN curXML
?[END Ampersand :]+TIME()
* END OF PACKAGER
XML2Cursor(curXML.strXML)

********************************************************************
**  Receiver Method - Loads XML From Packager - Creates a cursor  **
**  And parses embedded Tags to cursor "curReceived" packaged in  **
** <cursor> tag with VFP statements in update Node                **
********************************************************************
PROCEDURE XML2Cursor(lcXML)
* the XML object
lcErrorHandler=ON('error')
ON ERROR oXML=.NULL.
oXML=CREATEOBJECT("MSXML2.DOMDocument.4.0") &&Try an implicit connect to 4.0
ON ERROR &lcErrorHandler
IF ISNULL(oXML) && Can't get 4.0
   oXML=CREATEOBJECT("MSXML.DOMDocument") && Generic
ENDIF 
oXML.async=.f.
oXML.setProperty("SelectionLanguage","XPath")
oXML.loadXML(lcXML)
lcCreateCursorScript=;
  oXML.selectSingleNode("dbf2xml").selectSingleNode("cursor").text
* Create a receiving Cursor  
EXECSCRIPT(lcCreateCursorScript)
* The EXECSCRIPT "replace" cmd line
lcUpdate=oXML.selectSingleNode("dbf2xml").selectSingleNode("update").text
* oRows has the records each in it's own <row> node
oRows=oXML.selectSingleNode("dbf2xml").selectSingleNode("rows")
nMaxRows=oRows.childNodes.length-1 && Assuming no empty cursor
nFieldCt=oRows.childNodes(0).childNodes.length-1
SELECT curReceived
DIMENSION arFieldValues[nFieldCt+1]
?[START APPEND XML TO curReceived: ]+TIME()
SET STEP ON 
FOR C=0 TO nMaxRows
oRow=oRows.childNodes(C)
FOR F=0 TO nFieldCt
arFieldValues[F+1]=EXECSCRIPT(oRow.childNodes(F).text)
ENDFOR &&F=0 TO nFieldCt
APPEND FROM ARRAY arFieldValues
ENDFOR &&C=0 TO nMaxRows
?[END APPEND XML TO curReceived: ]+TIME()
* Cursor Complete
?[END utDBFDOM : ]+TIME()
BROWSE && THe received Cursor

********************************************************************
**                           Error Procedure                      **
********************************************************************
PROCEDURE errhand (merror, mess, mess1, mprog, mlineno) &&----------
on error
if messagebox('Error number           :'+LTRIM(STR(merror))+chr(13);
              +'Error message          :'+ mess+chr(13);
              +'Line of code with error:'+mess1+chr(13);
              +'Line number of error   :'+LTRIM(STR(mlineno))+chr(13);
              +'Alias                  :'+alias()+chr(13);
              +'Order()                :'+Order()+chr(13);
              +'Program with error     :'+mprog,1+48,[R6 Tape Error Trapped!])=2
   CANCEL
else
   ON ERROR DO errhand WITH ERROR( ), MESSAGE( ), MESSAGE(1), PROGRAM( ), LINENO( )
endif
ENDPROC && errhand
Imagination is more important than knowledge
Previous
Reply
Map
View

Click here to load this message in the networking platform