que tal, tengo un programita que genera un archivo texto con las estructuras e indices de mis dbfs, lo extraño es ke en ocasiones me manda el siguiente mensaje, si alguien me pudiera ayudar le estaria agradecido.
UNRECOVERABLE ERROR 9009:
hb_xrealloc can't reallocate memory
alex
ayuda con error !!
- Antonio Linares
- Site Admin
- Posts: 37481
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
- Contact:
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.
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.
- Antonio Linares
- Site Admin
- Posts: 37481
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
- Contact:
Alex,
Comentando estas tres líneas ya no falla ?
De ser asi, prueba con:
Comentando estas tres líneas ya no falla ?
Code: Select all
cnombre := substr(lntx,at('.',lntx)+1,3)
ckey := indexkey()
fwrite(wtexto,'I'+cnombre+' '+ckey+chr(13)+chr(10))
Code: Select all
cnombre := substr(lntx,at('.',lntx)+1,3)
ckey := indexkey()
if Empty( cnombre ) .or. Empty( ckey )
MsgAlert( "nombre ó key no válido!" )
endif
DEFAULT cnombre := "", ckey := ""
fwrite(wtexto,'I'+cnombre+' '+ckey+chr(13)+chr(10))
- Antonio Linares
- Site Admin
- Posts: 37481
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
- Contact:
Tambien puede ser que at('.',lntx) devuelva cero, por lo que le estarías pasando un valor erróneo a SubStr()
Compruébalo:
Compruébalo:
Code: Select all
if at('.',lntx) == 0
MsgAlert( "el fichero no tiene extension!" )
endif
- Antonio Linares
- Site Admin
- Posts: 37481
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
- Contact: