Hola
Existe alguna funcion o pgrama que permita tomar tablas de MS-SQL y exportarlas como DBF ?
Gracias
DEFAULT cSql := [ select * from ORA.name ]
lResult := ::Traspasa_Oracle( cSql ,; // Sentencia SQL
"FINAME",; // Tabla DBF que vamos a crear
"NAME", ::lInfo ) // Tabla Orable
METHOD Traspasa_Oracle( cSql , cFileDbf, cTableSQL, lInfo ) CLASS TareasSQL
Local oSql, oTdbf, oDbIntermedia, n := 1
Local nTotalRegistros, x, nLen
Local aStruct := {} // Estructura de la dbf
Local hTabla := {=>}, cname, ctype, nLenField, ndec, uValue
Local lReturn := .F., oError
::SetText( CRLF+ "Sentencia:" + cSql + CRLF )
oSql := tAdoRs():New():Create()
try
if !oSql:Open( cSql, ::oConnection:oConnection, adOpenDynamic )
oTDbf:Close()
? "No se pudo ejecutar select"
lReturn := .T.
endif
catch
oTDbf:Close()
? "No se pudo ejecutar select"
lReturn := .T.
end
if lReturn // retorno por error.
return .f.
endif
oDbIntermedia:SetBuffer( .T. )
oDbIntermedia:lOemAnsi := .T.
nTotalRegistros := oSql:oRs:RecordCount
::SetText( "Comenzando transaccion para " + alltrim( str( nTotalRegistros,12 )) + " registros." )
nLen := oSql:oRs:fields:Count - 1
for x := 0 to nLen
ADO_FIELDINFO( oSql:oRs, x, DBS_NAME, @cName )
ADO_FIELDINFO( oSql:oRs, x, DBS_TYPE, @cType )
ADO_FIELDINFO( oSql:oRs, x, DBS_LEN, @nLenField )
ADO_FIELDINFO( oSql:oRs, x, DBS_DEC, @nDec )
// Guarda la referencia del campo
if lInfo
::SetText( "Name:"+ cName + " Clipper:" + Get_Name_Clipper( cName, hTabla ) )
endif
hTabla[ cName ] := Get_Name_Clipper( cName, hTabla )
oDbIntermedia:Append()
oDbIntermedia:Blank()
oDbIntermedia:Table_SQL := cTableSQL
oDbIntermedia:Table_DBF := cFileDbf
oDbIntermedia:Field_SQL := cName
oDbIntermedia:Field_DBF := hTabla[ cName ]
oDbIntermedia:Save()
if lInfo
::SetText( "SQL:"+ cName + ;
" DBF:" + hTabla[ cName ] + "[ "+ cType + "*" + cValtoChar( nlenField ) + "*" + cValtoChar( nDec ) + " ]" )
endif
if "V" $ cType // Tipo Variant, vamos a tratarlo como Caracter
cType := "C"
endif
if "@" $ cType
cType := "D"
nLenField := 8
endif
if "M" $ cType // MEMO
nLenField := 10
endif
if "N" $ cType // No sabemos que tipo de longitud decimal va a tener
if nDec = 0
nDec := 10
nLenField += 10 + 2 // porque tenemos que tener en cuenta el . decimal , y el signo negativo( si lo fuese )
else
nLenField += 2 // Le add 2 numeros mas por si acaso
endif
endif
if cType = "G" // Los tipo G no se guardan
// loop
cType := "C"
nLenField := 50
endif
AADD( aStruct, { hTabla[ cName ], cType, nLenField, nDec } )
next x
if !empty( aStruct )
::SetText( "Creando estructura "+ cFileDbf )
if file( cFileDbf + ".DBF" )
delete file ( cFileDbf +".dbf" )
endif
DbCreate( cFileDbf, aStruct )
endif
if nTotalRegistros = 0
::SetText( "No hay registros a traspasar." )
oTDbf:Close()
return .t.
endif
::SetText( "Comenzando exportanción de datos a " + cFileDbf )
USE ( cFileDbf ) NEW ALIAS ( cFileDbf )
oSql:oRs:MoveFirst()
while !oSql:oRs:Eof()
APPEND BLANK
// Guardamos el contenido de lo campos por regsitro
for x := 0 to nLen
ADO_FIELDINFO( oSql:oRs, x, DBS_NAME, @cName )
ADO_FIELDINFO( oSql:oRs, x, DBS_TYPE, @cType )
ADO_FIELDINFO( oSql:oRs, x, DBS_DEC, @nDec )
if "@" $ cType
try
uValue := oSql:oRs:fields(x):value
catch
uValue := ""
::SetText( "ATENCION registro Dbf[ " + alltrim( cStr( recno() ) ) + " ] NAME_ID:" + CStr( cName ) + " Campo: " + cName + "--> Valor por defecto" )
end
if empty( uValue )
uValue := CTOD( " / / " )
else
uValue := CTOD( TtoC( oSql:oRs:fields(x):value ) )
endif
elseif "N" $ cType
if empty( oSql:oRs:fields(x):value ) // Si es null
uValue := 0
else
uValue := oSql:oRs:fields(x):value
endif
elseif "C" $ cType .or. "M" $ cType .or. "V" $ cType
uValue := hb_AnsiToOem( cvaltoChar( oSql:oRs:fields(x):value ) )
elseif "L" $ cType
uValue := oSql:oRs:fields(x):value
elseif "G" $ cType
// uValue := "TIPO BINARIO"
// loop
uValue := hb_AnsiToOem( cvaltoChar( oSql:oRs:fields(x):value ) )
else
::SetText( "Registro DBF:"+ CStr( Recno() ) + "ATENCION DE TIPOS:( " + CStr( FieldPos( hTabla[ cName ] ) ) + " ) "+ hTabla[ cName ] + "-->"+ cvaltoChar( uValue ) + " valtype:" + Valtype( uvalue ) + " type:" + ctype )
loop
endif
try
fieldput( FieldPos( hTabla[ cName ] ), uValue )
catch oError
::SetText( "DBF:"+ hTabla[ cName ] + " Registro DBF:"+ CStr( Recno() ) + "Error:" + oError:Description )
end
next
oSql:oRs:MoveNext()
end while
CLOSE
oDbIntermedia:Close()
STATIC FUNCTION Get_Name_Clipper( cName, hTabla )
Local cTmp := substr( strtran( cName, "_",""), 1, 9 )
Local x , nCaracter := 65
Local cShortName
cTmp := substr( strtran( cTmp, " ",""), 1, 9 )
cTmp := substr( strtran( cTmp, "ñ","n"), 1, 9 )
cTmp := substr( strtran( cTmp, "Ñ","N"), 1, 9 )
cTmp := substr( strtran( cTmp, "ç","c"), 1, 9 )
cTmp := substr( strtran( cTmp, "Ç","C"), 1, 9 )
cTmp := substr( strtran( cTmp, "(",""), 1, 9 )
cTmp := substr( strtran( cTmp, ")",""), 1, 9 )
cTmp := substr( strtran( cTmp, "%",""), 1, 9 )
cTmp := substr( strtran( cTmp, "º",""), 1, 9 )
cTmp := substr( strtran( cTmp, "ª",""), 1, 9 )
cTmp := substr( strtran( cTmp, "â","a"), 1, 9 )
cTmp := substr( strtran( cTmp, "ê","e"), 1, 9 )
cTmp := substr( strtran( cTmp, "î","i"), 1, 9 )
cTmp := substr( strtran( cTmp, "ô","o"), 1, 9 )
cTmp := substr( strtran( cTmp, "û","u"), 1, 9 )
cTmp := substr( strtran( cTmp, "ä","a"), 1, 9 )
cTmp := substr( strtran( cTmp, "ë","e"), 1, 9 )
cTmp := substr( strtran( cTmp, "ï","i"), 1, 9 )
cTmp := substr( strtran( cTmp, "ö","o"), 1, 9 )
cTmp := substr( strtran( cTmp, "ü","u"), 1, 9 )
cShortName := ctmp // Impresionante , a veces, vienen CAMPOS con espacios en blanco
while .t.
x := HSCAN( hTabla, cShortName, NIL , NIL, .T. ) // Busca EXACTAMENTE
if x > 0
cShortName := cTmp + chr( nCaracter )
else
exit // No existe, la usaremos
endif
nCaracter++
end
RETURN cShortName
STATIC FUNCTION ADO_FIELDINFO( oRecordSet, nField, nInfoType, uInfo )
LOCAL nType, nLen
LOCAL nResult := .T.
DO CASE
CASE nInfoType == DBS_NAME
uInfo := oRecordSet:Fields( nField ):Name
uInfo := strtran( uInfo ,"Á" , "A")
uInfo := strtran( uInfo ,"É" , "E")
uInfo := strtran( uInfo ,"Í" , "I")
uInfo := strtran( uInfo ,"Ó" , "O")
uInfo := strtran( uInfo ,"Ú" , "U")
uInfo := strtran( uInfo ,"À" , "A")
uInfo := strtran( uInfo ,"È" , "E")
uInfo := strtran( uInfo ,"Ì" , "I")
uInfo := strtran( uInfo ,"Ò" , "O")
uInfo := strtran( uInfo ,"Ù" , "U")
uInfo := strtran( uInfo ,"á" , "a")
uInfo := strtran( uInfo ,"é" , "a")
uInfo := strtran( uInfo ,"í" , "i")
uInfo := strtran( uInfo ,"ó" , "o")
uInfo := strtran( uInfo ,"ú" , "u")
uInfo := strtran( uInfo ,"à" , "a")
uInfo := strtran( uInfo ,"è" , "a")
uInfo := strtran( uInfo ,"ì" , "i")
uInfo := strtran( uInfo ,"ò" , "o")
uInfo := strtran( uInfo ,"ù" , "u")
uInfo := strtran( uInfo ,"-" , "")
uInfo := strtran( uInfo ,"%" , "")
uInfo := strtran( uInfo ,"/" , "")
uInfo := strtran( uInfo ," " , "")
uInfo := strtran( uInfo ,"Ñ" , "N")
uInfo := strtran( uInfo ,"ä" , "a")
uInfo := strtran( uInfo ,"ë" , "e")
uInfo := strtran( uInfo ,"ï" , "i")
uInfo := strtran( uInfo ,"ö" , "o")
uInfo := strtran( uInfo ,"ü" , "u")
uInfo := strtran( uInfo ,"Ä" , "A")
uInfo := strtran( uInfo ,"Ë" , "E")
uInfo := strtran( uInfo ,"Ï" , "I")
uInfo := strtran( uInfo ,"Ö" , "O")
uInfo := strtran( uInfo ,"Ü" , "U")
CASE nInfoType == DBS_TYPE
nType := ADO_GETFIELDTYPE( oRecordSet:Fields( nField ):Type )
DO CASE
CASE nType == HB_FT_STRING
uInfo := "C"
CASE nType == HB_FT_LOGICAL
uInfo := "L"
CASE nType == HB_FT_MEMO
uInfo := "M"
CASE nType == HB_FT_OLE
uInfo := "G"
CASE nType == HB_FT_PICTURE
uInfo := "P"
CASE nType == HB_FT_ANY
uInfo := "V"
CASE nType == HB_FT_DATE
uInfo := "D"
CASE nType == HB_FT_DATETIME
uInfo := "T"
CASE nType == HB_FT_TIMESTAMP
uInfo := "@"
CASE nType == HB_FT_LONG
uInfo := "N"
CASE nType == HB_FT_INTEGER
uInfo := "N"
CASE nType == HB_FT_DOUBLE
uInfo := "N"
OTHERWISE
uInfo := "U"
ENDCASE
CASE nInfoType == DBS_LEN
ADO_FIELDINFO( oRecordSet, nField, DBS_TYPE, @nType )
IF nType == 'N'
nLen := oRecordSet:Fields( nField ):Precision
if nLen > 100
nLen := 100
endif
ELSE
nLen := oRecordSet:Fields( nField ):DefinedSize
ENDIF
// Un campo mayor de 1024 lo consideramos un campo memo..
// CARACTER de 200
uInfo := If( nLen > 1024, 600, nLen )
CASE nInfoType == DBS_DEC
ADO_FIELDINFO( oRecordSet, nField, DBS_LEN, @nLen )
ADO_FIELDINFO( oRecordSet, nField, DBS_TYPE, @nType )
IF oRecordSet:Fields( nField ):Type == adInteger
uInfo := 0
ELSEIF nType == 'N'
uInfo := Min( Max( 0, nLen - 1 - oRecordSet:Fields( nField ):DefinedSize ), 15 )
ELSE
uInfo := 0
ENDIF
CASE nInfoType == DBS_FLAG
uInfo := 0
CASE nInfoType == DBS_STEP
uInfo := 0
OTHERWISE
RETURN .F.
ENDCASE
RETURN .T.
STATIC FUNCTION ADO_GETFIELDTYPE( nADOFieldType )
LOCAL nDBFFieldType := 0
DO CASE
CASE nADOFieldType == adEmpty
CASE nADOFieldType == adTinyInt
nDBFFieldType := HB_FT_INTEGER
CASE nADOFieldType == adSmallInt
nDBFFieldType := HB_FT_INTEGER
CASE nADOFieldType == adInteger
nDBFFieldType := HB_FT_INTEGER
CASE nADOFieldType == adBigInt
nDBFFieldType := HB_FT_INTEGER
CASE nADOFieldType == adUnsignedTinyInt
nDBFFieldType := HB_FT_INTEGER
CASE nADOFieldType == adUnsignedSmallInt
nDBFFieldType := HB_FT_INTEGER
CASE nADOFieldType == adUnsignedInt
nDBFFieldType := HB_FT_INTEGER
CASE nADOFieldType == adUnsignedBigInt
nDBFFieldType := HB_FT_INTEGER
CASE nADOFieldType == adSingle
nDBFFieldType := HB_FT_INTEGER
CASE nADOFieldType == adDouble
nDBFFieldType := HB_FT_DOUBLE
CASE nADOFieldType == adCurrency
nDBFFieldType := HB_FT_INTEGER
CASE nADOFieldType == adDecimal
nDBFFieldType := HB_FT_LONG
CASE nADOFieldType == adNumeric
nDBFFieldType := HB_FT_LONG
CASE nADOFieldType == adError
CASE nADOFieldType == adUserDefined
CASE nADOFieldType == adVariant
nDBFFieldType := HB_FT_ANY
CASE nADOFieldType == adIDispatch
CASE nADOFieldType == adIUnknown
CASE nADOFieldType == adGUID
nDBFFieldType := HB_FT_STRING
CASE nADOFieldType == adDate
nDBFFieldType := HB_FT_DATETIME
CASE nADOFieldType == adDBDate
nDBFFieldType := HB_FT_DATETIME
CASE nADOFieldType == adDBTime
CASE nADOFieldType == adDBTimeStamp
nDBFFieldType := HB_FT_TIMESTAMP
CASE nADOFieldType == adFileTime
nDBFFieldType := HB_FT_DATETIME
CASE nADOFieldType == adBSTR
nDBFFieldType := HB_FT_STRING
CASE nADOFieldType == adChar
nDBFFieldType := HB_FT_STRING
CASE nADOFieldType == adVarChar
nDBFFieldType := HB_FT_STRING
CASE nADOFieldType == adLongVarChar
nDBFFieldType := HB_FT_STRING
CASE nADOFieldType == adWChar
nDBFFieldType := HB_FT_STRING
CASE nADOFieldType == adVarWChar
nDBFFieldType := HB_FT_STRING
CASE nADOFieldType == adBinary
nDBFFieldType := HB_FT_OLE
CASE nADOFieldType == adVarBinary
nDBFFieldType := HB_FT_OLE
CASE nADOFieldType == adLongVarBinary
nDBFFieldType := HB_FT_OLE
CASE nADOFieldType == adChapter
CASE nADOFieldType == adVarNumeric
nDBFFieldType := HB_FT_INTEGER
// case nADOFieldType == adArray
CASE nADOFieldType == adBoolean
nDBFFieldType := HB_FT_LOGICAL
CASE nADOFieldType == adLongVarWChar
nDBFFieldType := HB_FT_MEMO
CASE nADOFieldType == adPropVariant
nDBFFieldType := HB_FT_MEMO
ENDCASE
RETURN nDBFFieldType
//--------------------DEFINES ----------------------------------------
// Para el método Open de Connection. Modo apertura.
#define adAsyncConnect 16
#define adConnectUnspecified -1
// Donde colocamos el cursor ADO??
#define adUseClient 3
#define adUseNone 1
#define adUseServer 2
// Tipos de Cursores
#define adOpenDynamic 2
#define adOpenForwardOnly 0
#define adOpenKeyset 1
#define adOpenStatic 3
#define adOpenUnspecified -1
// Tipos de bloqueos
#define adLockBatchOptimistic 4
#define adLockOptimistic 3
#define adLockPessimistic 2
#define adLockReadOnly 1
#define adLockUnspecified -1
// Tipos de comandos
#define adCmdUnspecified -1
#define adCmdText 1
#define adCmdTable 2
#define adCmdStoredProc 4
#define adCmdUnknown 8
#define adCmdFile 256
#define adCmdTableDirect 512
// Tipos de ejecuciones
#define adAsyncExecute 0x10 Indicates that the command should execute asynchronously.
#define adAsyncFetch 0x20 Indicates that the remaining rows after the initial quantity specified in the CacheSize property should be retrieved asynchronously.
#define adAsyncFetchNonBlocking 0x40 Indicates that the main thread never blocks while retrieving. If the requested row has not been retrieved, the current row automatically moves to the end of the file.
#define adExecuteNoRecords 0x80 Indicates that the command text is a command or stored procedure that does not return rows (for example, a command that only inserts data). If any rows are retrieved, they are discarded and not returned.
#define adExecuteStream 0x400 Indicates that the results of a command execution should be returned as a stream.
#define adExecuteRecord
#define adOptionUnspecified -1
#define adBigInt 20 // Indicates an eight-byte signed integer (DBTYPE_I8).
#define adBinary 128 // Indicates a binary value (DBTYPE_BYTES).
#define adBoolean 11 // Indicates a boolean value (DBTYPE_BOOL).
#define adBSTR 8 // Indicates a null-terminated character string (Unicode) (DBTYPE_BSTR).
#define adChapter 136 // Indicates a four-byte chapter value that identifies rows in a child rowset (DBTYPE_HCHAPTER).
#define adChar 129 // Indicates a string value (DBTYPE_STR).
#define adCurrency 6 // Indicates a currency value (DBTYPE_CY). Currency is a fixed-point number with four digits to the right of the decimal point. It is stored in an eight-byte signed integer scaled by 10,000.
#define adDate 7 // Indicates a date value (DBTYPE_DATE). A date is stored as a double, the whole part of which is the number of days since December 30, 1899, and the fractional part of which is the fraction of a day.
#define adDBDate 133 // Indicates a date value (yyyymmdd) (DBTYPE_DBDATE).
#define adDBTime 134 // Indicates a time value (hhmmss) (DBTYPE_DBTIME).
#define adDBTimeStamp 135 // Indicates a date/time stamp (yyyymmddhhmmss plus a fraction in billionths) (DBTYPE_DBTIMESTAMP).
#define adDecimal 14 // Indicates an exact numeric value with a fixed precision and scale (DBTYPE_DECIMAL).
#define adDouble 5 // Indicates a double-precision floating-point value (DBTYPE_R8).
#define adEmpty 0 // Specifies no value (DBTYPE_EMPTY).
#define adError 10 // Indicates a 32-bit error code (DBTYPE_ERROR).
#define adFileTime 64 // Indicates a 64-bit value representing the number of 100-nanosecond intervals since January 1, 1601 (DBTYPE_FILETIME).
#define adGUID 72 // Indicates a globally unique identifier (GUID) (DBTYPE_GUID).
#define adIDispatch 9 // Indicates a pointer to an IDispatch interface on a COM object (DBTYPE_IDISPATCH).
#define adInteger 3 // Indicates a four-byte signed integer (DBTYPE_I4).
#define adIUnknown 13 // Indicates a pointer to an IUnknown interface on a COM object (DBTYPE_IUNKNOWN).
#define adLongVarBinary 205 // Indicates a long binary value.
#define adLongVarChar 201 // Indicates a long string value.
#define adLongVarWChar 203 // Indicates a long null-terminated Unicode string value.
#define adNumeric 131 // Indicates an exact numeric value with a fixed precision and scale (DBTYPE_NUMERIC).
#define adPropVariant 138 // Indicates an Automation PROPVARIANT (DBTYPE_PROP_VARIANT).
#define adSingle 4 // Indicates a single-precision floating-point value (DBTYPE_R4).
#define adSmallInt 2 // Indicates a two-byte signed integer (DBTYPE_I2).
#define adTinyInt 16 // Indicates a one-byte signed integer (DBTYPE_I1).
#define adUnsignedBigInt 21 // Indicates an eight-byte unsigned integer (DBTYPE_UI8).
#define adUnsignedInt 19 // Indicates a four-byte unsigned integer (DBTYPE_UI4).
#define adUnsignedSmallInt 18 // Indicates a two-byte unsigned integer (DBTYPE_UI2).
#define adUnsignedTinyInt 17 // Indicates a one-byte unsigned integer (DBTYPE_UI1).
#define adUserDefined 132 // Indicates a user-defined variable (DBTYPE_UDT).
#define adVarBinary 204 // Indicates a binary value (Parameter object only).
#define adVarChar 200 // Indicates a string value.
#define adVariant 12 // Indicates an Automation Variant (DBTYPE_VARIANT).
#define adVarNumeric 139 // Indicates a numeric value (Parameter object only).
#define adVarWChar 202 // Indicates a null-terminated Unicode character string.
#define adWChar 130 // Indicates a null-terminated Unicode character string (DBTYPE_WSTR).
#define adParamInput 1 // Default. Indicates that the parameter represents an input parameter.
#define adParamInputOutput 3 // Indicates that the parameter represents both an input and output parameter.
#define adParamOutput 2 // Indicates that the parameter represents an output parameter.
#define adParamReturnValue 4 // Indicates that the parameter represents a return value.
#define adParamUnknown 0 // Indicates that the parameter direction is unknown.
#define HB_FT_NONE 0
#define HB_FT_STRING 1 /* "C" */
#define HB_FT_LOGICAL 2 /* "L" */
#define HB_FT_DATE 3 /* "D" */
#define HB_FT_LONG 4 /* "N" */
#define HB_FT_FLOAT 5 /* "F" */
#define HB_FT_INTEGER 6 /* "I" */
#define HB_FT_DOUBLE 7 /* "B" */
#define HB_FT_DATETIME 8 /* "T" */
#define HB_FT_TIMESTAMP 9 /* "@" */
#define HB_FT_MODTIME 10 /* "=" */
#define HB_FT_ROWVER 11 /* "^" */
#define HB_FT_AUTOINC 12 /* "+" */
#define HB_FT_CURRENCY 13 /* "Y" */
#define HB_FT_CURDOUBLE 14 /* "Z" */
#define HB_FT_VARLENGTH 15 /* "Q" */
#define HB_FT_MEMO 16 /* "M" */
#define HB_FT_ANY 17 /* "V" */
#define HB_FT_PICTURE 18 /* "P" */
#define HB_FT_BLOB 19 /* "W" */
#define HB_FT_OLE 20 /* "G" */
/* Positions for field structure array */
#define DBS_NAME 1
#define DBS_TYPE 2
#define DBS_LEN 3
#define DBS_DEC 4
#define DBS_FLAG 5
#define DBS_STEP 6
cnavarro wrote:También, creo recordar que existe la function, no sé si te servirá para lo que necesitas
FW_AdoExportToDBF( oRs, cDbf, lEditStruct )
cnavarro wrote:También, creo recordar que existe la function, no sé si te servirá para lo que necesitas
FW_AdoExportToDBF( oRs, cDbf, lEditStruct )
cnavarro wrote:Puedes mirar esto o buscar algo más en el foro
viewtopic.php?f=3&t=28839&start=0&hilit=FW_AdoExportToDBF
Return to FiveWin para Harbour/xHarbour
Users browsing this forum: VictorCasajuana and 9 guests