Dbf2XML Version 1.0

[kapiaba]

//---------------------------------------------------------

// Dbf2XML Version 1.0

//

// This program converts a dbf file to xml file

// Author : Yamil Bracho, Caracas, Venezuela

//          brachoy@pdvsa.com

//

// Date   : Nov 2000

// Note   : Compile with /n

// Revised: 7/29/02 Added special character processing.

//                  Fixed a few bugs. James Bott. jbott@compuserve.com

//---------------------------------------------------------


#include "FiveWin.ch"

#include "FileIo.ch"


#define CRLF Chr( 13 ) + Chr( 10 )



FUNCTION Main( cDbf )

  LOCAL cFile

  LOCAL nPos


  IF cDbf == NIL

    ? "dbf2xml Ver.1.0"

    ? "Usage:dbf2xml <dbf_file>"

    QUIT

  ELSE

    cFile:= cDbf

    nPos     := At( ".dbf", cFile )

    IF nPos == 0

      cFile := cFile + ".dbf"

    ENDIF


    IF File( cFile ) == .F.

      ? cFile + " does not exist."

      QUIT

    ELSE

      GenXML( cFile )

      ? "Converted to XML"

    ENDIF

  ENDIF


RETURN NIL




//---------------------------------------------------------

// Generates the file

//---------------------------------------------------------

STATIC FUNCTION GenXML( cDbf )

  LOCAL aFields

  LOCAL cBuffer

  LOCAL cFile

  LOCAL cValue

  LOCAL cTable

  LOCAL nHandle

  LOCAL nFields

  LOCAL nField

  LOCAL nPos


  cDBF   := lower(cDBF)

  cFile  := StrTran( cDbf, ".dbf", ".xml" )

  cTable := Left( cDbf, At( ".", cDbf ) - 1 )


  USE (cDbf)

  nHandle := fCreate( cFile, FC_NORMAL )


  //------------------

  // Writes XML header

  //------------------

  fWrite( nHandle, [<?xml version="1.0"?>] + CRLF )

  fWrite( nHandle, Space( 0 ) + "<"  + cDbf + ">" + CRLF )


  nFields := fCount()

  aFields := dbStruct()


  DO WHILE .NOT. Eof()

    cBuffer := Space( 2 ) + "<" + cTable + ">"  + CRLF

    fWrite( nHandle, cBuffer )


    FOR nField := 1 TO nFields


       //-------------------

       // Beginning Record Tag

       //-------------------


       cBuffer:= Space( 4 ) + "<" + FieldName( nField ) + ">"


       DO CASE

         CASE aFields[nField, 2] == "D"

           cValue := Dtos( FieldGet( nField ))


         CASE aFields[nField, 2] == "N"

           cValue := Str( FieldGet( nField ))


         CASE aFields[nField, 2] == "L"

           cValue := If( FieldGet( nField ), "True", "False" )


         OTHERWISE

           cValue := FieldGet( nField )

       ENDCASE


       //--- Convert special characters

       cValue:= strTran(cValue,"&","&")

       cValue:= strTran(cValue,"<","<")

       cValue:= strTran(cValue,">",">")

       cValue:= strTran(cValue,"'","'")

       cValue:= strTran(cValue,["],["])


       cBuffer := cBuffer             + ;

                  Alltrim( cValue )   + ;

                  "</"                + ;

                  FieldName( nField ) + ;

                  ">"                 + ;

                  CRLF


       fWrite( nHandle, cBuffer )

    NEXT nField


    //------------------

    // Ending Record Tag

    //------------------

    fWrite( nHandle, Space( 2 ) + "</" + cTable + ">"  + CRLF )

    SKIP

  ENDDO


  dbCloseAll()

  fWrite( nHandle, Space(0) + "</" + cDbf + ">" + CRLF )

  fClose( nHandle )

RETURN NIL


// eof

[kleyber]

Kapi,

Interessante... vou fazer uns testes aqui... valeu!!!

[rochinha]

Amiguinhos,

Este código é de 2000, será que funciona nos dias de hoje, ka, ka, ka.

Funciona sim, só de olhar.