DUPLICIDADE NO APPEND BLANK

[HASA]

, Olá Pessoal, Boa Pascoa a Todos, estou com um problema e já tentei monitorar mas não consigo identificar, é o seguinte: Quando existe uma digitação uma atras da outra (contínua) dá a impressão que cada item é incluido no banco de dados (até ai está certo), e no final, quando o usuário sai da rotina que estava executando o Clipper grava novamente na mesma ordem em que foi digitado dando a impressão de que o usuário digitou 2 vezes (Duplica os dados). Bem isso só acontece em REDE, a cada final de append Blank eu uso commit, seria esse o problema ? ainda acontece exporadicamente, em outro usuário já não acontece outro sim outro não outro sim..... Gostaria de ler a opnião dos colegas e ainda alguma dica para solucionar o problema, abraços,
Honório

[ANDRIL]

Ola Hasa,

Esse problema aconteceu comigo e no meu caso verifiquei problema de indices. Para consertar, antes do append blank utilizei o comando set index to indice1, indice2... PARA ATUALIZAR OS INDICES.

No meu caso o usuario tinha como fazer uma procura em um dbedit() criando assim um indice temporario e quando calhava de apos a procura o usuario cadastrasse um item ou duplicava ou não aparecia apos o termino da rotina de inclusao.

Vale apena rever este ponto.

Abraços

[HASA]

Olá Andril, Boa Pascoa, eu já faço dessa forma, pois a uns anos atras tive problemas ao esquecer te incluir algum indice na inclusão, alteracão e Exclusão de dados, dai prá cá nunca mais esqueci de usar, he he he, creio que falta sincronismo por máquinas muito lentas ou coisa assim, mas na verdade não sei é claro. Valeu pela força, vamos ler mais opniões dos colegas com certeza vão me ajudar a chegar no ponto. :xau

[marbio]

Boa Noite,

Como vc esta abrindo o DBFs, com o indice, depois do APPEND BLANK, vc colocou o COMMIT a onde des vc o unlock para liberar o registro na rede, poste o PRGs para dar uma olha, qual e a rede que vc usa.....



SEMPRE A UMA LUZ NO FINAL DO TUNEU :*

[HASA]

Básicamente é isso:
SELE 1

IF .NOT. USEREDE("CAIXA",.F.,10)
MSG("O arquivo CAIXA não está disponível")
RETURN
ELSE
SET INDEX TO CAIXA001,CAIXA002,CAIXA003,CAIXA004
ENDIF

Janela coleta os dados etc....

Append Blank
replace etc...
COMMIT
UNLOCK

[marbio]

Ve se eu entendi!!!

A funcao basica mente esta certa

a duplicidade que tem no DBS e do cadastro e o sequencia ex:

Codigo
1 joao
2 marcio
3 pedro
3
4 maria
5 rita
6 jose
6

ou e o registro enteiro.

:*


Eu uso desta forma abixo: e nunca deu probelma tenho uns 11 terminal usando.

Código: Selecionar todos

*************************** Menu Principal
#include "common.ch"
#include "inkey.ch"
save screen to pro001
close
box3dr2(07,13,41,54)
box3df2(05,20,04,75)
setcolor(cor4)
cor3='r /nw,bg+/b,,,n/nw'
@03,15 say empresa
@01,05 say 'Usuario.: ' +user
@05,07 say ' Produto - Inclusao '
setcolor(cor2)


select 1                                               OBS use desta forma
if netuse("produto",.f.,10)
set index to pro001, pro002, pro003
else
   msgab()
   return
endif

select 2
if netuse("procod",.f.,10)
else
   msgab()
   return
endif


do while .t.
   xcodigo=0
   xnome=space(30)
   xlabora=space(20)
   xtipo=space(20)
   xcusto=0
   xmargem=0
   xvenda=0
   xvvenda=0
   xdesconto=0
   xestoque=0
   xminimo=0
   xbarra=space(13)
   xdep=space(2)
   xicms=0
   xcodf=0
   xemb=0
   xbon=0
   xgen=' '
   @08,07 say 'Barra....:' get xbarra pict '@!'
   @09,07 say 'Produto..:' get xnome pict '@!'
   @10,07 say 'Labora...:' get xlabora pict '@!'
   @11,07 say 'Tipo.....:' get xtipo pict '@!'
   @12,07 say 'Custo R$.:' get xcusto pict '@E 99,999,999.99'
   @12,40 say 'V. Venda.:' get xvvenda pict '@E 99,999,999.99' valid regra(xvvenda)
   @13,07 say 'Margem...:' get xmargem pict '999.99' valid porcento(xmargem)
   @14,07 say 'Venda.R$.:' get xvenda pict '@E 99,999,999.99'
   @15,07 say 'Desconto.:' get xdesconto pict '9999'
   @15,40 say 'Cod. Frac:' get xcodf pict '999999' 
   @16,07 say 'Dep......:' get xdep pict '@!'
   @16,40 say 'Embalagem:' get xemb pict '999'
   @17,07 say 'ICMS.....:' get xicms pict '99.99'
   @18,07 say 'Estoque..:' get xestoque pict '9999'
   @19,07 say 'Minimo...:' get xminimo pict '9999'
   @17,40 say 'Bonif....:' get xbon pict '@E 999.99'
