FiveTech Software tech support forums

Code: Select all | Expand

STATIC Function DBF_TO_CSV( aFields_ )
LOCAL h, i, nFields, uData
LOCAL aFN_ := {}

BUILD_IDX() // build a defined index of the selected DBF

IF EMPTY(aFields_)
    nFields := len(aStruc[2])
    ASIZE(aFN_, nFields)
    FOR i := 1 to nFields
        aFN_[i] := i
    NEXT
ELSE
    nFields := len(aFields_)
    ASIZE(aFN_, nFields)
    FOR i := 1 to nFields
        aFN_[i] := (2)->( fieldpos(aFields_[i]) )
        IF aFN_[i] = 0 
            MsgAlert(  "Invalid field name: " + aFields_[i], "Error" )
            DBSELECTAREA( 2 )
            NET_CLOSE( 3, 3, .T.)
            DELETE FILE &cTMP
            aStruc[2] := {}
            AADD(aStruc[2], { "FIELD1", "C", 1, 0 }) 
            cTMP := cFilepath( cDBF ) + "_" + cFileNoExt( cDBF ) + ".dbf"
            DBCREATE( cTMP, aStruc[2] )
            RETURN(NIL)
        ENDIF      
    NEXT
ENDIF

h := FCREATE(cCSV, FC_NORMAL)
IF h = F_ERROR 
//  MsgAlert( "Failed to create CSV file " + cCSV + ": " + cFerror(), "Error" )
    RETURN(NIL)
ENDIF

MsgRun( "Working...", "CSV-Convert", { |oDlg1| DBF_CSV( aFN_, nFields, h ) } )

IF cShow = "Writer"
    IF FILE( cCSV )
        WAITRUN( c_path + "Angelwriter.exe" + " " + cCSV )
    ELSE
        MsgAlert( "Cannot load :" + CRLF + cCSV, "Missing CSV-file" )
    ENDIF
ENDIF

RETURN(NIL)

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

FUNCTION DBF_CSV( aFN_, nFields, h )
LOCAL cText, nLines := 0, nRecords := 0, I, F   

// MsgAlert( cDELIM, "Delimiter" )
// DBF_TO_CSV( cRDD, cDELIM, cDateFmt, cEOL, cHeader, cMemos, cLOGIC, aFields_ )

IF cHeader = "Yes"
    //#define DBS_NAME        1
    //#define DBS_TYPE        2
    //#define DBS_LEN         3
    //#define DBS_DEC         4
    cText := ""
    FOR i := 1 to nFields
        f := aFN_[I]
        IF cFieldsize = "Yes"
            cText += aStruc[2][F, DBS_NAME] + "-" + aStruc[2][F, DBS_TYPE] + ;
                                                "-" + ALLTRIM(STR(aStruc[2][F, DBS_LEN])) + ;
                                                "-" + ALLTRIM(STR(aStruc[2][F, DBS_DEC]))
        ELSE
            cText += aStruc[2][F, DBS_NAME] 
        ENDIF
        IF i < nFields
            cText += cDELIM // ","
        ENDIF
    NEXT
    FWRITE(h, cText + CRLF)
    nLines++
ENDIF

(2)->( DBGoTop() )
DO WHILE !(2)->( EOF() ) 
    IF INKEY() == K_ESC
        EXIT
    ENDIF
    FOR I := 1 to nFields
        F := aFN_[I]
        cText := ""
        uData := (2)->( FIELDGET(f) )
        DO CASE
            CASE aStruc[2][F, DBS_TYPE] == "C"
                IF cFTrim == "Yes"
                    cText := RTRIM(uData) // Enquote(RTRIM(uData))
                ELSE
                    cText := uData // Enquote(uData) 
                ENDIF
            CASE aStruc[2][F, DBS_TYPE] == "D"
                IF !EMPTY(uData)
                    cText := DTOC(uData)
                ENDIF
            CASE aStruc[2][F, DBS_TYPE] == "L"
                IF cLOGIC = "TRUE"
                    cText := IIF(uData, "TRUE", "FALSE")
                ELSEIF cLOGIC = "T"
                    cText := IIF(uData, "T", "F")
                ELSEIF cLOGIC = ".T."
                    cText := IIF(uData, ".T.", ".F.")
                ENDIF
            CASE aStruc[2][F, DBS_TYPE] == "M"
                IF cMemos = "Yes" .and. !EMPTY(uData)
                    ADDMEMO(uData, h, @cText, @nLines)
                ENDIF
            CASE aStruc[2][F, DBS_TYPE] == "N"
                IF cFTrim == "Yes"
                    cText := LTRIM(str(uData, aStruc[2][F, DBS_LEN], aStruc[2][F, DBS_DEC]))
                ELSE
                    cText := STR(uData, aStruc[2][f, DBS_LEN], aStruc[2][F, DBS_DEC] )
                ENDIF
        END CASE
        IF I < nFields
            FWRITE(h, cText + cDELIM ) // ",")
        ELSEIF !EMPTY(cText)
            FWRITE(h, cText)
        ENDIF
    NEXT
    FWRITE(h, CRLF)
    nLines++
    nRecords++
    (2)->( DBSkip() )
ENDDO

FCLOSE(h)

IF LASTKEY() == K_ESC
    MsgAlert( "Cancelled.  Output file is incomplete.", "Attention" )
ELSE
    MsgAlert(  LTRIM(STR(nLines)) + " lines written for " + LTRIM(STR(nRecords)) + " records." + CRLF + ;
    "Using Delimiter : < " + cDELIM + " >", "Attention" )
ENDIF

RETURN(NIL)

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

STATIC FUNCTION ADDMEMO( cMemo, h, cText, nLines )
LOCAL I, ILEN, A, Q, C
LOCAL cQUOTE := '"'
//LOCAL CRLF := chr(13) + chr(10)
LOCAL lMULTILINE := cEOL == ""  

// MEMO-single Line  Yes   cEOL := "\###", No   cEOL := "" Multiline 

cText += cQUOTE
      
Q := ASC(cQUOTE)
ILEN := LEN(cMemo)

//IF (2)->(ORDKEYNO()) < 2
//  MsgAlert( ILEN, "Record : " + ALLTRIM(STR( (2)->(ORDKEYNO() ) )) )
//ENDIF

I := 1
DO WHILE I <= ILEN 
    C := SUBSTR(cMemo, I, 1) // 1. Character
    A := ASC(C)
    // MsgAlert( A, "1. ASC :" + C )
    IF A == Q
        cText += cQUOTE + cQUOTE // Double literal quotes
    ELSEIF A == 13 .or. A == 10
        IF lMULTILINE // cEOL == "" 
            FWRITE(h, cText + CRLF)
            nLines++
            cText := ''
        ELSE
            cText += cEOL
        ENDIF
        IF A == 13 .and. I < ILEN // CRLF?
            IF ASC(SUBSTR(cMemo, I + 1, 1)) == 13 .or. ASC(SUBSTR(cMemo, I + 1, 1))  == 10
                I++
            endif
        ENDIF
    ELSEIF A == 141
        // Replace soft line breaks with a space if not already adjacent to one
        IF I > 1 .and. substr(cMemo, I - 1, 1) <> " "
            cText += " "
        ENDIF
    ELSE
        cText+= C  
    ENDIF
    I++
ENDDO

cText += cQuote

RETURN(NIL)