/*
/ Dbf2Xml. Utilidad de conversion de ficheros DBF a XML
/ mediante transformacion XSL con salida HTML
/ (C) 2003. Joaquim Ferrer Godoy
/ Inicio: 16-07-2003 */
#define CRLF chr(13)+chr(10)
function main( cDbf, cXmlOut )
local aStruc, aNomFields
local nHandle
cXmlOut := If( cXmlOut = NIL, cDbf, cXmlOut )
if cDbf = NIL
? "Es necesario indicar el nombre del archivo DBF"
return( .f. )
endif
if !file( cDbf + ".dbf" )
? "No existe el archivo DBF especificado"
return( .f. )
endif
USE ( cDbf ) NEW ALIAS "_temp_"
//Obtener la lista de campos
aStruc := dbstruct()
aNomFields := {}
aeval( aStruc, {|a| aadd( aNomFields, a[1] ) } )
// Proceso de escritura del archivo de salida XML
? "Generando XML : " + cXmlOut
nHandle := fcreate( cXmlOut + ".xml" )
fwrite( nHandle, '<?xml version="1.0" encoding="ISO8859-1" ?>' + CRLF )
fwrite( nHandle, "<DATABASE>" + CRLF )
_temp_->( dbgotop() )
do while !_temp_->( eof() )
fwrite( nHandle, "<RECORD>" + CRLF )
aeval( aNomFields, {|cField, nPos| ;
fwrite( nHandle, "<" + cField + ">" +;
Val2Char( _temp_->( fieldget( nPos ) ) ) + ;
"</" + cField + ">" + CRLF ) } )
fwrite( nHandle, "</RECORD>" + CRLF )
_temp_->( dbskip() )
enddo
fwrite( nHandle, "</DATABASE>" + CRLF )
fclose( nHandle )
_temp_->( dbclosearea() )
// Proceso de escritura del archivo de salida XSL
// XSL realizara la transformacion del XML
? "Generando XSL : " + cXmlOut
nHandle := fcreate( cXmlOut + ".xsl" )
fwrite( nHandle, "<?xml version='1.0'?>" + CRLF )
fwrite( nHandle, '<xsl:stylesheet xmlns:xsl="http://www.w3.org/TR/WD-xsl">' + CRLF )
fwrite( nHandle, '<xsl:template match="/">' + CRLF )
fwrite( nHandle, '<html>' + CRLF )
fwrite( nHandle, '<body>' + CRLF )
fwrite( nHandle, '<table border="1" cellpadding="2" bgcolor="#f1f1f1" width="100%">' + CRLF )
fwrite( nHandle, '<tr>' + CRLF )
aeval( aNomFields, {|cField| ;
fwrite( nHandle, "<th>" + cField + "</th>" + CRLF ) } )
fwrite( nHandle, '</tr>' + CRLF )
fwrite( nHandle, '<xsl:for-each select="DATABASE/RECORD">' + CRLF )
fwrite( nHandle, '<tr>' + CRLF )
aeval( aNomFields, {|cField| ;
fwrite( nHandle, '<td><xsl:value-of select="' + ;
cField + '"/></td>' + CRLF ) } )
fwrite( nHandle, '</tr>' + CRLF )
fwrite( nHandle, '</xsl:for-each>' + CRLF )
fwrite( nHandle, '</table>' + CRLF )
fwrite( nHandle, '</body>' + CRLF )
fwrite( nHandle, '</html>' + CRLF )
fwrite( nHandle, '</xsl:template>' + CRLF )
fwrite( nHandle, '</xsl:stylesheet>' + CRLF )
fclose( nHandle )
// Proceso de escritura del archivo de salida HTML
? "Generando HTML: " + cXmlOut
nHandle := fcreate( cXmlOut + ".htm" )
fwrite( nHandle, '<html>' + CRLF )
fwrite( nHandle, '<head>' + CRLF )
fwrite( nHandle, '<title>Dbf2XML : ' + cXmlOut + '</title>' + CRLF )
fwrite( nHandle, '<style>' + CRLF )
fwrite( nHandle, 'TH{font-family:verdana;font-size:12px}' + CRLF )
fwrite( nHandle, 'TD{font-family:verdana;font-size:10px}' + CRLF )
fwrite( nHandle, '</style>' + CRLF )
fwrite( nHandle, '</head>' + CRLF )
fwrite( nHandle, '<body>' + CRLF )
fwrite( nHandle, '<script language="javascript">' + CRLF )
fwrite( nHandle, 'var xml = new ActiveXObject("Microsoft.XMLDOM")' + CRLF )
fwrite( nHandle, 'xml.async = false' + CRLF )
fwrite( nHandle, 'xml.load("' + cXmlOut + '.xml")' + CRLF )
fwrite( nHandle, 'var xsl = new ActiveXObject("Microsoft.XMLDOM")' + CRLF )
fwrite( nHandle, 'xsl.async = false' + CRLF )
fwrite( nHandle, 'xsl.load("' + cXmlOut + '.xsl")' + CRLF )
fwrite( nHandle, 'document.write(xml.transformNode(xsl))' + CRLF )
fwrite( nHandle, '</script>' + CRLF )
fwrite( nHandle, '</body>' + CRLF )
fwrite( nHandle, '</html>' + CRLF )
fclose( nHandle )
return( .t. )
//--------------------------------------------------------------------------//
static func Val2Char( uVar )
local cChar
local cType := valtype( uVar )
do case
case cType == "N"
cChar := rtrim( str( uVar ) )
case cType == "D"
cChar := dtos( uVar )
case cType == "L"
cChar := If( uVar, ".T.", ".F." )
otherwise
cChar := uVar // Caracter
endcase
return( rtrim( cChar ) )
FUNCTION MAIN()
LOCAL oStream, oRs
oStream = CREATEOBJECT( "ADODB.Stream" )
msgInfo( valtype( oStream ) ) // returns "O"
oStream:Open()
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: No registered users and 41 guests