hola foro,
desde programa creo una dbf con los campos en un arreglo, modifico el arreglo agregandole campos, obviamente hay campos que no existen que estan en el arreglo, como hago para que la estructura de la dbf tome los campos nuevos agregados?
salu2
paco
Paco:
Si tu pregunta es para saber si hay alguna funci贸n o clase que te ayude a modificar la estructura, ummmm pues creo que no.
Si lo que necesitas es una idea de c贸mo hacerlo, se me ocurre lo siguiente:
1.- Tienes una nueva estructura en un arreglo, como dices
2.- Debes leer la estructura de la DBF existente y la metes en otro arreglo, me parece que la funci贸n DIRECTORY() puede ayudarte con eso
3.- Comparas ambos arreglos
4.- Si hay diferencia(s) creas una DBF temporal con la nueva estructura
5.- Copias los registros de la DBF existente a la nueva DBF, con APPEND FROM .... puedes hacerlo
6.- Borras la DBF anterior y
7.- Renombras la nueva DBF al nombre de la DBF anterior, obviamente debes abrirlas DBF en forma exclusiva.
Es solo una idea, espero te sirva
Saludos
Paco:
En el punto 2 de mi anterior respuesta no es la funci贸n DIRECTORY() es la funci贸n DBSTRUCT(), las prisas son malas consejeras 
Un abrazo
Exactamente como indica Armando es como se hace.
Creas una estrutrua vacia en un archivo temporal.
Abres el archivo temporal
Haces un append from
renombras el archivo original por ejemplo como .OLD
y renombras el temporal con el nombre del original
y listo.
enterado, gracias
paco
function checkBaseDato()
local cPath, aDir, cDbf, aStruc1, aStruc2, i, j, cInfo, nHandle, lPaso, aBase := {}, lIndex := .f.
if DirMake( ViewUsu():cPathTmp + "\chkDbf" ) <> 0
MsgInfo( "imposible crear directorio" + CRLF + ViewUsu():cPathTmp + "\chkDbf"+ CRLF + CRLF + "Borrelo manualmente", "Usuario" )
return( nil )
endif
cPath := ViewUsu():cPathDbf //guardamos la ubicacion original
ViewUsu():cPathDbf := ViewUsu():cPathTmp + "\chkDbf"
AdsSetSearchPath( ViewUsu():cPathDbf )
CreaDbf() //creamos los dbf en el directorio creado
aDir := Directory( ViewUsu():cPathDbf + "\*.DBF" )
IF (nHandle := FCREATE( 'Informe.log', 0 )) == -1
msginfo( "Hubo un Error;;al crear Archivo" )
return( nil )
endif
cInfo := "Informe de structura" + CRLF
cInfo += repli("=",80) + CRLF
for i := 1 to len( aDir )
cDbf := strtran( upper(aDir[i,1]),".DBF", "" )
cInfo += "Archivo:"+PADR(cDbf,10)
aStruc1 := {}
aStruc2 := {}
use (ViewUsu():cPathDbf + "\" + cDbf )exclusive VIA "DBFCDX"
if !NetErr()
aStruc1 := dbStruct()
if file( cPath + "\" + cDbf + ".dbf" )
USE (cPath + "\" + cDbf) EXCLUSIVE VIA "DBFCDX"
if !NetErr()
aStruc2 := dbStruct()
else
cInfo += CRLF + "Imposible abrir de la ruta "+cPath
endif
else
aStruc2 := {{ "NO EXISTE FILE", "C", 0, 0 }}
endif
else
cInfo := "Error abrir archivo:"+ViewUsu():cPathDbf + "\"+cDbf
endif
lPaso := .f.
if !empty(aStruc1) .and. !empty(aStruc2)
if len( aStruc1 ) = len( aStruc2 )
for j := 1 to len( aStruc1 )
if aStruc1[j,1] <> aStruc2[j,1] .or. ;
aStruc1[j,2] <> aStruc2[j,2] .or. ;
aStruc1[j,3] <> aStruc2[j,3] .or. ;
aStruc1[j,4] <> aStruc2[j,4]
cInfo += CRLF + ;
aStruc1[j,1] + aStruc1[j,2] + str(aStruc1[j,3],3) + str(aStruc1[j,4],2)+ " " +;
aStruc2[j,1] + aStruc2[j,2] + str(aStruc2[j,3],3) + str(aStruc2[j,4],2)
lPaso:=.t.
endif
next j
if !lPaso
cInfo += chr(9)+ chr(9) + "OK" + CRLF
endif
else
lPaso := .t.
endif
endif
if lpaso
if len(aStruc1) <= len( aStruc2 )
cInfo += CRLF + chr(9) + "Estructuras de " + padr(cPath,50)+ chr(9)+ViewUsu():cPathDbf+CRLF
for j := 1 to len( aStruc1 )
cInfo += chr(9) + ;
PadR(aStruc1[j,1],10)+chr(9) + aStruc1[j,2] + chr(9) + str(aStruc1[j,3],3) + chr(9)+str(aStruc1[j,4],2) + chr(9)+chr(9)
cInfo += chr(9) + ;
PadR(aStruc2[j,1],10) + chr(9) + aStruc2[j,2] + chr(9) + str(aStruc2[j,3],3) + chr(9)+str(aStruc2[j,4],2) + CRLF
next j
while j <= len( aStruc2 )
cInfo += chr(9) + ;
PadR(aStruc2[j,1],10) + chr(9)+aStruc2[j,2] + chr(9)+str(aStruc2[j,3],3) + chr(9)+str(aStruc2[j,4],2) + CRLF
j++
enddo
else
cInfo += CRLF + chr(9) + "Estructuras de " + PadR(ViewUsu():cPathDbf,50)+ chr(9)+cPath+CRLF+CRLF
for j := 1 to len( aStruc2 )
cInfo += chr(9) + ;
PadR(aStruc2[j,1],10)+chr(9) + aStruc2[j,2] + chr(9) + str(aStruc2[j,3],3) + chr(9)+str(aStruc2[j,4],2) + chr(9)+chr(9)
cInfo += chr(9) + ;
PadR(aStruc1[j,1],10) + chr(9) + aStruc1[j,2] + chr(9) + str(aStruc1[j,3],3) + chr(9)+str(aStruc1[j,4],2) + CRLF
next j
while j <= len( aStruc1 )
cInfo += chr(9) + ;
PadR(aStruc1[j,1],10) + chr(9)+aStruc1[j,2] + chr(9)+str(aStruc1[j,3],3) + chr(9)+str(aStruc1[j,4],2) + CRLF
j++
enddo
endif
aadd( aBase, cDbf )
endif
USE
FWRITE( nHandle, cInfo+CRLF )
cInfo:=""
next i
FCLOSE( nHandle )
dbCloseAll()
WAITRUN("NOTEPAD informe.LOG")
if len( aBase ) > 0 .AND. MsgNoYes( "Desea reparar las bases!!" + CRLF + "antes de prodeder hacer una copia de respaldo", "usuario" )
lIndex := .t.
for i := 1 to len( aBase )
cDbf := aBase[i]
use (ViewUsu():cPathDbf + "\" + cDbf )exclusive VIA "DBFCDX"
if !NetErr()
if file( cPath + "\" + cDbf + ".dbf" )
MsgRun( "Espere, importando " +cDbf+"["+str(i,2)+"/"+str(len(abase),2)+"]", "Usuario",;
{ || __dbApp( cPath + "\"+cDbf,{ },,,,,.F.,"DBFCDX") } )
USE
if fErase( cPath + "\" + cDbf + ".DBF" ) = 0
if file( cPath + "\" + cDbf + ".fpt" )
fErase( cPath + "\" + cDbf + ".fpt" )
FileCopy( ViewUsu():cPathDbf + "\" + cDbf + ".fpt", cPath + "\" + cDbf + ".fpt" )
endif
FileCopy( ViewUsu():cPathDbf + "\" + cDbf + ".DBF", cPath + "\" + cDbf + ".DBF" )
else
MsgInfo( "Error al borrar "+ cPath + "\" + cDbf + ".DBF" )
endif
else
USE
FileCopy( ViewUsu():cPathDbf + "\" + cDbf + ".DBF", cPath + "\" + cDbf + ".DBF" )
if file( ViewUsu():cPathDbf + "\" + cDbf + ".FPT" )
FileCopy( ViewUsu():cPathDbf + "\" + cDbf + ".fpt", cPath + "\" + cDbf + ".fpt" )
endif
endif
else
msginfo( "imposible abrir base" + cDbf )
endif
USE
next i
endif
aDir := Directory( ViewUsu():cPathTmp + "\chkDbf\*.*" )
aEval( aDir, { |x| cDbf := X[1], fErase( ViewUsu():cPathTmp + "\chkDbf\"+ cDbf ) } )
ViewUsu():cPathDbf := cPath //restauramos el original
AdsSetSearchPath( ViewUsu():cPathDbf )
DirRemove( ViewUsu():cPathTmp + "\chkDbf" )
if lIndex
Indexar( .f. )
dbCloseAll()
endif
return( nil )
//---------------------------------------------------------------------------------------------------------------gracias patricio, la probare
salu2
paco