*  @18,40 say 'Generico.:' get xgen pict '@!' valid xgen $ 'SN'
   read

*   if xgen="S"
*   if rlock()
*      save screen to tela
*      ge=space(200)
*      set color to w+/r
*      @12,05 clear to 19,65
*      @12,05 to 19,65 double
*      @12,25 say 'Cadastro dos Genericos'
*      @19,20 say 'Gravar (Ctrl+W) - Apagar Linha (Ctrl+Y)'
*     ge=memoedit(ge,13,06,18,64,.t.)
*      replace generico with memoedit(ge,13,06,18,64,.t.)
*      restore screen from tela
*   endif
*endif

setcolor(cor2)
   @22,05 say space(60)
   save screen to tela1
   box3dr2(10,14,27,39)
   @11,30 prompt 'Confirma'
   @12,30 prompt 'Cancela '
   @13,30 prompt '  Sair  '
   menu to xc
   do case
      case xc=1
         if xnome=space(30)
            restore screen from pro001
            do produto
         endif
         restore screen from tela1
         select 2
         if rlock()
            xcodigo=codcli
            replace codcli with codcli+1
            dbcommit()
            unlock
         endif
         @07,07 say 'Codigo...: ' +str(xcodigo)
         select 1
         append blank
         replace codigo    with xcodigo
         replace nome      with xnome
         replace labora    with xlabora  
         replace tipo      with xtipo  
         replace custo     with xcusto
         replace margem    with xmargem
         replace venda     with xvenda 
         replace vvenda    with xvvenda
         replace desconto  with xdesconto
         replace estoque   with xestoque 
         replace minimo    with xminimo
         replace data      with date()
         replace dept      with xdep
         replace icms      with xicms
         replace barra     with xbarra
         replace codf      with xcodf
         replace embalagem with xemb
         replace bonificado with xbon
         dbcommit()
         unlock
         inkey(0)
         @07,07 say 'Codigo...:                           '
      case xc=2
         do pro001
      case xc=3
         restore screen
         set key -1 to
         do produto
   endcase
   if lastkey()=27
      restore screen
      set key -1 to
      do produto
   endif
enddo

Tomara que de certo t+

[HASA]

Completando, é + ou - assim:
1 joao
2 marcio
3 pedro
4 maria
5 rita
6 jose
Até aqui ok, ai parece que quando o usuário sai da rotina o Clipper (ou sei lá o que) append tudo novamente na mesma ordem ouse seja
1 joao --->primeira
2 marcio --->primeira
3 pedro --->primeira
4 maria --->primeira
5 rita --->primeira
6 jose --->primeira
1 joao --->segunda
2 marcio --->segunda
3 pedro --->segunda
4 maria --->segunda
5 rita --->segunda
6 jose --->segunda

Exatamente uma abaixo da outra e de vez em quando NÃO é sempre, ai é que fica dificil de pegar.
Honório

[marbio]

Bom dia

Vc pode colocar o fonte inteiro para dar uma olha, se vc fizer = ao ex: acima vai dar certo, talvez pode ser na hora que vai gravar a sequencia do registro etc....

Tem que ter e solucao ok

t+

[HASA]

Ai vai !!!, você perceberá que eu tenho uma função que verifica duplicidade de registros, por isso posso afirmar que o problema não está no código e sim em algum outro MISTER, uso :
PCTERROR.OBJ
VL2_52.LIB
impbar.LIB
DIVIDE52.OBJ
TIMESLIC.OBJ
CTUSP.OBJ
LIB CTP,SUBNTX
LIB BLXCLP52.LIB

Código: Selecionar todos

*************************************
* TITULO     : CONTAS A PAGAR       *
* DATA       : 08/06/98             *
* PROGRAMA   : FNCI02.PRG           *
* COMENTARIO : INCLUSAO             *
* DIREITOS   : INFO2000 INFORMATICA *
*************************************

#INCLUDE "INKEY.CH"
#INCLUDE "VISUAL2.CH"

