Arquivo Corrompido

[JuniorVaz]

Olam estou com um problema com um dbf. Eu tenho um backup dele, quando eu adiciono ele no diretoriu do programa, ele funciona certinhu, faz pesquisas, tudo OK, mas quando eu peço um novo cadastro, ele aparec mensagem de arquivo corrompido, e dai naum funciona mais nada. No caso é um dbf q tem poucos dados ainda, portando criei outro limpo e comecei a cadastrar denovo, mas mesmo assim da corrompido, ja refis os NTX tb. Vou postar abaixo o prg para ver se tem alguma falha q esta corrompendo o arquivo ou se alguem tem alguma ideia pra me passar. Obrigado


close all
clear
cbc()
set curs on
stor 0 to xcodmat,xcodpal,xcodsal,xcodsol,xcodgra,XCODEMB
stor 0.00 to xpreco,xpreco2
stor 0 to xdescsol,xdescsal,xdescpal,xcodref2
stor space(50) to xobs
stor space(30) to xdescref,xdescref2
stor space(10) to xlinha
stor space(5) to xcodref
sele 0
use codref inde codref alias cod
set index to codref
sele 0
use cademb inde cademb alias emb
set inde to cademb
sele 0
use cadref inde cadref alias ref
set inde to cadref
sele 0
use cadmat inde cadmat alias mat
set inde to cadmat,dcadmat
sele 0
use cadpal inde cadpal alias pal
set inde to cadpal,dcadpal
sele 0
use cadsal inde cadsal alias sal
set inde to cadsal,dcadpal
sele 0
use cadsol inde cadsol alias sol
set inde to cadsol,dcadsol
sele 0
use cadgra inde cadgra alias gra
set inde to cadgra
do tl_cadref
do while .t.
ss=savescreen(00,00,24,79)
setcolor(cor2)
SELE REF
do lp_cadref
@ 6,17 get xcodref pict "@K!"
read
sele cod
go 1
xcodref2=a+1
@ 6,41 say xcodref2 pict "99999"

if lastkey()=27
exit
endif
@ 7,17 get xcodmat pict "999999"
read
sele mat
if empty(xcodmat)
sf=savescreen(00,00,24,79)
do selmat
setcolor(cor2)
restscreen(00,00,24,79,sd)
index on codmat to cadmat
@ 7,17 get xcodmat pict "999999"
READ
restscreen(00,00,24,79,sf)

if lastkey()=27 .OR. EMPT(XCODMAT)
do lp_cadref
loop
endif
endif
sele mat
seek xcodmat
if found()
xdescmat=descmat
@ 7,24 say xdescmat
else
set color to r*/w+
@ 24,4 say "Material Nao Cadastrado no Sistema!!!"
setcolor(cor2)
inkey(0)
do lp_cadref
loop
endif
sele ref
seek xcodref+str(xcodmat,6)
if found()
xd=savescreen(23,4,23,60)
tone(900,2)
set color to r*/w+
@ 24,4 say "Referencia ja Cadastrada no Sistema!!!"
inkey(0)
do lp_cadref
loop
return
endif
@ 8,17 GET xdescref pict "@K!"
@ 9,17 get xdescref2 pict "@K!"
@ 10,17 get xlinha pict "@K!"
@ 11,17 get xcodemb pict "999999"
read



if empty(xcodemb) .or. xcodemb=0 .or. lastkey()=27
ds=savescreen(0,0,24,79)
do selemb
sele emb
setcolor(cor2)
index on codemb to cademb
restscreen(0,0,24,79,ds)
@ 11,17 GET xcodemb pict "999999"
read
if empt(xcodemb) .or. xcodemb=0 .or. lastkey()=27
do lp_cadref
loop
endif
endif
sele emb
seek xcodemb
if found()
xtamanho = tamanho
xmarca = marca
@ 11,24 say rtrim(xtamanho) + " - " + xmarca
else
set color to r*/w+
@ 24,4 say "Embalagem Nao Cadastrada no Sistema!!!"
setcolor(cor2)
inkey(0)
@ 24,4 clear to 24,79
do lp_cadref
loop
endif
@ 12,17 GET xcodsol pict "999999"
read
if empty(xcodsol) .or. xcodsol=0 .or. lastkey()=27
dd=savescreen(0,0,24,79)
do selsol
sele sol
setcolor(cor2)
index on codsol to cadsol
restscreen(0,0,24,79,dd)
@ 12,17 GET xcodsol pict "999999"
read
if empt(xcodsol) .or. xcodsol=0 .or. lastkey()=27
do lp_cadref
loop
endif
endif
sele sol
seek xcodsol
if found()
xdescsol=descsol
@ 12,24 say xdescsol
else
set color to r*/w+
@ 24,4 say "Sola Nao Cadastrada no Sistema!!!"
setcolor(cor2)
inkey(0)
do lp_cadref
loop
endif

@ 13,17 GET xcodpal pict "999999"
read
if empty(xcodpal) .or. xcodpal=0 .or. lastkey()=27
dd=savescreen(0,0,24,79)
do selpal
sele pal
setcolor(cor2)
inde on codpal to cadpal
restscreen(0,0,24,79,dd)
@ 13,17 GET xcodpal pict "999999"
read
if empt(xcodpal) .or. xcodpal=0 .or. lastkey()=27
do lp_cadref
loop
endif
endif
sele pal
seek xcodpal
if found()
xdescpal=descpal
@ 13,24 say xdescpal
else
set color to r*/w+
@ 24,4 say "Palmilha Nao Cadastrada no Sistema!!!"
setcolor(cor2)
inkey(0)
do lp_cadref
loop
endif
@ 14,17 GET xcodsal pict "999999"
read
if empty(xcodsal) .or. xcodsal=0 .or. lastkey()=27
dd=savescreen(0,0,24,79)
do selsal
sele sal
setcolor(cor2)
index on codsal to cadsal
restscreen(0,0,24,79,dd)
@ 14,17 GET xcodsal pict "999999"
read
if empt(xcodsal) .or. xcodsal=0 .or. lastkey()=27
do lp_cadref
loop
endif
endif
sele sal
seek xcodsal
if found()
xdescsal=descsal
@ 14,24 say xdescsal
else
set color to r*/w+
@ 24,4 say "Salto Nao Cadastrado no Sistema!!!"
setcolor(cor2)
inkey(0)
do lp_cadref
loop
endif
@ 15,17 GET xpreco pict "@E 999.99"
@ 15,42 get xpreco2 pict "@E 999.99"
@ 16,17 GET xobs pict "@K!"
READ
CS=' '
tone(990)
@ 24,4 SAY 'Deseja Gravar Esta Referencia?' get cs pict "!" valid cs $ "SN"
read
if lastkey()=27
do lp_cadref
loop
endif
if cs='S'
do gr_cadref
do lp_cadref
loop
else
do lp_cadref
loop
endif
enddo
close all
return
*********
proc tl_cadref
setcolor(cor2)
cx(04,03,18,69,"CADASTRO DE REFERENCIAS")
SETCOLOR(COR4)
@ 06,5 SAY "Referencia: "
@ 06,30 say "Cod. Ref 2: "
@ 07,5 SAY "Cod.Mater.: "
@ 08,5 say "Descricao1: "
@ 09,5 say "Descricao2: "
@ 10,5 say "Linha.....: "
@ 11,5 say "Cod.Embal.: "
@ 12,5 SAY "Cod.Sola..: "
@ 13,5 SAY "Cod.Palm..: "
@ 14,5 say "Cod.Salto.: "
@ 15,5 SAY "Preco 1...: "
@ 15,30 say "Preco 2....."
@ 16,5 SAY "Observac..: "
retu
***********
proc lp_cadref
stor 0 to xcodmat,xcodpal,xcodsal,xcodsol,xcodgra,xcodemb,xcodref2
stor 0.00 to xpreco,xpreco2
stor space(50) to xobs
stor space(30) to xdescref,xdescref2
stor space(10) to xcodref,xlinha
stor 0 to xdescsol,xdescsal,xdescpal
setcolor(cor2)
restscreen(00,00,24,79,ss)
retu
***********
proc gr_cadref
sele cod
rlock()
replace a with xcodref2
commit
unlock
sele ref
seek xcodref+str(xcodmat,6)
if found()
RLOCK()
else
APPE BLANK
endif
replace codref with xcodref,;
codmat with xcodmat,;
descref with xdescref,;
codpal with xcodpal,;
codsol with xcodsol,;
codsal with xcodsal,;
codref2 with xcodref2,;
descref2 with xdescref2,;
desmat with xdescmat,;
descsol with xdescsol,;
descsal with xdescsal,;
linha with xlinha,;
descpal with xdescpal,;
codemb with xcodemb,;
obs with xobs,;
preco2 with xpreco2,;
preco with xpreco
commit
unlock
retu

[filizola]

amigo, seu problema de corrupção está aqui:

use cadmat inde cadmat alias mat
set inde to cadmat,dcadmat

USE CADMAT INDE CADMAT ALIAS MAT
vc está abrindo um indice
SET INDE TO CADMAT,DCADMAT
vc agora esta tentando abrir um segundo arquivo de indice

faça assim
USE CADMAT INDE CADMAT,DCADMAT ALIAS MAT
pronto

[DORNELES]

Caro amigo Junior, em uma aplicação um dos grandes problema e a abertura de arquivo e dos índices. Tenho uma aplicação que tem 210 arquivos de dados e 423 arquivos de índice e vendo o seu código resolvi dar algumas sugestões para você ou alguém que venha a interessar.

Fazendo uma analise do seu código e possiveis alterações.
sele 0
use codref inde codref alias cod
set index to codref
sele 0
use cademb inde cademb alias emb
set inde to cademb
sele 0
use cadref inde cadref alias ref
set inde to cadref
sele 0
use cadmat inde cadmat alias mat
set inde to cadmat,dcadmat
sele 0
use cadpal inde cadpal alias pal
set inde to cadpal,dcadpal
sele 0
use cadsal inde cadsal alias sal
set inde to cadsal,dcadpal
sele 0
use cadsol inde cadsol alias sol
set inde to cadsol,dcadsol
sele 0
use cadgra inde cadgra alias gra
set inde to cadgra

Para vc abrir os seus arquivos e seus índices vc utiliza todos esses códigos, eu simplifiquei as aberturas, criei uma função para abrir e fechar, vc só passa os arquivos que quer abrir, e a abertura fica em um só lugar, quando precisar criar novos índices vc só altera uma vez, não tem que ficar alterando em toda sua aplicação. Outra coisa só abre o arquivo quando precisar dele e feche em seguida.

AbreDbf({"cod","emb","ref","mat","pal","sal","sol","gra"})

************************************************
FUNCTION AbreDbfNtx(aAbre,aFecha,lShared,lAjuda)
************************************************
//
LOCAL cArqAbre, cArea, i
LOCAL Achou := .F.
LOCAL cLinha:= SAVESCREEN(MAXROW(),00,MAXROW(),MAXCOL())
//
lAjuda := IF(lAjuda == NIL, .F., lAjuda )
lShared:= IF(lShared== NIL, .T., lShared )
aFecha := IF(aFecha == NIL, { }, aFecha )
//
FOR i:= 1 TO LEN(aAbre)
//
Aviso("Abrindo Arquivo " + aAbre )
//
IF SELECT(aAbre) = 0
AADD(aFecha, aAbre)
END
//
IF UPPER(aAbre) == UPPER("Cod")
//
IF SELECT("Cod") == 0
IF !AbreDbf("CODREF"{"codref"};
,Nil,"Cod",,lShared,Nil,lAjuda)
Mensagem("Imposs¡vel acessar o arquivo de Referencias!",3,1)
RETURN(.F.)
END
END
//

ELSE
//
Mensagem('Alias '+ aAbre +' nÆo Existe',3,3)
FechaDbfNtx(aFecha)
Return(.f.)
//
END
//
NEXT
RETURN(.T.)

**************************************
stor 0 to xcodmat,xcodpal,xcodsal,xcodsol,xcodgra,XCODEMB
stor 0.00 to xpreco,xpreco2
stor 0 to xdescsol,xdescsal,xdescpal,xcodref2
stor space(50) to xobs
stor space(30) to xdescref,xdescref2
stor space(10) to xlinha
stor space(5) to xcodref

Outra alteração e a criação de variaveis, tenho um arquivo que possui 145 campos, ja pensou criar todas essas variaveis. Você tem que trabalhar com arquivos cabeçalhos *.ch.

CORREF.CH
// no arquivo corref.ch vc tem que ter as mesma estrutura do banco de
// dados e na sequencia.
#xtranslate.ref_codref => \[01]
#xtranslate.ref_descricao => \[02]
// .ref_ isso é so para indentificar o arquivo, porque vc pode ter mais de
// um arquivo aberto e com campos iguais.

Isso funciona da seguinte forma.
#include "CORREF.ch"
// vc tem que colocar essa linha no inicio do seu arquivo onde for ultilizar.

LOCAL aGetRef
//
...
...
SELECT Cor
GO BOTTOM
SKIP
aGetRef := InitData() //vai iniciar todos os campos em branco
//

SELECT Cor
GO TOP
aGetRef := InitData() //vai com o conteudo que esta nos campos

SETCOLOR(aCor[10])
@ 04 ,07 GET aGetRef.ref_codref PICT "9999"
@ 05 ,07 GET aGetRef.ref_descricao PICT "@!"

...
...
// para gravar
//
IF FOUND()
WHILE !BloqReg(); END //bloqueia o registro para gravar
ELSE
WHILE !AddRec(); END //adiciona um registro em branco e
END //bloqueia
ReplData(aGetRef)
DBCOMMIT()
DBUNLOCK()

Espero ter ajudado
Ok