FoxPress – Octubre 2005

Traspasa datos de DBF a FireBird (DBF2FB)

Por Dorin Vasilescu

Utilidad para transferir datos desde DBFs a FireFox:

 
PROCEDURE DBF2FB
PARAMETERS tcTable, tnConnHnd, tlAddData
*parameters: tcTable table name or full path
* tnConnHnd valid connection handle to Firebird database returned by SQLConnect()
* tlAddData transfer table data?
_t1=SECONDS()
LOCAL lcCreateTableSQL, lcCreateIndexSQL, lcDropTableSQL, lcInsertDataSQL, ;
 lcVFPTypes, lcFBTypes, lcOptions, lnFields, lnNDX
LOCAL ARRAY laVFPTypes[9], laFBTypes[9], laOptions[9]
 
USE (tcTable)
 
*types translation table
lcVFPTypes = 'C^D^L^M^N^F^I^B^Y^T'
lcFBTypes = 'CHAR^DATE^SMALLINT^BLOB SUB_TYPE TEXT^NUMERIC^FLOAT^INTEGER^DOUBLE PRECISION^NUMERIC^TIMESTAMP'
lcOptions = 'C^ ^ ^ ^N^N^ ^ ^N^ ^ '
lnFields = AFIELDS(laFlds)
ALINES(laVFPTypes,lcVFPTypes,.t.,'^')
ALINES(laFBTypes,lcFBTypes,.t.,'^')
ALINES(laOptions,lcOptions,.t.,'^')
tcTable = ALIAS() 
*build SQL statements
lcDropTableSQL = [DROP TABLE ]+tcTable 
 
SET TEXTMERGE on
SET TEXTMERGE TO memvar lcCreateTableSQL NOSHOW 
 
\\CREATE TABLE <<tcTable>> (
FOR i=1 TO lnFields
 IF i>1
 \\, 
 ENDIF
 lnFieldTypeRange = ASCAN(laVFPTypes, laFlds[i,2])
 IF !'getkey'$LOWER(laFlds[i,9])
 \\<<laFlds[i,1]>> <<laFBTypes[lnFieldTypeRange]>>
 ELSE
 \\<<laFlds[i,1]>> BIGINT 
 ENDIF  
 IF laOptions[lnFieldTypeRange] = 'N'
 \\(<<laFlds[i,3]>>,<<laFlds[i,4]>>)
 ENDIF
 IF laOptions[lnFieldTypeRange] = 'C'
 \\(<<laFlds[i,3]>>)
 ENDIF
 IF laFlds[i,5] = .f. and !(laFlds[i,2] = 'D' OR laFlds[i,2]='T')
 \\ NOT NULL 
 ENDIF
NEXT
\\)
SET TEXTMERGE to
SQLEXEC(tnConnHnd,lcDropTableSQL)
IF SQLEXEC(tnConnHnd,lcCreateTableSQL) < 0
 AERROR(laError)
 DISPLAY MEMORY LIKE laError
ENDIF
SQLCOMMIT(tnConnHnd)
*build and execute SQL statements to add data if third parameter is .T.
lcMemoConversion = ''
IF tlAddData=.t.
 z=0
 SET TEXTMERGE on
 SET TEXTMERGE TO memvar lcInsertDataSQL NOSHOW 
 \\INSERT INTO <<tcTable>> (
 FOR i=1 TO lnFields
 IF i>1
 \\, 
 ENDIF
 \\<<laFlds[i,1]>>
 NEXT
 \\) VALUES (
 FOR i=1 TO lnFields
 IF i>1
 \\, 
 ENDIF
 \\?m.<<laFlds[i,1]>>
 NEXT
 \\) 
 SET TEXTMERGE to
 SQLPREPARE(tnConnHnd,lcInsertDataSql)
 SCAN
 SCATTER MEMVAR 
 z=z+1
 FOR i=1 TO lnFields
 lcVarName = 'm.'+laFlds[i,1]
 DO case
 CASE TYPE(laFlds[i,1]) = 'L' &&logical type, need conversion
 &lcVarName = IIF(EVALUATE(laFlds[i,1]) = .T.,1,0)
 CASE TYPE(laFlds[i,1]) = 'D' AND EMPTY(EVALUATE(laFlds[i,1])) &&empty date, need conversion
 &lcVarName = '1900-01-01'
 CASE TYPE(laFlds[i,1]) = 'T' AND EMPTY(EVALUATE(laFlds[i,1])) &&empty datetime, need conversion
 &lcVarName = '1900-01-01 00:00:00'
 CASE TYPE(laFlds[i,1]) = 'M' AND EMPTY(EVALUATE(laFlds[i,1])) 
 &lcVarName = ''
 ENDCASE
 NEXT
 IF SQLEXEC(tnConnHnd) < 1
 CLEAR
 AERROR(xx)
 DISPLAY MEMORY LIKE xx
 ?'insert error'
 SUSPEND
 ENDIF
 IF MOD(z,100) = 0
 SET MESSAGE to STR(z)
 endif
 ENDSCAN
ENDIF
CLEAR
?
?SECONDS()-_t1
 
*build and execute SQL statements to create indexes
lnNDX = ATAGINFO(laIndexes)
FOR i=1 TO lnNDX
 lcIndexName = ALIAS()+'_'+laIndexes[i,1]
 IF laIndexes[i,2] = 'PRIMARY'
 lcCreateIndexSQL = [ALTER TABLE ]+tcTable+[ ADD PRIMARY KEY (]+laIndexes[i,3]+[)]
 ELSE 
 lcCreateIndexSQL = [CREATE INDEX ]+tcTable+[_]+ALLTRIM(STR(I))+[ ON ]+tcTable+[ (]+LaIndexes[i,3]+[)]
 ENDIF
 ?lcCreateIndexSQL
 
 SQLEXEC(tnConnHnd,lcCreateIndexSQL)
 SQLCOMMIT(tnConnHnd)
NEXT
 
RETURN

FoxPress – Octubre de 2005