M->SOCORRO = "FNCI02" 

SELE 1

IF .NOT. USEREDE("CAIXA",.F.,10)
   MSG("O arquivo CAIXA nÆo est  dispon¡vel")
   RETURN
ELSE
   SET INDEX TO CAIXA001,CAIXA003,CAIXA004,CAIXA002,CAIXA005,CAIXA006,CAIXA007,CAIXA008,CAIXA009
ENDIF

SELE 2

IF .NOT. USEREDE("BANCOS",.F.,10)
   MSG("O arquivo BANCO nÆo est  dispon¡vel")
   RETURN
ELSE
   SET INDEX TO BANCO001,BANCO002
ENDIF

SELE 3

IF .NOT. USEREDE("DESPESAS",.F.,10)
   MSG("O arquivo DESPESAS nÆo est  dispon¡vel")
   RETURN
ELSE
   SET INDEX TO DESPE002,DESPE003,DESPE004
ENDIF

SELE 4

IF .NOT. USEREDE("HIST",.F.,10)
   MSG("O arquivo HIST nÆo est  dispon¡vel")
   RETURN
ELSE
   SET INDEX TO HIST001
ENDIF

SELE 5

IF .NOT. USEREDE("VENDEDOR",.F.,10)
   MSG("O arquivo VENDEDOR nÆo est  dispon¡vel")
   RETURN
ELSE
   SET INDEX TO VENDE010,VENDE009
ENDIF

SELE 6

IF .NOT. USEREDE("NATUREZA",.F.,10)
   MSG("O arquivo NATUREZA nÆo est  dispon¡vel")
   RETURN
ELSE
   SET INDEX TO NATUR003
ENDIF

SELE 7

IF .NOT. USEREDE("FORNECE",.F.,10)
   MSG("O arquivo FORNECE nÆo est  dispon¡vel")
   RETURN
ELSE
   SET INDEX TO FORNE001,FORNE002,FORNE003,FORNE004
ENDIF

SELE 8

IF .NOT. USEREDE("ESTATIST",.F.,10)
   MSG("O arquivo ESTATIST nÆo est  dispon¡vel")
   RETURN
ELSE
   SET INDEX TO MES
ENDIF

SELE 1

**
**

M->P_VERI = .T.
M->X_VERI = .F.
M->CNF_XXX=.T.
M->IN_CLUI=.T.
PRIMEIRA:=SAVESCREEN(0,0,24,79)
DO WHILE .T.
   **
   **
   DWNMSG("Tecle <ESC> para retornar")
   IF M->P_VERI
      **
      **
      IF M->CNF_XXX
         *
         * -> Inicializa variaveis
	 IF M->CNF_REP
	    M->CNF_XXX=.F.
	 ENDIF
         REGFNC02(1)
      ELSE
         M->X_VERI = .T.
      ENDIF
   ELSE
      M->X_VERI = .T.
      **
      **
   ENDIF
   *
   * -> Carrega tela de cadastro
   IF GETFNC02(IIF(M->AL_TERA,2,1))=.F.
      IF M->AL_TERA
         **
         **
         REGFNC02(2)
         M->X_VERI = .T.
         GETFNC02(5)
         BEEP()
         IF PERG("Registro j  cadastrado. Deseja alterar ?")="S"
            **
            **
            M->IN_CLUI=.F.
            M->P_VERI=.F.
         ELSE
            **
            **
            M->AL_TERA=.F.
         ENDIF
         LOOP
      ENDIF
      **
      **
      EXIT
   ENDIF
   **
   **
   IF PERG("Confirma as informa‡äes ?")="N"
      *
      * -> Faz reedicao
      M->P_VERI = .F.
      **
      **
      LOOP
   ENDIF
   M->P_VERI = .T.
   M->X_VERI = .F.
   **
   **
   IF M->IN_CLUI
      IF .NOT. ADIREG(0)
         M->P_VERI=.F.
         MSG("InclusÆo nÆo foi bem sucedida")
         DWNMSG("Tecle <ESC> para retornar")
         LOOP
      ENDIF
   ELSE
      IF .NOT. REGLOCK(20)
         BEEP()
         MSG("Atualiza‡Æo nÆo foi bem sucedida")
         DWNMSG("Tecle <ESC> para retornar")
         LOOP
      ENDIF
   ENDIF
   *
   * -> Atualiza o banco de dados
   SALFNC02(1)
   IF .NOT. M->IN_CLUI
      M->IN_CLUI=.T.
   ENDIF
   COMMIT
   UNLOCK
ENDDO
CLOSE DATABASES
RESTSCREEN(00,00,24,79,PRIMEIRA)
RETURN

**
**
 
