FUNCTION DoImportNow( cHostName, cDatabase, cUser, cPassWord, cTable, cDbf )
LOCAL cQuery, i, iMax, nPosi
LOCAL oServer, oTable
LOCAL cField, cType, nLen, nReccount
LOCAL sType
LOCAL dType
LOCAL nHandle
LOCAL nStart, nStop, cLogFile
LOCAL lUseBlob, cPreText, cIns
LOCAL nLenStruc, nLenSum := 0
LOCAL aDbfStruct
LOCAL lCreateTable := .T.
LOCAL nEvery := 100
LOCAL nCount := 0
LOCAL lTruncate := .F.
LOCAL lUseTrans := .F.
LOCAL nBatchSize := 20
LOCAL nBatchhave := 0
LOCAL _cVia := "DBFCDX"
SbarText( "" )
SbarText( "Import DBF " + cDbf )
SbarText( "to" )
SbarText( "Hostname " + cHostName )
SbarText( "Catalog " + cDatabase )
SbarText( "Table " + cTable )
SbarText( "" )
lUseBlob := .F.
cLogFile := RTRIM( cTable ) + ".log"
// create log file
IF ( nHandle := FCREATE( cLogFile ) ) == F_ERROR
MsgInfo( "Cannot create log file" )
RETURN .F.
ENDIF
USE ( cDbf ) VIA TRIM(_cVia) ALIAS "IMPORT" EXCLUSIVE // CODEPAGE TRIM(_cCodepage)
aDbfStruct := DBSTRUCT()
nReccount := RECCOUNT()
oServer := TPQServer() :New( cHostName, cDatabase, cUser, cPassWord )
IF oServer:NetErr()
MsgInfo( oServer:ErrorMsg(), "TPQServer" )
RETURN .F.
ENDIF
oServer:lallCols := .F.
IF lCreateTable
IF oServer:TableExists( cTable )
oServer:DeleteTable( cTable )
IF oServer:NetErr()
MsgInfo( oServer:ErrorMsg(), "DeleteTable" )
FWRITE( nHandle, "Error: " + oServer:ErrorMsg() + hb_eol() )
FCLOSE( nHandle )
RETURN .F.
ENDIF
ENDIF
// oServer:CreateTable( cTable, aDbfStruct )
//
// "own" Way to include "internal" FIELD(s)
cQuery := "CREATE TABLE " + cTable + " ( "
SbarText( "Create Table " + cTable )
SbarText( "" )
iMax := LEN( aDbfStruct )
i = 1
FOR i = 1 TO iMax
nLenSum += aDbfStruct[ i ] [ DBS_LEN ]
cQuery += aDbfStruct[ i, DBS_NAME ]
SbarText( aDbfStruct[ i ] [ DBS_NAME ] )
DO CASE
CASE aDbfStruct[ i, DBS_TYPE ] = "C"
cQuery += " character(" + ALLTRIM( STR( aDbfStruct[ i, DBS_LEN ] ) ) + "), "
nLenSum += 4
CASE aDbfStruct[ i, DBS_TYPE ] = "N"
cQuery += " numeric(" + ALLTRIM( STR( aDbfStruct[ i, DBS_LEN ] ) ) + ',' + ALLTRIM( STR( aDbfStruct[ i, DBS_DEC ] ) ) + "), "
nLenSum += 2
CASE aDbfStruct[ i, DBS_TYPE ] = "D"
cQuery += " date, "
nLenSum += 4
CASE aDbfStruct[ i, DBS_TYPE ] = "M"
// IF lUseBlob = .T.
// cQuery += " bytea, "
// ELSE
cQuery += " text, "
// ENDIF
nLenSum += 4
CASE aDbfStruct[ i, DBS_TYPE ] = "L"
nLenSum += 8
cQuery += " boolean, "
CASE aDbfStruct[ i, DBS_TYPE ] = "V"
// store as HEX String
cQuery += " bytea, "
ENDCASE
NEXT
// add "internal" Xbase++ v2.x ISAM Emulation Fields
cQuery += " __deleted boolean NOT NULL DEFAULT false, "
cQuery += " __record serial NOT NULL, "
cQuery += " __rowversion integer NOT NULL DEFAULT 0, "
cQuery += " __keyversion integer NOT NULL DEFAULT 0, "
cQuery += " __lock_owner integer NOT NULL DEFAULT 0, "
IF nReccount * nLenSum < 4096
nBatchSize := 1
ENDIF
//
cQuery += " CONSTRAINT " + cTable + "_pkey PRIMARY KEY (__record)"
cQuery += " )"
oTable := oServer:Query( cQuery )
IF oServer:NetErr()
MsgInfo( oServer:ErrorMsg(), "CreateTable" )
FWRITE( nHandle, "Error: " + oServer:ErrorMsg() + hb_eol() )
FCLOSE( nHandle )
RETURN .F.
ENDIF
ENDIF
IF lTruncate
oServer:Execute( "truncate table " + cTable )
IF oServer:NetErr()
MsgInfo( oServer:ErrorMsg(), "truncate table" )
FWRITE( nHandle, "Error: " + oServer:ErrorMsg() + hb_eol() )
FCLOSE( nHandle )
RETURN .F.
ENDIF
ENDIF
i := 1
// SetProperty( "HbImport", "ProgressBar_1", "Value", 0 )
IF lUseTrans
oServer:StartTransaction()
ENDIF
SbarText( "Start: " + TIME() )
cPreText := "INSERT INTO " + cTable + " VALUES("
nEvery := INT( RECCOUNT() / 100 )
nStart := SECONDS()
DO WHILE !EOF()
nCount ++
lUseBlob := .F.
cIns := cPreText
i = 1
FOR i = 1 TO LEN( aDbfStruct )
cField := aDbfStruct[ i ] [ DBS_NAME ]
cType := aDbfStruct[ i ] [ DBS_TYPE ]
nLen := aDbfStruct[ i ] [ DBS_LEN ]
DO CASE
CASE aDbfStruct[ i, DBS_TYPE ] = "C"
cIns += " '" + STRTRAN( ALLTRIM( FIELDGET( i ) ), "'", '"' ) + "',"
CASE aDbfStruct[ i, DBS_TYPE ] = 'N'
cIns += " " + ALLTRIM( STR( FIELDGET( i ), aDbfStruct[ i, DBS_LEN ], aDbfStruct[ i, DBS_DEC ] ) ) + ","
CASE aDbfStruct[ i, DBS_TYPE ] = 'D'
IF EMPTY( FIELDGET( i ) )
cIns += " NULL,"
ELSE
cIns += " '" + DTOC( FIELDGET( i ) ) + "',"
ENDIF
CASE aDbfStruct[ i, DBS_TYPE ] = 'M'
// if you have Bitmap in Memo
IF lUseBlob = .T.
// cIns += " '\x" + cBin2Hex( FIELDGET( i ) ) + "',"
lUseBlob := .T.
ELSE
cIns += " '" + STRTRAN( FIELDGET( i ), "'", '"' ) + "',"
ENDIF
CASE aDbfStruct[ i, DBS_TYPE ] = "L"
cIns += " " + IF( FIELDGET( i ) = .T., "true, ", "false, " )
CASE aDbfStruct[ i, DBS_TYPE ] = "V"
// better use Type "V"
// cIns += " '\x" + cBin2Hex( FIELDGET( i ) ) + "',"
lUseBlob := .T.
ENDCASE
NEXT
// add "__deleted" default
cIns += "false," // "__deleted"
// use nextval() for Sequence !
cIns += "nextval('" + cTable + "___record_seq')" + "," // use nextval()
cIns += "0," // "__rowversion"
cIns += "0," // "__keyversion"
cIns += "0 " // "__lock_owner"
cIns += ")"
cIns += ";" + CRLF
* nBatchhave ++
* IF nBatchhave >= nBatchSize
* nBatchhave := 0
oTable := oServer:Query( cIns )
IF oServer:NetErr()
MsgInfo( oServer:ErrorMsg(), "INSERT Record" )
SbarText( "Error Record: " + STR( RECNO() ) + " " + LEFT( oTable:ErrorMsg(), 70 ) )
FWRITE( nHandle, "Error at record: " + hb_ntos( RECNO() ) + ;
" Description: " + cField + hb_eol() + ;
" Type " + cType + hb_eol() + ;
" Len " + STR( nLen ) + hb_eol() + ;
oTable:ErrorMsg() + hb_eol() )
FCLOSE( nHandle )
GO BOTTOM
ENDIF
// Reset
cIns := ""
* ELSE
* cIns += ";" + CRLF
* ENDIF
IF ( nCount % nEvery ) == 0
// nPosi := GetProperty( "HbImport", "ProgressBar_1", "Value" )
// SetProperty( "HbImport", "ProgressBar_1", "Value", nPosi + 1 )
// DO EVENTS
SysRefresh()
IF lUseTrans
oServer:commit()
oServer:StartTransaction()
ENDIF
ENDIF
// IF ::lAbort = .T.
// GO BOTTOM
// ENDIF
SKIP
ENDDO
* IF ( nCount % nEvery ) != 0
* IF lUseTrans
oServer:commit()
* ENDIF
* ENDIF
// SetProperty( "HbImport", "ProgressBar_1", "Value", 0 )
nStop := SECONDS()
SbarText( "" )
SbarText( "End: " + TIME() )
SbarText( "" )
SbarText( "records in dbf: " + hb_ntos( RECNO() ) )
SbarText( "imported recs: " + hb_ntos( nCount ) )
SbarText( "Sec " + Sec2HMS( nStop - nStart ) )
SbarText( "Rec/Sec " + hb_ntos( nCount / ( nStop - nStart ) ) )
SbarText( "" )
CLOSE
IF !EMPTY( nHandle )
FCLOSE( nHandle )
ENDIF
oTable:Destroy()
oServer:Destroy()
IF FILESIZE( cLogFile ) > 1
RUN ( "NOTEPAD.EXE " + cLogFile )
ELSE
FERASE( cLogFile )
ENDIF
RETURN .T.
PROCEDURE SbarText( cIn )
fwlog cIn
RETURN