try this CODE and use your "UMLOEM.DBF"
- Code: Select all Expand view
- #include "fivewin.ch"
#include "DBSTRUCT.CH"
#include "DrXlsx.ch"
* #define Use_OEM
#define Use_UTF8_Sign
REQUEST DBFCDX
*+--------------------------------------------------------------------
*+
*+ Function Main()
*+
*+--------------------------------------------------------------------
*+
FUNCTION Main( cDBF, cCodepage, cXLS )
LOCAL cLangCode := "DE"
DEFAULT cDBF := "TESTTYPE.DBF"
* DEFAULT cCodepage := "DE850"
DEFAULT cCodepage := "DEWIN"
DEFAULT cXLS := "DBF2EX.XLSX"
SET DATE GERMAN
SET EPOCH TO YEAR( DATE() ) - 50
SET CENTURY ON
SET DECIMALS TO 2
* hb_LangSelect( cLangCode )
* hb_cdpSelect( cCodepage )
* FW_SetUnicode( .T. )
UseDbf2Excel( cDBF, cCodepage, cXLS )
RETURN NIL
*+--------------------------------------------------------------------
*+
*+ Function UseDbf2Excel()
*+
*+ Called from ( xlswrite.prg ) 1 - function main()
*+
*+--------------------------------------------------------------------
*+
FUNCTION UseDbf2Excel( cDBF, cCodepage, cXLS )
LOCAL oXlsx := TDrXlsx() :New()
LOCAL aStruct, ii, iMax, nRow, nCol, nReccount, cText1, cText2
LOCAL xValue, cType, nStart, nStop, nRecSec, nTime, cName, nLen
LOCAL nOEM := 0
LOCAL nANSI := 0
LOCAL nELSE := 0
LOCAL nCount := 0
LOCAL lDiverse := .F.
LOCAL cFieldKDNR := ""
LOCAL nMemory
LOCAL nEvery
LOCAL nRecLast
IF !FILE( cDBF )
MsgInfo( "need DBF" )
ENDIF
IF FILE( "DBF2EX.XLSX" )
FERASE( "DBF2EX.XLSX" )
ENDIF
USE (cDBF) // CODEPAGE cCodepage EXCLUSIVE
aStruct := DBSTRUCT()
iMax := LEN( aStruct )
nReccount := RECCOUNT()
nEvery := INT( nReccount / 100 )
fwlog cDBF, nReccount, iMax
oXlsx:CreateFile( cXLS )
nRow := 0
FOR ii := 1 TO iMax
nCol := ii - 1
cName := aStruct[ ii ] [ DBS_NAME ]
nLen := aStruct[ ii ] [ DBS_LEN ] * 2
cType := aStruct[ ii ] [ DBS_TYPE ]
oXlsx:SetColumnSize( nRow, nCol, nLen )
oXlsx:Say( nRow, nCol, cName )
fwlog nCol, cType, nLen, cName
NEXT
nCol := 0
nRow := 1
nStart := SECONDS()
DO WHILE !EOF()
MEMORY( - 1 )
SysRefresh()
nMemory := MEMORY( 3 )
IF nMemory < 32000 // 32 kb
fwlog "Memory(3)", RECNO(), MEMORY( 3 )
EXIT
ENDIF
IF ( RECNO() % nEvery ) = 0
nCount ++
fwlog nCount, RECNO(), MEMORY( 3 )
ENDIF
ii := 1
FOR ii := 1 TO iMax
xValue := FIELDGET( ii )
cName := TRIM( aStruct[ ii ] [ DBS_NAME ] )
cType := TRIM( aStruct[ ii ] [ DBS_TYPE ] )
nCol := ii - 1
DO CASE
CASE cType = "C"
DO CASE
CASE ISOEM( xValue )
nOEM ++
// fwlog "ISOEM"
cText1 := Umlaute( xValue )
cText2 := CheckValue( cText1 )
IF !EMPTY( cText1 ) .AND. !EMPTY( cText2 )
oXlsx:Say( nRow, nCol, cText2 )
ENDIF
CASE ISANSI( xValue )
nANSI ++
// fwlog "ISANSI"
cText1 := Umlaute( xValue )
cText2 := CheckValue( cText1 )
IF !EMPTY( cText1 ) .AND. !EMPTY( cText2 )
oXlsx:Say( nRow, nCol, cText2 )
ENDIF
CASE IsUTF8( xValue )
fwlog "IsUTF8"
oXlsx:Say( nRow, nCol, xValue )
OTHERWISE
// fwlog "ELSE", xValue
nELSE ++
oXlsx:Say( nRow, nCol, xValue )
ENDCASE
CASE cType = "M"
#ifdef Use_Memo
cText1 := Umlaute( xValue )
cText2 := CheckValue( cText1 )
IF !EMPTY( cText2 )
oXlsx:WriteString( nRow, nCol, cText2 )
ENDIF
#endif
CASE cType = "N"
oXlsx:WriteNumber( nRow, nCol, xValue )
CASE cType = "D"
oXlsx:WriteDate( nRow, nCol, xValue, DRXLSX_ALIGN_CENTER, "dd.mm.yyyy" )
CASE cType = "L"
oXlsx:WriteLogical( nRow, nCol, xValue, DRXLSX_ALIGN_CENTER )
// CASE cType = "DT"
// oXlsx:Say(nRow,nCol,"Datetime format" )
// CASE cType = "D+"
// oXlsx:Say(nRow,nCol,"Datetime" )
ENDCASE
NEXT
SKIP
nRow ++
ENDDO
oXlsx:Close()
nStop := SECONDS()
nTime := ( nStop - nStart )
nRecLast := RECNO()
nRecSec := nRecLast / nTime
fwlog nReccount, nRecLast, nCount, nTime, nRecSec, nOEM, nANSI, nELSE
IF USED()
CLOSE
ENDIF
MEMORY( - 1 )
SysRefresh()
RETURN NIL
*+--------------------------------------------------------------------
*+
*+ Function Umlaute()
*+
*+ Called from ( xlswrite.prg ) 4 - function usedbf2excel()
*+
*+--------------------------------------------------------------------
*+
FUNCTION Umlaute( cIn, nNo )
LOCAL cText := TRIM( cIn )
LOCAL cTest1, cTest2
cTest1 := UTF16toUTF8( strToWide( UML_OEMTOANSI( cText ) ) )
#ifdef Use_UTF8_Sign
cText := STRTRAN( cText, CHR( 228 ), "ä" )
cText := STRTRAN( cText, CHR( 246 ), "ö" )
cText := STRTRAN( cText, CHR( 252 ), "ü" )
cText := STRTRAN( cText, CHR( 196 ), "Ä" )
cText := STRTRAN( cText, CHR( 214 ), "Ö" )
cText := STRTRAN( cText, CHR( 220 ), "Ü" )
cText := STRTRAN( cText, CHR( 223 ), "ß" )
#endif
cTest2 := cText
#ifdef Use_OEM
// OEM
cText := STRTRAN( cText, CHR( 132 ), "ä" )
cText := STRTRAN( cText, CHR( 148 ), "ö" )
cText := STRTRAN( cText, CHR( 129 ), "ü" )
cText := STRTRAN( cText, CHR( 142 ), "Ä" )
cText := STRTRAN( cText, CHR( 153 ), "Ö" )
cText := STRTRAN( cText, CHR( 154 ), "Ü" )
cText := STRTRAN( cText, CHR( 225 ), "ß" )
#endif
fwlog cText, cTest1, cTest2, cTest1 == cTest2
RETURN cText
*+--------------------------------------------------------------------
*+
*+ Function CheckValue()
*+
*+ Called from ( xlswrite.prg ) 4 - function usedbf2excel()
*+
*+--------------------------------------------------------------------
*+
FUNCTION CheckValue( xValue )
LOCAL lNoCheck := .F.
LOCAL cRet := ""
LOCAL aSign := "abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-+/.,:;!$%&/()=?#"
LOCAL cSign, ii, iMax, cLine := TRIM( xValue )
#ifdef Use_UTF8_Sign
aSign += "äöüÄÖÜß"
#endif
aSign += CHR( 34 )
IF lNoCheck = .T.
cRet := cLine
ELSE
iMax := LEN( cLine )
FOR ii := 1 TO iMax
cSign := SUBSTR( cLine, ii, 1 )
// IF AT(cSign,cLine) > 0
IF cSign $ aSign
cRet += cSign
ELSE
fwlog cSign, ASC( cSign ), cRet
cRet := ""
EXIT
ENDIF
NEXT
ENDIF
RETURN cRet
save as UTF8 Format
do you mean Sign > CHR(128)