FUNCTION VERFNC2
*
* -> Funcao que verifica duplicidade no arquivo "CAIXA"
PARA R_PARA
IF M->CODIGO = "0000000000" .OR. M->CODIGO = SPACE(10)
   MSG('N£mero da Duplicata nÆo pode ser zeros ou espa‡o em branco !!!')
   RETURN .F.
ENDIF
M->I_REG=RECN()
M->ORDEM = INDEXORD()
SET ORDER TO 1
GO TOP
SEEK "P"+M->CODIGO
IF M->I_REG=RECN() .AND. R_PARA=2
   SET ORDER TO M->ORDEM
   RETURN .T.
ENDIF
IF .NOT. EOF()
   IF R_PARA=2
      MSG("Registro j  cadastrado")
      DWNMSG("Tecle <ESC> para retornar")
      GOTO M->I_REG
      RETURN .F.
   ELSE
      M->AL_TERA=.T.
      CLEAR GETS
      SET ORDER TO M->ORDEM
      RETURN .T.
   ENDIF
ENDIF
SET ORDER TO M->ORDEM
GOTO M->I_REG
RETURN .T.
 
**
**

FUNCTION PSQ02001
*
* -> Funcao que faz pesquisas no banco de dados de Bancos
SELE 2
SET ORDER TO 1
GO TOP
SEEK STR(M->BANCO,4,0)
M->RETOR_NO=.T.
IF M->TEC_F2
   M->GET_CAM=READVAR()
   IF LEN(M->GET_CAM)<>0
      EDIT_ARQ(EMPTY(M->BANCO))
      IF LASTKEY()=13
         M->BANCO = NRO
      ENDIF
   ENDIF
ELSE
   @ 6,22 SAY SUBSTR(NOME,1,20) COLOR(C_DAD)
ENDIF
SELE 1
RETURN M->RETOR_NO
 
**
**

FUNCTION PSQ02002
*
* -> Funcao que faz pesquisas no banco de dados de Fornecedor
SELE 7
SET ORDER TO 3
GO TOP
SEEK STR(M->CODCLI,5,0)
M->RETOR_NO=.T.
IF M->TEC_F2
   M->GET_CAM=READVAR()
   IF LEN(M->GET_CAM)<>0
      EDIT_ARQ(EMPTY(M->CODCLI))
      IF LASTKEY()=13
         M->CODCLI = CODIGO
      ENDIF
   ENDIF
ELSE
   M->SACADO = SUBSTR(RAZAO,1,40)
   M->END = SUBSTR(ENDERECO,1,40)
   M->MUNICIPIO = SUBSTR(CIDADE,1,20)
   M->PCAPAGTO = SUBSTR(CIDADE,1,20)
   M->CEP = CEP
   M->ESTADO = ESTADO
   M->CGC = CGC
   M->INSC = SUBSTR(INSC_EST,1,15)
ENDIF
SELE 1
RETURN M->RETOR_NO
 
**
**

FUNCTION PSQ02003
*
* -> Funcao que faz pesquisas no banco de dados Historico
SELE 4
SET ORDER TO 1
GO TOP
SEEK M->DESCRICAO
M->RETOR_NO=.T.
IF (EOF() .AND. LASTKEY()<>5) .OR. M->TEC_F2
   M->GET_CAM=READVAR()
   IF LEN(M->GET_CAM)<>0
      EDIT_ARQ(EMPTY(M->DESCRICAO))
      IF LASTKEY()=13
         M->DESCRICAO = HISTORICO+SPACE(5)
      ENDIF
   ENDIF
ELSE
   M->DESCRICAO = HISTORICO+SPACE(5)
ENDIF
SELE 1
RETURN M->RETOR_NO
 
**
**

FUNCTION PSQ02004
*
* -> Funcao que faz pesquisas no banco de dados de Natureza
SELE 6
SET ORDER TO 1
GO TOP
SEEK M->OPERACAO
M->RETOR_NO=.T.
IF M->TEC_F2
   M->GET_CAM=READVAR()
   IF LEN(M->GET_CAM)<>0
      EDIT_ARQ(EMPTY(M->OPERACAO))
      IF LASTKEY()=13
         M->OPERACAO = CODIGO
      ENDIF
   ENDIF
ELSE
   @ 9,25 SAY NATUREZA COLOR(C_DAD)
ENDIF
SELE 1
RETURN M->RETOR_NO
 
**
**

