Aplicacao desenvolvida em GASPRO 4.0o, convertida para Harbour, indice NSX
Arquivo ODPROD.DBF
indice 1 str(codop,6) ( CHAVE PRIMARIA)
indice 2 codprod+IMPRESSA ( codprod caracter)
indice 3 IMPRESSA+str(codop,6)
indice 4 str(codcli,5)+IMPRESA
indice 5 codlan (controle do proprio GASPRO)
No clipper o comando commit ou dbcommit() nao estava atualizando
os indices, 2,3 E 4, os que tem o campo impressa na chave
Nao sei como é possivel.. !
Fiz um teste, em clipper, que passa pela rotina faz o replace e faz o commit..
na mesma rotina fiz um ALT_X para mostrar os indices envolvidos
com data e hora, e nao esta atualizando..
Se sair da rotina, opcao que fecha os aquivos, ao verificar os
indices esta atualizados...
* Nao sei como mas desse jeito funcionou por 10 anos
Talvez a atualizacao acontecesse depois de um certo tempo..
No harbour o comando commit ‚ executado, como deveria..
atualizado os indices o arquivo envolido na hora..
mas ai da um dos erros abaixo, mas nem sempre..
O que me deixa louco é ue outras rotinas com outros DBF, nao dao isso..
Como contas a receber, pagar,nota fiscal, etc
Uso o harbour 2.1 Mingw, compilado com hbmk2
Atualizacao de campo que faz parte dos indices secundarios, IMPRESSA CARAC 1
Código: Selecionar todos
Application Internal Error - G:\poliv1\dados\INFO_IN_.EXE
Terminated at: 2011.05.11 10:35:41
Erro irrecuper vel 6005: Exception error:
Called from DBCOMMIT(0)
Called from OPB_INCL(0) in OPBAIXA.prg
Called from OPBAIXA(0) in OPBAIXA.prg
Called from INF_MENU(0) in INF_MENU.prg
Called from MAIN(0) in INFO_IND.prg
ou
Na alteracao do arquivo, NO CAMPO IMPRESSA CARACT 1
Código: Selecionar todos
Application Internal Error - G:\poliv1\dados\INFO_IN_.EXE
Terminated at: 2011.05.11 15:16:42
Erro irrecuper vel 6005: Exception error:
Called from INDEXORD(0)
Called from POINTER_DBF(0) in INF_FUN2.prg
Called from OKBASEPED(0) in INF_OUTR.prg
Called from CRIT(0) in INF_FUNC.prg
Called from (b)STOREALL(0) in getsys.prg
Called from GETPOSTVALIDATE(0) in getsys.prg
Called from GETREADER(0) in getsys.prg
Called from READMODAL(0) in getsys.prg
Called from ORD_GET1(0) in ORDPROD.prg
Called from EDIT(0) in INF_PROC.prg
Called from ORD_INCL(0) in ORDPROD.prg
Called from ORDPROD(0) in ORDPROD.prg
Called from INF_MENU(0) in INF_MENU.prg
Called from MAIN(0) in INFO_IND.prg
A rotina é grande... sei que é complicado sem ter a aplicacao toda...mas independente disso..talvez alguem ai possa me dar uma ajuda, porque atualizacao de indice gera erro ??
Código: Selecionar todos
#include "info_ind.ch" // inicializa constantes manifestas
PARA lin_menu,col_menu
PRIV op_sis, tela_fundo:=SAVESCREEN(0,0,MAXROW(),79),vttpares:=0,vlido:=0
PRIV matriz:={},vinicio:=.t.,vmodo:="E",vestacao:=right(ide_maq,4)
op_sis=EVAL(qualsis,"OPITEM")
IF nivelop<1 // se usuario nao tem permissao,
ALERTA() // entao, beep, beep, beep
DBOX(msg_auto,,,3) // lamentamos e
RETU // retornamos ao menu
ENDI
cn:=fgrep :=.f.
#ifdef COM_LOCK
IF LEN(pr_ok)>0 // se a protecao acusou
? pr_ok // erro, avisa e
QUIT // encerra a aplicacao
ENDI
#endi
criterio=""
abrearq() // <======
*--
dele_atu:=SET(_SET_DELETED,.t.) // os excluidos nao servem...
SET KEY K_F9 TO veoutros // habilita consulta em outros arquivos
IF AT("D",exrot[op_sis])=0 // se usuario pode fazer inclusao
OPB_INCL() // neste arquivo chama prg de inclusao
ELSE // caso contrario vamos avisar que
ALERTA() // ele nao tem permissao fpara isto
DBOX(msg_auto,,,3)
ENDI
SET KEY K_F9 TO // F9 nao mais consultara outros arquivos
SET(_SET_DELETED,dele_atu) // os excluidos serao vistos
CLOS ALL // fecha todos arquivos abertos
RETU
*-----------------------------------------------
*-----------------------------------------------
PROC OPB_incl // inclusao no arquivo OPITEM
LOCAL getlist:={}, cabem:=1, ult_reg:=RECN(),ctl_r, ctl_c, t_f3_, t_f4_, l_max
LOCAL vdias,vnovo,v1,vprimleitura,vturno,vhms,vhhmm,tela2,vmsg,vficha:=''
LOCAL bblock,vop,vcor,lin24,vachou,vlincur,vloteok,vcodlote
LOCAL ventrada,ventrou,vgravou
PRIV op_menu:=TEL_EXTRA, blk_opitem:=.t., tem_borda, criterio:=""
PRIV cpord:="", l_a,vcodop,vseq,vusuliber,vnatrasos:=0,vnumparlido
PRIV MATOP:={},vpares,okprocesso:=.f.,vertrava:=.f.,vleuopanter:=.f.
PRIV vfichatag,vleutag,vtemtag
*---
ctl_w=SETKEY(K_CTRL_W,{||nadafaz()}) // enganando o CA-Clipper...
ctl_c=SETKEY(K_CTRL_C,{||nadafaz()})
ctl_r=SETKEY(K_CTRL_R,{||nadafaz()})
vt1:=time()
DISPBEGIN() // monta tela na pagina de traz
OPB_TELA() // imp tela para inclusao
*----
vcor:=setcolor()
SETCOLOR(drvcorenf)
@ 0,56 say 'Estacao.: '+vestacao
@ l_i,c_s+1 SAY space(78)
SETCOLOR(vcor)
*----
l_a=3
DISPEND() // apresenta tela de uma vez so
DO WHIL cabem>0
cod_sos=6
rola_t=.f. // flag se quer rolar a tela
SELE OPITEM
GO BOTT // forca o
SKIP // final do arquivo
vcod:=space(10) // alfa 6+4
vli:=l_s+l_a
vtl:=savescreen(vli,0,vli,79)
@ l_s+l_a,c_s+03 GET vcod pict '@k 9999999999' valid( val(vcod)>0 )
read
SET KEY K_ALT_F8 TO
IF rola_t
ROLATELA(.f.)
LOOP
ENDI
IF LASTKEY()=K_ESC // cancelou ou chave em branco
cabem=0 // prepara saida da inclusao
LOOP // volta p/ menu de cadastramento
ENDI
* vcod vem preenchido com zeros … esquerda nao d para tratar
if val(vcod)<999999
// CUIDADO se ler op 1 a 99 no leitor vai achar que e digitacao manual
vcodop:=val(vcod) // digitou so a OP manualmente nao o seq
vseq:=0
else
vcodop:=val(left(vcod,6))
vseq:=val(right(vcod,4))
endif
vpares:=0
vitemtag:=0
okprocesso:=.f.
vleutag:=.f.
vtemtag:=.f.
vfichatag:=.f.
ventrada:=alltrim(vcod)
vtam=len(ventrada)
SELE ORDPROD
M->cod_oprod:=vcodop
M->seq:=vseq
restscreen(vli,0,vli,79,vtl)
@ l_s+l_a,c_s+03 say M->cod_oprod pict '999999'
@ l_s+l_a,c_s+10 say M->seq pict '9999'
if vfichatag
@ row(),c_s+16 say 'TAG'
@ row(),c_s+21 say vpares pict '999'
vseq:=0
M->seq:=vseq
endif
vnumparlido:=0
vleuopanter:=.f.
vertrava:=.f.
SELE ORDPROD
SET ORDER TO 1
SEEK STR(vcodop,06,00)
IF eof()
rolar()
ALERTA()
DBOX("OP NAO ENCONTRADA ",12,,1)
LOOP
ENDIF
if vseq>0 //
SELE OPITEM
SET ORDER TO 1
SEEK STR(vcodop,06,00)+STR(vseq,04,00)
IF eof()
SELE ORDPROD
dadosop() // mostra
rolar()
SELE OPITEM
ALERTA()
vmsg:="Item "+alltrim(STR(vseq))+" da OP n„o ENCONTRADO "
if vseq=9999
vmsg+='|ETIQUETA de SALTO'
elseif vseq=9998
vmsg+='|ETIQUETA de PALMILHA'
elseif vseq=9997
vmsg+='|ETIQUETA de SEPARACAO'
endif
DBOX(vmsg,12)
LOOP
else
vpares:=OPITEM->qtdpar // qtd de pares desta etiq
vnumparlido:=OPITEM->numpar // dtos(vdtlida) > dtos(date()) // lendo pra frente
vsituitem:=OPITEM->situacao // situacao do item lido
okprocesso:=.t.
ENDI
endif
*--------
vlincur:=row()
vloteok:=.t.
if vseq>0 .or. vfichatag
SELE ORDPROD
if at('AMOSTRA',ORDPROD->obsprod)>0
vloteok:=.f.
else
vcodlote:=ORDPROD->loteinj
vcorfundo:=ORDPROD->corfundo
SELE LOTEINJ
set order to 1
dbseek(str(vcodlote,6)+str(vcorfundo,3))
if !eof() .and. LOTEINJ->obs='AMOSTRA'
vloteok:=.f. // nao processa op desse lote
endif
endif
SELE ORDPROD
endif
if vseq>0 .and. vloteok // so op poli normal
SELE OPTRAVA
SET ORDER TO 1
SEEK STR(vcodop,6)+STR(vseq,04,00)
if !eof() .and. empty(dataliber) // ta pendente
voppend:=OPTRAVA->cod_oprod
vitpend:=OPTRAVA->itemop
moppriori(voppend,vitpend,'T') // mostra e se for a estacao espera
else
moppriori(vcodop,vseq,'A') // analiza e pode travar
endif
if vleuopanter // leu op liberadora
setcolor(drvtitenf)
@ vlincur,c_s+16 say "NAO" // op pretendida
@ vlincur,c_s+21 say "LEU"
setcolor(vcor)
rolar()
SELE ORDPROD
SET ORDER TO 1
SEEK STR(vcodop,06,00)
@ l_s+l_a,c_s+03 say vcodop pict '999999'
@ l_s+l_a,c_s+10 say vseq pict '9999'
dadosop() // mostra
if vseq>0
SELE OPITEM
SET ORDER TO 1
SEEK STR(vcodop,06,00)+STR(vseq,04,00)
vpares:=OPITEM->qtdpar // qtd de pares desta etiq
vnumparlido:=OPITEM->numpar // dtos(vdtlida) > dtos(date()) // lendo pra frente
vsituitem:=OPITEM->situacao // situacao do item lido
okprocesso:=.t.
endif
endif
endif
if !okprocesso
setcolor(drvtitenf) // vermelho
if vtemtag .and. !vfichatag
@ vlincur,c_s+16 say "LER"
@ vlincur,c_s+21 say "TAG"
else
@ vlincur,c_s+16 say "NAO"
@ vlincur,c_s+21 say "LEU"
endif
setcolor(vcor)
endif
*------------
vleuitem:=.f.
vprimleitura:=.f.
SELE ORDPROD // necessario reposicionar
SET ORDER TO 1
SEEK STR(vcodop,06,00)
*--
if vseq>0 // etiq
SELE OPITEM // necessario reposicionar
SET ORDER TO 1
SEEK STR(vcodop,6)+STR(vseq,04,00)
if okprocesso .and. empty(OPITEM->situacao) .and. lastkey()<>K_ESC // se ='A' ou 'L', j tinha sido lido
IF !BLOREG(0,.5) // se ESC, nao trava
rolar()
LOOP
ENDI
POSIPAI() // relaciona com os pais
FOR i=1 TO FCOU() // inicializa variaveis
msg=FIEL(i) // de memoria com o mesmo
M->&msg.=&msg. // valor valor dos campos
NEXT
SELE 0
OPB_GET1() // faz leitura
SELE OPITEM
if empty(OPITEM->situacao) // se ='A' ou 'L', j tinha sido lido
vprimleitura:=.t.
vleuitem:=.t.
OPI_GET1(FORM_INVERSA) // em ordprod.prg grava qtd lida
if ORDPROD->atelie='S'
REPL OPITEM->situacao with 'A' // se ja estiver L ?
else
REPL OPITEM->situacao with 'L'
endif
OPI_GET1(FORM_DIRETA) // faz processo em itens da OP ordprod.prg
@ vlincur,c_s say "ok"
endif
sele opitem
dbcommit()
dbunlock() // libera registro
endif
endif
*------------------
if okprocesso .and. vprimleitura
vhms:=time()
vturno:=pegaturno(vhms)
SELE OPLIDA
set order to 1
dbgobottom() // ultimo
if dtinicio>date()+180 // data maior que 6 meses
vmsg:='Problema Arquivo OPLIDA.DBF data final:'+dtoc(dtinicio)
DBOX(vmsg,,,,,"ATEN€ŽO!")
if BLOREG(0,.5)
dbdelete()
dbcommit()
dbunlock()
endif
dbgobottom() // erro que aconteceu devido data ultimo
endif
vnovo:=.f.
vdata:=date()
vdias:=vdata-dtinicio
if vdias>=1 .or. empty(dtinicio) .or. turno<>vturno
vnovo:=.t.
elseif vdias=0 // mesmo dia
v1:=shoras(horainic,60,'+') // ultima leitura+60minutos
if vhms >= v1 // carac
vnovo:=.t. // passou + de 1 hora
endif
endif
if vnovo // <----
SELE OPLIDA
GO BOTT
SKIP
if BLOREG(0,.5)
APPEND BLANK
REPL dtinicio with vdata, horainic with vhms,turno with vturno,;
numetiq with 1, numpares with vpares
dbcommit()
dbunlock()
endif
else
SELE OPLIDA
GO BOTT
if BLOREG(0,.5)
REPLA numetiq with numetiq+1, numpares with numpares+vpares
dbcommit()
dbunlock()
endif
endif
SELE LEPOSTO
set order to 1
dbseek(dtos(vdata)+str(vturno,1)+vestacao)
if eof()
GO BOTT
SKIP
if BLOREG(0,.5)
APPEND BLANK
REPL dtinicio with vdata, turno with vturno,;
estacao with vestacao, numetiq with 1, numpares with vpares
dbcommit()
dbunlock()
endif
else
if BLOREG(0,.5)
REPLA numetiq with numetiq+1, numpares with numpares+vpares
dbcommit()
dbunlock()
endif
endif
endif
*--------
ventrou:=.f.
vfimexped:=''
SELE ORDPROD
SET ORDER TO 1
SEEK STR(vcodop,06,00)
IF okprocesso // .and. BLOREG(0,.5) // and vseq>0 // era bloreg(3,.5
ventrou:=.t.
vgravou:=.f.
vhms:=time() // 12:45:33
vhhmm:=val(left(vhms,2))+val(substr(vhms,4,2))/100 // 12.45 num
if vprimleitura
if empty(primleitur)
*REPLA primleitur WITH date(),horapleitu WITH vhhmm
vgravou:=.t.
REPBLO('ORDPROD->primleitur',{|| date() }) // bloqueia e faz replace
REPBLO('ORDPROD->horapleitu',{|| vhhmm })
endif
if ORDPROD->impressa='G' .or. empty(ultleitura)
*REPLA ultleitura WITH date(),horauleitu WITH vhhmm
vgravou:=.t.
REPBLO('ORDPROD->ultleitura',{|| date() })
REPBLO('ORDPROD->horauleitu',{|| vhhmm })
endif
endif
vttpares:=spares('P')
vlido:=spares('L') // so lido, se Ordprod ‚ de atelie, item passou para 'A' entao lido=0
if ORDPROD->impressa='S'
if vleuitem
* REPLA ultleitura WITH date(),horauleitu WITH vhhmm
REPBLO('ORDPROD->ultleitura',{|| date() })
REPBLO('ORDPROD->horauleitu',{|| vhhmm })
endif
endif
if vlido>=vttpares .and. !(impressa $ 'CFM') // se completou OP, passa de G/S para 'E'
* REPLA ORDPROD->IMPRESSA WITH 'E' // expedicao pronta, podia esta em G ou A
vgravou:=.t.
vfimexped:='L' // comeco do erro 2012
REPBLO('ORDPROD->impressa',{|| 'E'})
else
if !(impressa $ 'CFM') // lendo na expedicao
vematelie:=spares('A')+spares('L') // todos foram para A, algus voltaram estao em L
if vematelie>=vttpares // se completou leitura
* REPLA ORDPROD->IMPRESSA WITH 'A' // op completamente 'lida' para atelie
vgravou:=.t.
vfimexped:='A'
REPBLO('ORDPROD->impressa',{|| 'A'})
endif
endif
endif
if vgravou
dbcommit() // <========= PROBLEMA NO HARBOUR
endif
endif
SELE ORDPROD
IF okprocesso .and. !ventrou
vmsg:='Separar e Verificar esta OP:'+STR(vcodop,6)
vmsg+='|Sistema Nao teve acesso para gravar dados !'
vmsg+='|Tente Ler de NOVO'
DBOX(vmsg,12)
endif
ok:=.t. // verifica
vt2:=shoras(vt1,p_tverop,'+') // tempo maximo tolerado entre leituras
if time()<vt2
ok:=.f. // nao passou o tempo para nova verificacao ainda
endif
if (ok .or. vinicio .or. vseq=0) // vseq=0 digitado manualmente
PARAMETROS(dbfparam)
vinicio:=.f. // so entra uma vez
vhms:=time() // 12:45:78
vhhmm:=val(left(vhms,2))+val(substr(vhms,4,2))/100 // 12.45 num
matriz:={}
lin24:=savescreen(24,0,24,79)
SELE ORDPROD
SET ORDER TO 3
DBSEEK('G') // procurar S ??
do while impressa='G' .and. !eof()
@ 24,60 say '..aguarde..'+str(cod_oprod,6)
if !empty(ultleitura) // leu pelo menos uma
vtempo:=pegthm(ultleitura,horauleitu,date(),vhhmm) // tempo entre ultima leitura e leitura atual
if vtempo>p_horaop // 5 a 10 horas
ttlida:=contaetiq('L')+contaetiq('A')
if ttlida>0
ttetiq:=contaetiq('P')
vperc:=-9999
vpfalta:=9999
if ttetiq>0
vperc:=(ttlida/ttetiq)*100 // perc lido
vpfalta:=100-vperc
endif
if vpfalta>0
vsitu:=''
if vperc>=p_perclido
vsitu:='A'
elseif vperc>=p_perclido-10
vsitu:='Z' // fica no final, so ser mostrado
endif
if !empty(vsitu) // 1 2 3 4 5 6 7 8 9 10 11 12
aadd(matriz,{cod_oprod,ultleitura,horauleitu,vtempo,ttetiq,ttlida,cod_prod,cod_client,vperc,data_prod,vpfalta,vsitu})
endif
endif
if len(matriz)>300 // op's candidatas
exit
endif
endif
endif
endif
dbskip()
enddo
if len(matriz)>0
bblock:={|kk,ww| kk[12]+dtos(kk[10])+str(kk[11],5,2) < ww[12]+dtos(ww[10])+str(ww[11],5,2)} // dtprev+percfalta
asort(matriz,,,bblock)
if matriz[1,10]<=date() .and. matriz[1,9]>=p_perclido
vertrava:=.t. // data entrega ate hoje e perc lido>= tolerado
endif
endif
vt1:=time() // renova para so fazer nova comparacao depois de
restscreen(24,0,24,79,lin24)
endif
SELE ORDPROD
SET ORDER TO 1
SEEK STR(vcodop,06,00)
dadosop() // mostra
rolar()
*---
ENDD
SELE OPLIDA
GO ult_reg // para o ultimo reg digitado
SETKEY(K_CTRL_W,ctl_w)
SETKEY(K_CTRL_C,ctl_c)
SETKEY(K_CTRL_R,ctl_r)
RETU
*-----------------------
*-----------------------
static function abrearq()
PARAMETROS(dbfparam)
*--
SELE 0
#ifdef COM_REDE
IF !USEARQ("LIBEROP",.f.,10,1) // se falhou a abertura do arq
RETU // volta ao menu anterior
ENDI
#else
USEARQ("LIBEROP") // abre o dbf e seus indices
#endi
*--
SELE 0
#ifdef COM_REDE
IF !USEARQ("ORDPROD",.f.,10,1) // se falhou a abertura do arq
RETU // volta ao menu anterior
ENDI
#else
USEARQ("ORDPROD") // abre o dbf e seus indices
#endi
*--
SELE 0
#ifdef COM_REDE
IF !USEARQ("OPTRAVA",.f.,10,1) // se falhou a abertura do arq
RETU // volta ao menu anterior
ENDI
#else
USEARQ("OPTRAVA") // abre o dbf e seus indices
#endi
sele 0
#ifdef COM_REDE
IF !USEARQ("TAGOP",.f.,10,1) // se falhou a abertura do arq
RETU // volta ao menu anterior
ENDI
#else
USEARQ("TAGOP") // abre o dbf e seus indices
#endi
sele 0
#ifdef COM_REDE
IF !USEARQ("LOTEINJ",.f.,10,1) // se falhou a abertura do arq
RETU // volta ao menu anterior
ENDI
#else
USEARQ("LOTEINJ") // abre o dbf e seus indices
#endi
*--
sele 0
#ifdef COM_REDE
IF !USEARQ("OPLIDA",.f.,10,1) // se falhou a abertura do arq
RETU // volta ao menu anterior
ENDI
#else
USEARQ("OPLIDA") // abre o dbf e seus indices
#endi
*--
sele 0
#ifdef COM_REDE
IF !USEARQ("LEPOSTO",.f.,10,1) // se falhou a abertura do arq
RETU // volta ao menu anterior
ENDI
#else
USEARQ("LEPOSTO") // abre o dbf e seus indices
#endi
*--
sele 0
#ifdef COM_REDE
IF !USEARQ(sistema[op_sis,O_ARQUI,O_NOME],.f.,20,1) // se falhou a abertura do
RETU // arquivo volta ao menu anterior
ENDI
#else
USEARQ(sistema[op_sis,O_ARQUI,O_NOME])
#endi
retu
