by alex_cyr » Tue Dec 18, 2007 1:28 am
Antonio, esta es mi funcion, te platico rapidamente que hace, obtiene todos los dbfs de un directorio, escribe la estructura en un TXT y luego cada uno de sus indices NTX, si remuevo la parte donde escribo los indices funciona sin problema:
gracias
alex.
*CREA EL ARCHIVO TEXTO CON LAS ESTRUCTURAS DEL SISTEMA PARA LA APERTURA DE EMPRESAS
static function txtstru()
LOCAL afiles := directory(xrutemp+'*.DBF')
LOCAL astrcut:= {}
LOCAL wtexto,i,j,k := 0
LOCAL lanio,afiles2:={}
LOCAL aindices:={}
PRIVATE ldbf,lntx
wtexto := fcreate(xrutbas+'ESTRUCT.TXT',0)
k:= len(afiles)
for j = 1 to k
*LOS YY YA NO JUEGAN
if upper(substr(afiles[j,1],at('.',afiles[j,1])-2,2)) == upper('YY')
loop
endif
*DETERNIMA SI ES UN ARCHIVO ANUAL EN CUYO CASO PROCESA SOLO LOS DEL AÑO DEL XDATE
lfile := afiles[j,1]
if val(substr(afiles[j,1],at('.',afiles[j,1])-2,2)) > 0
lanio := 2000+val(substr(afiles[j,1],at('.',afiles[j,1])-2,2))
if lanio # year(xdate)
loop
endif
lfile := strtran(afiles[j,1],substr(str(year(xdate),4),3,2),'YY')
aadd(afiles2,lfile) //ARREGLO CON ARCHIVOS DE EJERCICIO
endif
*ESCRIBE EL NOMBRE DEL ARCHIVO
fwrite(wtexto,'A'+lfile+chr(13)+chr(10))
dbusearea(.t.,,xrutemp+afiles[j,1])
astruct := dbstruct()
*ESCRIBE LA ESTRUCTURA DEL ARCHIVO
for i = 1 to len(astruct)
fwrite(wtexto,'E{'+astruct[i,1]+','+astruct[i,2]+','+str(astruct[i,3],2)+','+str(astruct[i,4],1)+'}'+chr(13)+chr(10))
next i
dbclosearea()
*ESCRIBE LOS INDICES
asize(aindices,0)
aindices := directory(xrutemp+strtran(upper(afiles[j,1]),'.DBF','')+'.*')
for x := 1 to len(aindices)
lntx := aindices[x,1]
if upper(substr(lntx,at('.',lntx),4)) $ '.DBF,.BAK,.RES,.OLD,.ANT'
loop
endif
ldbf := xrutemp+afiles[j,1]
lntx := xrutemp+aindices[x,1]
USE &ldbf index &lntx NEW ALIAS ALTEMP
cnombre := substr(lntx,at('.',lntx)+1,3)
ckey := indexkey()
fwrite(wtexto,'I'+cnombre+' '+ckey+chr(13)+chr(10))
dbclosearea()
next x
fwrite(wtexto,'*'+chr(13)+chr(10))
next j
*AGREGA LOS ARCHIVOS DE APERTURA DE EJERCICIO
for j = 1 to len(afiles2)
fwrite(wtexto,'FILEC'+afiles2[j]+chr(13)+chr(10)) //FILEC = COPIAR EL FICHERO CON DATOS
//FILEZ = COPIAR SOLO ESTRUCTURA *SE DEBE PONER LA Z MANUALMENTE
next j
fclose(wtexto)
return .t.