FUNCTION PSQ02005
*
* -> Funcao que faz pesquisas no banco de dados Vendedor
SELE 5
SET ORDER TO 1
GO TOP
SEEK STR(M->VENDEDOR,5,0)
M->RETOR_NO=.T.
IF M->TEC_F2
   M->GET_CAM=READVAR()
   IF LEN(M->GET_CAM)<>0
      EDIT_ARQ(EMPTY(M->VENDEDOR))
      IF LASTKEY()=13
         M->VENDEDOR = CODIGO
      ENDIF
   ENDIF
ENDIF
SELE 1
RETURN M->RETOR_NO
 
**
**

FUNCTION REGFNC02
*
* -> Carrega variaveis para entrada ou altercao de dados

PARA R_CAR

PUBLIC TIPO,CODIGO,NUMERO,VALOREAL,CODCLI,DESCRICAO,BANCO,DTEMISS,DTVENC
PUBLIC DTBAIXA,VRCONTA,VRPAGO,DOCTO,TIPODOC,MATRIZ,DUPLICATA,BOLETO,VENDEDOR
PUBLIC TRANSP,DESCONTO,SOBRE,ATE,CONDICOES,SACADO,END,MUNICIPIO,ESTADO,CEP
PUBLIC PCAPAGTO,CGC,INSC,LOCAL,INSTRU,INSTRU1,OBS,OPERACAO,DTPAG,NROBCO
PUBLIC IPI,ICMS

IF M->R_CAR=1
   M->TIPO="P"
   M->CODIGO=SPACE(10)
   M->NUMERO=0
   M->VALOREAL=0
   M->CODCLI=0
   M->DESCRICAO=SPACE(40)
   M->BANCO=0
   M->DTEMISS=D_DAT
   M->DTVENC=CTOD("")
   M->DTPAG=CTOD("")
   M->DTBAIXA=CTOD("")
   M->VRCONTA=0
   M->VRPAGO=0
   M->DOCTO=SPACE(16)
   M->TIPODOC=SPACE(10)
   M->MATRIZ=SPACE(1)
   M->DUPLICATA="S"
   M->BOLETO="S"
   M->VENDEDOR=0
   M->OPERACAO=SPACE(7)
   M->TRANSP=SPACE(5)
   M->DESCONTO=0
   M->SOBRE=SPACE(10)
   M->ATE=SPACE(15)
   M->CONDICOES=SPACE(40)
   M->SACADO=SPACE(40)
   M->END=SPACE(40)
   M->MUNICIPIO=SPACE(20)
   M->ESTADO=SPACE(2)
   M->CEP=SPACE(9)
   M->PCAPAGTO=SPACE(20)
   M->CGC=SPACE(19)
   M->INSC=SPACE(15)
   M->LOCAL="PAGAVEL EM QUALQUER BCO ATE O VENCIMENTO"
   M->INSTRU=SPACE(40)
   M->INSTRU1=SPACE(40)
   M->OBS=SPACE(60)
   M->NROBCO=SPACE(20)
   M->IPI=0
   M->ICMS=0
   **
   **
ELSE
   M->TIPO=TIPO
   M->CODIGO=CODIGO
   M->NUMERO=NUMERO
   M->VALOREAL=VALOREAL
   M->CODCLI=CLIENTE
   M->DESCRICAO=DESCRICAO
   M->BANCO=BANCO
   M->DTEMISS=DTEMISS
   M->DTVENC=DTVENC
   M->DTPAG=DTPAG
   M->DTBAIXA=DTBAIXA
   M->VRCONTA=VRCONTA
   M->VRPAGO=VRPAGO
   M->DOCTO=DOCTO
   M->TIPODOC=TIPODOC
   M->MATRIZ=MATRIZ
   M->DUPLICATA=DUPLICATA
   M->BOLETO=BOLETO
   M->VENDEDOR=VENDEDOR
   M->OPERACAO=OPERACAO
   M->TRANSP=TRANSP
   M->DESCONTO=DESCONTO
   M->SOBRE=SOBRE
   M->ATE=ATE
   M->CONDICOES=CONDICOES
   M->SACADO=SACADO
   M->END=END
   M->MUNICIPIO=MUNICIPIO
   M->ESTADO=ESTADO
   M->CEP=CEP
   M->PCAPAGTO=PCAPAGTO
   M->CGC=CGC
   M->INSC=INSC
   M->LOCAL=LOCAL
   M->INSTRU=INSTRU
   M->INSTRU1=INSTRU1
   M->OBS=OBS
   M->NROBCO=NROBCO
   M->IPI=IPI
   M->ICMS=ICMS
   **
   **
ENDIF
 
**
**

FUNCTION GETFNC02
*
* -> Formata a tela para entrada ou alteracao de dados
PARA R_CAR
IF R_CAR<>5
   M->AL_TERA=.F.
ENDIF
**
**
CLRTED()
**
FRAME(02,03,22,78,"InclusÆo de Contas a Pagar", 2, Nil, Nil, "B/W")
**
*
* -> Monta cercaduras
@ 10,04 TO 10,77
@ 15,04 TO 15,77
IF M->X_VERI
    PSQ02003()
    PSQ02001()
    PSQ02004()
ENDIF
*
* -> Monta tela de cadastro
@  3, 5 SAY "Tipo......:" GET M->TIPO PICT "@!" VALID M->TIPO = "P" COLOR(C_DAD)
CLEAR GETS
@ 03,46 SAY "Duplicata..........:" GET M->CODIGO PICT "@!" VALID ZEROS() .AND. VERFNC2(M->R_CAR) COLOR(C_DAD)
@ 04,05 SAY "EmissÆo...:" GET M->DTEMISS COLOR(C_DAD)
@ 04,28 SAY "Baixa:" GET M->DTBAIXA COLOR(C_DAD) VALID IIF(M->DTBAIXA < M->DTEMISS .AND. M->DTBAIXA # CTOD(''),MENSAGEM("Data da Baixa menor que a Data de EmissÆo"),.T.)
@ 04,46 SAY "Nota Fiscal........:" GET M->NUMERO PICT "9999999999" COLOR(C_DAD)
@ 05,05 SAY "Vencto....:" GET M->DTVENC COLOR(C_DAD) VALID IIF(M->DTVENC < M->DTEMISS .AND. M->DTVENC # CTOD(''),MENSAGEM("Data da Vencimento menor que a Data de EmissÆo"),.T.)
@ 05,28 SAY "Pagto:" GET M->DTPAG COLOR(C_DAD) VALID IIF(M->DTPAG < M->DTEMISS .AND. M->DTPAG # CTOD(''),MENSAGEM("Data do Pagamento menor que a Data de EmissÆo"),.T.)
@ 05,46 SAY "Valor Total....:" GET M->VALOREAL PICT "@E. 999,999,999.99" COLOR(C_DAD)
@ 06,05 SAY "Banco.....:" GET M->BANCO PICT "9999" VALID PSQ02001() COLOR(C_DAD)
@ 06,46 SAY "Valor Duplicata:" GET M->VRCONTA PICT "@E. 999,999,999.99" COLOR(C_DAD)
@ 07,05 SAY "C.Contabil:" GET M->DESCRICAO PICT "@!" VALID PSQ02003() COLOR(C_DAD)
@ 07,62 SAY "IPI:" GET M->IPI PICT "@E. 999,999.99" COLOR(C_DAD)
@ 08,05 SAY "Vendedor..:" GET M->VENDEDOR PICT "99999" VALID PSQ02005() COLOR(C_DAD)
@ 08,26 SAY "Nr. Banc rio:" GET M->NROBCO PICT "@!" COLOR(C_DAD)
@ 08,61 SAY "ICMS:" GET M->ICMS PICT "@E. 999,999.99" COLOR(C_DAD)
@ 09,05 SAY "Opera‡Æo..:" GET M->OPERACAO PICT "@!" VALID PSQ02004() COLOR(C_DAD)
@ 09,50 SAY "Tipo Transporte:" GET M->TRANSP PICT "@!" COLOR(C_DAD)
@ 11,05 SAY "Fornecedor:" GET M->CODCLI PICT "99999" VALID PSQ02002() COLOR(C_DAD)
@ 11,23 GET M->SACADO PICT "@!" COLOR(C_DAD)
@ 12,05 SAY "Endere‡o..:" GET M->END PICT "@!" COLOR(C_DAD)
@ 12,58 SAY "Cep....:" GET M->CEP PICT "@!" COLOR(C_DAD)
@ 13,05 SAY "Cidade....:" GET M->MUNICIPIO PICT "@!" COLOR(C_DAD)
@ 13,38 SAY "UF..:" GET M->ESTADO PICT "@!" COLOR(C_DAD)
@ 13,48 SAY "P‡a Pg:" GET M->PCAPAGTO PICT "@!" COLOR(C_DAD)
@ 14,05 SAY "CNPJ\CPF..:" GET M->CGC PICT "###.###.###/####-##" COLOR(C_DAD)
@ 14,44 SAY "I.E.\R.G..:" GET M->INSC PICT "@!" COLOR(C_DAD)
@ 16,05 SAY "Local.....:" GET M->LOCAL PICT "@!" COLOR(C_DAD)
@ 16,59 SAY "J  Imp. Dupl ?:" GET M->DUPLICATA PICT "@!" COLOR(C_DAD)
@ 17,05 SAY "Instru‡Æo.:" GET M->INSTRU PICT "@!" COLOR(C_DAD)
@ 17,59 SAY "J  Imp. Bol. ?:" GET M->BOLETO PICT "@!" COLOR(C_DAD)
@ 18,17 GET M->INSTRU1 PICT "@!" COLOR(C_DAD)
@ 19,05 SAY "Desconto..:" GET M->DESCONTO PICT "99.99" COLOR(C_DAD)
@ 19,24 SAY "Sobre" GET M->SOBRE PICT "@!" COLOR(C_DAD)
@ 19,42 SAY "At‚" GET M->ATE PICT "@!" COLOR(C_DAD)
@ 20,05 SAY "Condi‡äes.:" GET M->CONDICOES PICT "@!" COLOR(C_DAD)
@ 21,10 SAY "Obs..:" GET M->OBS PICT "@!" COLOR(C_DAD)
**
**
IF M->R_CAR=5
   CLEAR GETS
   RETURN .F.
ENDIF
IF M->R_CAR=3 .OR. M->R_CAR=0
   CLEAR GETS
   IF M->R_CAR=0
      RETURN .T.
   ENDIF
   DWNMSG("Tecle algo para continuar")
   M->R_X=INKEY(0)
   IF M->R_X=27
      RETURN .F.
   ENDIF
ELSE
   SET CURSOR ON
   VLREAD                                                
   SET CURSOR OFF
   IF M->AL_TERA
      RETURN .F.
   ENDIF
   IF LASTKEY()=27
      RETURN .F.
   ENDIF
ENDIF
RETURN .T.
 
**
**

FUNCTION SALFNC02
*
* -> Salva o conteudo das variaveis de entrada no arquivo
PARA DEONDE

REPLACE TIPO WITH M->TIPO
REPLACE CODIGO WITH M->CODIGO
REPLACE NUMERO WITH M->NUMERO
REPLACE VALOREAL WITH M->VALOREAL
REPLACE CLIENTE WITH M->CODCLI
REPLACE DESCRICAO WITH M->DESCRICAO
REPLACE BANCO WITH M->BANCO
REPLACE VENDEDOR WITH M->VENDEDOR
REPLACE DTEMISS WITH M->DTEMISS
REPLACE DTVENC WITH M->DTVENC
REPLACE DTPAG WITH M->DTPAG
REPLACE DTBAIXA WITH M->DTBAIXA
REPLACE VRCONTA WITH M->VRCONTA
REPLACE VRPAGO WITH M->VRPAGO
REPLACE DOCTO WITH M->DOCTO
REPLACE TIPODOC WITH M->TIPODOC
REPLACE MATRIZ WITH "S"
REPLACE DUPLICATA WITH M->DUPLICATA
REPLACE BOLETO WITH M->BOLETO
REPLACE OPERACAO WITH M->OPERACAO
REPLACE TRANSP WITH M->TRANSP
REPLACE DESCONTO WITH M->DESCONTO
REPLACE SOBRE WITH M->SOBRE
REPLACE ATE WITH M->ATE
REPLACE CONDICOES WITH M->CONDICOES
REPLACE SACADO WITH M->SACADO
REPLACE END WITH M->END
REPLACE MUNICIPIO WITH M->MUNICIPIO
REPLACE ESTADO WITH M->ESTADO
REPLACE CEP WITH M->CEP
REPLACE PCAPAGTO WITH M->PCAPAGTO
REPLACE CGC WITH M->CGC
REPLACE INSC WITH M->INSC
REPLACE LOCAL WITH M->LOCAL
REPLACE INSTRU WITH M->INSTRU
REPLACE INSTRU1 WITH M->INSTRU1
REPLACE OBS WITH M->OBS
REPLACE NROBCO WITH M->NROBCO
REPLACE IPI WITH M->IPI
REPLACE ICMS WITH M->ICMS
COMMIT
UNLOCK

IF DEONDE = NIL
   RETURN
ENDIF

IF M->DTPAG = D_DAT .OR. M->DTBAIXA = D_DAT
   *********************** BAIXA DO CAIXA **************************
   ************ VARIAVEIS DE TRANSPORTE **************
   DTPAG1=DATE()
   DTBAIXA1=DATE()
   VRPAGO1=0
   DOCTO1=SPACE(16)
   TIPODOC1=SPACE(10)           
   ****************************************************
   OJAN10:=WIN(10,12,18,58,"B A I X A",,WD_AZUL1CINZA)
   @ 12,17 SAY "Pagamento......:" GET DTPAG1 COLOR(C_DAD)
   @ 13,17 SAY "Data Baixa.....:" GET DTBAIXA1 COLOR(C_DAD)
   @ 14,17 SAY "Vlr Pago.......:" GET VRPAGO1 PICT "@E 9,999,999,999.99" COLOR(C_DAD)
   @ 15,17 SAY "Documento......:" GET DOCTO1 PICT "@!" COLOR(C_DAD)
   @ 16,17 SAY "Tipo Documento.:" GET TIPODOC1 PICT "@!" VALID LO_CAL() COLOR(C_DAD)
   SET CURSOR ON
   READ                 
   SET CURSOR OFF
   IF PERG("Confirma os dados da Baixa ?")="S"
      ******
      SELE 1
      ******
      IF .NOT. REGLOCK(20)
         MSG("Atualiza‡Æo nÆo foi bem sucedida")
         RSTENV(OJAN10)
         RETURN
      ENDIF
      REPLACE DTPAG WITH DTPAG1
      REPLACE DTBAIXA WITH DTBAIXA1
      REPLACE VRPAGO WITH VRPAGO1
      REPLACE DOCTO WITH DOCTO1
      REPLACE TIPODOC WITH TIPODOC1
      COMMIT
      UNLOCK

      ******
      SELE 3
      ******
      IF .NOT. ADIREG(0)
         MSG("InclusÆo nÆo foi bem sucedida")
         RSTENV(OJAN10)
         RETURN
      ENDIF                                                    

      REPLACE DT WITH DATE(),VALOR WITH VRPAGO1,TP WITH "PAGAMENTO DE DUPLICATA"
      REPLACE OPERACAO WITH "D",SALDO WITH VRPAGO1,PLAKA WITH "BAIXADB"
      REPLACE HISTORICO WITH "DUPLICATA PAGA COM "+TIPODOC1
      COMMIT
      UNLOCK

      ******
      SELE 8
      ******
      M->ANO=YEAR(D_DAT)
      M->MES=MONTH(D_DAT)
      GO TOP
      SEEK STR(M->ANO,4,0)+STR(M->MES,2,0)
      IF FOUND()
         IF .NOT. REGLOCK(20)
            MSG("Atualiza‡Æo nÆo foi bem sucedida")
            RSTENV(OJAN10)
            RETURN
         ENDIF
         REPLACE DESPESAS WITH DESPESAS+VRPAGO1
         COMMIT
         UNLOCK
      ELSE
         IF .NOT. ADIREG(0)
            MSG("InclusÆo nÆo foi bem sucedida")
            RSTENV(OJAN10)
            RETURN
         ENDIF                                                    
         REPLACE DESPESAS WITH VRPAGO1,ANO WITH M->ANO,MES WITH M->MES
         COMMIT
         UNLOCK
      ENDIF
   ENDIF   
   RSTENV(OJAN10)
   ******
   SELE 1
   ******
ENDIF

**
** Final do programa FNCI02.PRG

[HASA]

:-O
Marbio, analisando o código que postei, acredito que localizei o problema, veja se concorda comigo, faço a chamada a funcão SALFNC02(1), lá dou commit e unlock e faço outros procedimentos em outros sele's, depois volto para o sele 1 (o sele das duplicidades) e novamente dou commit e unlock, ai deve acontecer a duplicidade, o banco de dados está aberto e o commit força a gravação do que está na memoria, ou seja a seqüencia sempre bate, CREIO eu !!! :*

[marbio]

Ola!!

Analizando desta forma vai dar certo vc vai testar isso hoje ou sa na segunda feira,

fico no aguardo..........

-:] :*

[HASA]

A partir de segunda, como disse hora acontece hora não, e ainda terei que atualizar o sistema de algum dos clientes e esperar que não aconteça, mas de qualquer forma valeu mesmo. :xau

[Jorge Adourian]

Meu caro HASA, se entendi bem, você está achando que se chamar o DBCOMMIT() 2 vezes grava 2 vezes, e que se chamasse o DBCOMMIT() 10 vezes gravaria 10 vezes. Se é isto que você está achando...Esqueça, e não perca seu tempo testando porque isto não acontece.

O DBCOMMIT não cria duplicidades em hipótese alguma.

O mais provavel é que exista um erro de lógica.

[HASA]

A principio era uma boa idéia, não tinha multiplicado por 10.
Voltamos a estaca ZERO !!!
Honório

[marbio]

Ola!!

Vc deve verificar a onde que gera a sequencia de arquivo. Igual nosso amigo ai estava falanco sobre o commit , ele e so para descaregar o buffer(forcar a gravacao).

O seu problema esta na sequencia, de registro.

Vc nao tem nenhum DBF de seguincia de registro para controlar.


me corrige se eu estiver errado.

t+