Article ID: 191758
Article Last Modified on 6/29/2004
LOCAL lcFileName,lcXMLFile,lcFilter lcDBFName = HOME(2) + "data\orders.dbf" lcXMLFile = LOWER(SYS(2023)) + "\orders.xml" lcFilter = "FOR To_Region='WA'" STRTOFILE(DBF2XML(lcDBFName, lcFilter, .T.), ; lcXMLFile) MODIFY FILE (lcXMLFile) NOWAIT RETURN
* Dbf2xml.prg
*-- ASCII codes
#DEFINE TAB CHR(9)
#DEFINE LF CHR(10)
#DEFINE CR CHR(13)
#DEFINE CR_LF CR+LF
LPARAMETERS tcTable, tcScope, tnTabIndents
LOCAL lcTable, lcAlias, lcScope, lcDBFName, lcIndentText, lcDBF, lcRootName
LOCAL lcValue, lcField, lnFieldCount, lnCount, lnLastSelect, lnLastRecNo
LOCAL lcXMLText
DIMENSION laFields[1]
IF NOT INLIST(VARTYPE(tcTable), "C", "L") OR NOT ;
INLIST(VARTYPE(tcScope), "C", "L")
RETURN ""
ENDIF
lcIndentText = IIF(VARTYPE(tnTabIndents) == "N", ;
REPLICATE(TAB, tnTabIndents), "")
lcTable = LOWER(IIF(EMPTY(tcTable), ALIAS(), ALLTRIM(tcTable)))
lnLastSelect=SELECT()
IF "." $ lcTable
lcDBF = lcTable
IF NOT FILE(lcDBF)
RETURN ""
ENDIF
SELECT 0
lcAlias = LOWER(SYS(2015))
USE (lcDBF) ALIAS (lcAlias) AGAIN SHARED
lcDBFName = LOWER(FORCEEXT(JUSTFNAME(DBF()), ""))
ELSE
lcDBF = ""
lcAlias = lcTable
lcDBFName = lcAlias
ENDIF
IF NOT USED(lcAlias)
SELECT (lnLastSelect)
RETURN ""
ENDIF
lcScope = IIF(EMPTY(tcScope), "ALL", ALLTRIM(tcScope))
SELECT (lcAlias)
lnLastRecNo = IIF(EOF(), 0, RECNO())
lcXMLText = "<"+ lcDBFName + "_table>" + CR_LF
lnFieldCount = AFIELDS(laFields)
IF lnFieldCount = 0
SELECT (lnLastSelect)
RETURN ""
ENDIF
lcRootName = lcDBFName
DO WHILE TYPE(lcRootName) != "U"
lcRootName = lcRootName + "1"
ENDDO
SCAN &lcScope
lcXMLText = lcXMLText + lcIndentText + ;
"<" + lcRootName + ">" + CR_LF
FOR lnCount = 1 TO lnFieldCount
lcField = LOWER(laFields[lnCount, 1])
lcValue = ALLTRIM(TRANSFORM(EVALUATE(lcField)))
IF EMPTY(lcValue)
LOOP
ENDIF
lcXMLText=lcXMLText + lcIndentText + TAB + ;
"<" + lcField + ">" + lcValue + "</" + lcField + ">" + CR_LF
ENDFOR
lcXMLText = lcXMLText + lcIndentText + ;
"</" + lcRootName + ">" + CR_LF
ENDSCAN
IF EMPTY(lcDBF)
IF lnLastRecNo > 0
GO lnLastRecNo
ENDIF
ELSE
USE
ENDIF
SELECT (lnLastSelect)
lcXMLText = lcXMLText + CR_LF + "</"+ lcDBFName + "_table>"
RETURN lcXMLText
Keywords: kbhowto KB191758