* 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,[&],[&]) 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