Perda de Dados no xHarbour

[wagner aragao]

Olá,

Tenho programa em produção em Clipper 5.2e e migrei para xHarbour 1.0.0 Simplex e agora to com 1.2.1 Simplex, as mesmas rotinas estão rodando em clipper e em xHarbour, ou seja os dois programas estão em produção em versões diferentes, o problema esta na versão xHarbour a mesma rotina de gravação de dados que funciona sem problemas a 12 anos, de vez em quando simplesmente não funciona. O problema acontece na baixa de contas a receber (rotina besta) que simplesmente não baixa 1 conta entre 50 em um dia por exemplo, e a mesma rotina funciona sem problema em outros cliente com clipper. Na clipper uso DBFSIX e na xHARBOUR DBFCDX alguém sabe de algum problema na atualizaçào no xHarbour, ja coloquei inclusive o dbcommit() apos cada grupo de replace e não no final do processo, mais não resolveu. A rotina que uso está abaixo :

T+

Código: Selecionar todos

funct BAIXA_CR
**************************************
* PROGRAMA   : BAIXA_CR.PRG
* FINALIDADE : Baixar CONTAS a RECEBER
**************************************
private CUR_ANT   := setcolor(),;
        RecFiscal := ResultAlert:= Autentica := 0,;
        vLANCA_CX :=vLANCA_MB:=' ',;
        RespBaixa := RespBX:= 0
if !p_ImpFiscal(.t.)
   return(.f.)
endif
do while .t.
   set key -11 to VEXTCLI()
   LigaF9()
   vJUROS=0
   set colo to
   sele RECEBER
   cria_var()
   ARQUIVO=dbf()

   PRG='Recbto Credito'
   scroll(03,00,22,79,00)
   menus('06','00','19','79','')
   informa('Contas Receber','PRG',06,19)
	
	
   @ 19,30 say ' <Shift+F2>=Consulta '
   set inte on
   limpa(24)
   *** Ativa a busca de CR ***
   if !BuscaCR()
      exit
   endif
   *** verifica se o cliente esta bloqueado ***
   CUR_ANT=setcolor()
   if cadcli->BLOQ .and. !'CICO'$upper(FUNDO) .and. !'IVEL'$upper(FUNDO)
      save scree to TBL
      mensagem('Cliente com restricoes, COMUNIQUE A GERENCIA...')
      CMEMO = cadcli->MEMO
      menus('08','05','20','75',' Informacoes Bloqueio ')
      @ 22,04 say 'Ý<ESC>=FIM Þ'
      memoedit(CMEMO,09,06,19,74,.f.,'FUNCMEMO',100)
      resto scree from TBL
      setcolor(CUR_ANT)
   endif
   sele RECEBER
   igual_var()

   vVLR_ARCo := VALOR_ARC
   vVLR_RECo := VALOR_REC
   mCOD_VEND := COD_VEND
   mCOD_CONTA:= COD_CONTA
   mCUSTEIO  := CUSTEIO
   mD        := D
   mDATA_CAD := DATA_CAD
   *** Calcula Juros + Multa se esta vencida e estourou o prazo de carencia ***
   vTOT_JUR  := vTOT_DESC := 0
   DIAS      := date() - DATA_VENC
   COR_JUROS := setcolor()
   vCUSTEIO  := vCUSTEIO+vD  
   @ 12,02 say '  Data Cadastro Äþ' get vDATA_CAD
   @ 13,02 say 'Data Vencimento Äþ' get vDATA_VENC
   @ 14,02 say ' Vlr Receber R$ Äþ' get vVALOR_ARC   pict '@E 9,999,999.99'
   @ 15,02 say '      Historico Äþ' get vHIST
   @ 15,60 say 'Origem Äþ'          get vNROVENDA
   @ 16,02 say ' Local Cobranca Äþ' get vLOCAL
   @ 17,02 say 'Centro de Custo Äþ' get vCUSTEIO
   p_cencusto(vCUSTEIO,.t.)
   if mCOD_VEND>0
      @ 18,02 say '       Vendedor Äþ' get mCOD_VEND pict '9999'
      p_vendedor(mCOD_VEND,.t.)
   endif
   clea gets
   limpa(24)
   ALTERA=.F.
   F10=.T.
   ResultAlert=0
   *** Grava tela para reapresentar ***
   MudaTela=savescreen(06,00,19,79) 
   
   if VALOR_REC>0
      *** Mostra Dados do Recebimento ***
      *** Restaura tela subindo linhas ***
      restscreen(03,00,16,79,MudaTela)   
      quadro('16','00','23','79',' Baixa Contas a Receber ' + iif( !empty(receber->DT_E_SPC) ,'(no SPC desde '+dtoc(DT_E_SPC)+')',''), VerdeAzulVerm )
	  DadosRec()
	  clear gets
      limpa(24)
      centra_msg(24,'Tecle <ENTER> p/continuar')
      inkey(0)
      ResultAlert = MsgAlert('Conta JA foi recebida...<ESC> p/retornar','Atencao',{'Retornar','Imprimir Recibo','Ver Auditoria'})
      if ResultAlert=1 
         loop
      endif
      *** Emite Recibo de Quitacao em Impressora NAO fiscal ***
      if ResultAlert=2
         if VALOR_REC>VALOR_ARC
            vTXTREC='D E B I T O  J'
         else
            vTXTREC='D E B I T O   '
         endif
         do R_RECIBO with vTXTREC,'R'
         loop
      endif
      if ResultAlert=3
         quadro('08','50','14','78',' Auditoria ', BcoAzulVerm )		
  	      limpa(24)
         centra_msg(24,'Tecle <ENTER> p/Retornar')
         @ 09,52 say 'Quem Baixou Äþ ' + trim(receber->QUEMBLOQ)
         @ 10,52 say '       Data Äþ ' + dtoc(receber->DT_BLOQ)
         @ 11,52 say '       Hora Äþ ' + receber->HORA_BLOQ 
         @ 12,52 say '    Maquina Äþ ' + receber->MAQ_BLOQ
         @ 13,52 say '     Rotina Äþ ' + receber->ROTINA
		   inkey(0)
         loop
      endif
      sele RECEBER
      ALTERA := .T.
   else
      centra_msg(24,'RECEBER ESTA CONTA ?')
      if SimNao(24)<>1
         loop
      endif
      vDATA_REC  := date()
      vVALOR_REC := vVALOR_ARC
   endif
   RespBaixa=0
   if vDATA_REC<vDATA_VENC .and. receber->VALOR_REC=0
      RespBaixa=MsgAlert('Este titulo ainda NAO venceu. Considerar a baixa como pagamento antecipado do cliente ? ','Atencao',{'SIM=Recebimento Cliente','NAO=Antecipacao Titulo'})
   endif
   if vANTEC
      mensagem('Este titulo teve seu recebimento antecipado no dia '+dtoc(vDATA_REC)+'...')
   endif
   vLANCA_CX:=vLANCA_MB:=' '
   *** ver se lanca automatico recebimento no caixa ***
   if vBX_CR_CX
      vLANCA_CX='X'
   endif
   *** Restaura tela subindo linhas ***
	restscreen(03,00,16,79,MudaTela)   
   quadro('16','00','23','79',' Baixa Contas a Receber ' + iif( !empty(receber->DT_E_SPC) ,'(no SPC desde '+dtoc(DT_E_SPC)+')',''), VerdeAzulVerm )
   limpa(24)
   centra_msg(24,'Informe os Dados da Baixa ou <ESC> p/retornar')
   @ 17,02       say 'TOTAL A RECEBERÄþ '+ transf(vVLR_REC1,'@E 999,999.99')
   *** Mostra dados do recebimento ***
   DadosRec()
   read
   *** Verifica se foi fornecido a forma de recebimento ***
   if vCOD_REC1 + vCOD_REC2 + vCOD_REC3 = 0
      mensagem('Nao foi informado a Forma de Recebimento...Corrija')
      loop
   endif
   *** verifica N§ de Dias de Baixa Retroativa ***
   if (date() - vDATA_REC) > vMAX_DIAS
      mensagem('Atencao !!! A baixa com data retroativa esta limitada a '+str(vMAX_DIAS,2)+' dias...')
      loop
   endif
   *** Renomeio as variaveis para garantir gravacao ***
   mDATA_REC :=vDATA_REC
   mVALOR_REC:=vVALOR_REC
   mBANCO    :=vBANCO
   mCHEQUE   :=vCHEQUE
   mCOD_COB  :=vCOD_COB
   mCOD_REC1 :=vCOD_REC1
   mCOD_REC2 :=vCOD_REC2
   mCOD_REC3 :=vCOD_REC3
   mVLR_REC1 :=vVLR_REC1
   mVLR_REC2 :=vVLR_REC2
   mVLR_REC3 :=vVLR_REC3
   confirma()
   if CONF<>'S' .or.lastkey()=27
      loop
   endif
   sele RECEBER
   DbSetOrder(2)
   seek mCOD_CONTA
   if vCHEQUE=0 .and. !ALTERA
      mensagem('NAO posso realizar baixa, numero CHEQUE=ZERO...')
      loop
   endif
   *** verifica se foi solicitado para baixar no caixa e se caixa esta fechado ***
   if vLANCA_CX='X'   .and. CloseCX(vDATA_REC,vCUSTEIO,vD) .or. ;
      setup->BX_CR_CX .and. CloseCX(vDATA_REC,vCUSTEIO,vD)
      loop
   endif
   if vLANCA_MB='X'
      do while .t.
         limpa(24)
         centra_msg(24,'DIGITE OS DADOS DA CONTA A SER FEITO O CREDITO')
         setcolor('B/W+')
         @ 17,12 to 22,69 double
         @ 22,12 say 'Ê'
         @ 22,69 say 'Ê'
         scroll(18,13,21,68,00)
         setcolor('N/BG')
         centra_msg(17,' DADOS DO LANCAMENTO BANCARIO ')
         @ 19,15 say 'Dt Lancto  Banco  Agencia     Conta     Valor Lancto'
         set colo to
         vAGENCIA :=vCONTABCO:=0
         vDATA_MOV:=date()
         vVALOR   :=vVALOR_REC
         @ 20,14      get vDATA_MOV
         @ 20,col()+3 get vBANCO    pict '999'          valid(vBANCO>0)
         @ 20,col()+5 get vAGENCIA  pict '99999'        valid(vAGENCIA>0)
         @ 20,col()+3 get vCONTABCO pict '999999999-9'  valid(vCONTABCO>0)
         @ 20,col()+1 get vVALOR    pict '99999999.99'  valid(vVALOR>0)
         read
         sele CADBANCO
         loca for vBANCO=BANCO.and.vAGENCIA=AGENCIA.and.vCONTABCO=CONTA
         if eof()
            mensagem('Banco NAO cadastrado...')
            LANCAR='N'
         else
            confirma()
            if CONF<>'S'.or.lastkey()=27
               loop
            endif
            reglock(.f.)
            repla SALDO with SALDO + vVALOR
            *** Auditoria de alteracao ***
            AuditAlt(procname())
            DbCommit()
            DbUnlock()            
            exit
         endif
      enddo
      *** verifica se foi solicitado para baixar no banco e se caixa movimento esta fechado ***
      if vLANCA_MB='X' .and. !CloseCB(vDATA_MOV,vBANCO,vAGENCIA,vCONTABCO)
         loop
      endif
   endif
   CAD_DIF:=' '
   CAD_JUR:='N'
   do case
      case vVALOR_REC < vVALOR_ARC + vTOT_JUR - vTOT_DESC .and. vVALOR_REC > 0 .and. vCJUR_DIF
           *** Cadastramento da Diferenca caso o recebimento esteja menor que o valor ***
           *** a receber + juros ou ainda se o valor principal nao foi recebido 
           RespBX = MsgAlert('ATENCAO !!! O Valor Recebido esta Menor que o Valor a Receber+Juros...','Atencao',{'Retornar','Cadastrar Diferenca ','Baixar com Desconto'})
           do case
              case RespBX = 1
                   loop
              case RespBX = 2
                   *** Cadastra a Diferenca da Conta ***
                   RespRec  = MsgAlert('Emitir Recibo de Quitacao ? ','Atencao',{' NAO ',' SIM '})
                   CAD_DIF='S'
                   if RespRec = 2
                      do R_RECIBO with 'P A R C I A L ','R'
                   endif
              case RespBX = 3
                   if !'CARTAO ' $ upper(cadcli->CLIENTE)
                      *** Atualiza a auditoria de baixas com diferenca ***
                      vDIFERENCA = (vVALOR_ARC + vTOT_JUR - vTOT_DESC) - vVALOR_REC

                      *** Grava LOG de auditoria ***
                      vHISTORICO = 'DESC.CR-' + vCOD_CONTA+'-'+str(vCOD_CLI,5)+'-'+left(cadcli->CLIENTE,30)+'-'+vTIPO_DOC+' '+str(vNUM_DOC,7)+'-'+transf(vDIFERENCA,'@E 99,999.99')+vD
                      auditoria(vHISTORICO)
                      RespRec  = MsgAlert('Emitir Recibo de Quitacao ? ','Atencao',{' NAO ',' SIM '})
                      if RespRec = 2
                         do R_RECIBO with 'D E B I T O  D','R'
                      endif
                   endif
           endcase
      case vVALOR_REC < vVALOR_ARC - vTOT_DESC .and. vVALOR_REC > 0 .and. !vCJUR_DIF
           *** Cadastramento da Diferenca SEM considerar os juros ***
           RespBX = MsgAlert('ATENCAO !!! O Valor Recebido esta Menor que o Valor a Receber...','Atencao',{'Retornar','Cadastrar Diferenca ','Baixar com Desconto'})
           do case
              case RespBX = 1
                   loop
              case RespBX = 2
                   *** Cadastra a Diferenca da Conta ***
                   RespRec  = MsgAlert('Emitir Recibo de Quitacao ? ','Atencao',{' NAO ',' SIM '})
                   CAD_DIF='S'
                   if RespRec = 2
                      do R_RECIBO with 'P A R C I A L ','R'
                   endif
              case RespBX = 3
                   *** Atualiza a auditoria de baixas com diferenca ***
                   vDIFERENCA = (vVALOR_ARC + vTOT_JUR - vTOT_DESC) - vVALOR_REC
                   *** Grava LOG de auditoria ***
                   vHISTORICO = 'DESC.CR-' + vCOD_CONTA+'-'+str(vCOD_CLI,5)+'-'+left(cadcli->CLIENTE,30)+'-'+vTIPO_DOC+' '+str(vNUM_DOC,7)+'-'+transf(vDIFERENCA,'@E 99,999.99')+vD
                   auditoria(vHISTORICO)
                   RespRec  = MsgAlert('Emitir Recibo de Quitacao ? ','Atencao',{' NAO ',' SIM '})
                   if RespRec = 2
                      do R_RECIBO with 'D E B I T O  D','R'
                   endif
           endcase

      case vVALOR_REC>vVALOR_ARC .and. vCONTABIL .and. !setup->JUROS_SEP
           *** Lancamento de Juros em Conta Separada ***
           CAD_JUR=' '
           if empty(setup->CONTAJURR)
              mensagem('ATENCAO !!! Valor Recebido MAIOR que o Valor a Receber...')
              limpa(24)
              @ 24,15 say 'Cadastrar Juros em Conta Separada ? (S/N) ' get CAD_JUR pict '!' valid(CAD_JUR$'SN')
              read
              vCONTA_JUR=vCONTA
              if CAD_JUR='S'
                 menus('11','10','13','70',' Lancto de Juros ')
                 @ 12,12 say 'Conta Äþ' get vCONTA_JUR pict (vMASC_CONT)  valid(p_plano(vCONTA_JUR,.t.,'C'))
                 read
                 vJUROS     = vVALOR_REC - vVLR_ARCo
                 vVALOR_REC = vVLR_ARCo
              endif
           else
              *** Se realmente for uma conta ***
              if left(setup->CONTAJURR,3)<>'999'
                 CAD_JUR    = 'S'
                 vCONTA_JUR = setup->CONTAJURR
                 vJUROS     = vVALOR_REC - vVLR_ARCo
                 vVALOR_REC = vVLR_ARCo
              endif
           endif
           RespRec  = MsgAlert('Emitir Recibo de Quitacao ? ','Atencao',{' NAO ',' SIM '})
           if RespRec = 2
              do R_RECIBO with 'C/ J U R O S J','R'
           endif
      other
           *** Conta Baixada normalmente pode emitir recibo de quitacao ***
           RespRec  = MsgAlert('Emitir Recibo de Quitacao ? ','Atencao',{' NAO ',' SIM '})
           if RespRec = 2
              do R_RECIBO with 'D E B I T O   ','R'
           endif
   endcase
   *** se tiver impressora autenticadora configurada ***
   if 'AUTENTIC' $ upper(fiscal->IDESTOT1)
      Autenticou=.f.
      CONT=1
      do while .t.
         *** permite a autenticacao do Documento ***
         Autentica := MsgAlert('Autenticar este Recebimento ? ','Atencao',{' Sim Autenticar DP ',' Sair e Autenticar Fita '})
         if Autentica =1 .and. lastkey()<>27
            Autenticou=.t.
            set devi to print
            set print on
            ?? chr(15)
            @ prow(),00 say 'D:'+dtoc(date())+':'+left(time(),5)+':'+receber->COD_CONTA+':'+transf(vVALOR_REC,'@E ***,***.**')+':'+strzero(CONT,2)
            @ prow(),00 say ''
            set print to xPrinter
            set print off
            set devi to scree
            CONT++
            loop
         endif
         exit
      enddo
      if Autenticou
         set devi to print
         set print on
         ?? chr(15)
         @ prow()+1,00 say 'F:'+dtoc(date())+':'+left(time(),5)+':'+receber->COD_CONTA+':'+transf(vVALOR_REC,'@E ***,***.**')
         @ prow()  ,00 say ''
         set print to xPrinter
         set print off
         set devi to scree        
      endif
   endif
   if empty(vBANCO).and.empty(vCHEQUE)
      vDATA_REC :=ctod('')
      vVALOR_REC:=vCOD_COB:=0
      vCOD_REC1 :=vCOD_REC2:=vCOD_REC3:=0
      vVLR_REC1 :=vVLR_REC2:=vVLR_REC3:=0
   endif
   *** Baixa Lancamento ***
   sele RECEBER
   DbSetOrder(2)
   seek mCOD_CONTA
   reglock(.f.)
   if RespBaixa=2
      vANTEC=.T.
   endif
   *** Grava data do recebimento p/retirada do SPC
   if !empty(receber->DT_E_SPC)
      vDT_R_SPC = vDATA_REC
   endif
   *** devido a conta do banco ***
   vENVIADO  := .f.
   vDATA_CAD := mDATA_CAD
   vCUSTEIO  := mCUSTEIO
   vD        := mD
   vDATA_REC := mDATA_REC
   vVALOR_REC:= mVALOR_REC
   vBANCO    := mBANCO
   vCHEQUE   := mCHEQUE
   vCOD_COB  := mCOD_COB
   vCOD_REC1 := mCOD_REC1
   vCOD_REC2 := mCOD_REC2
   vCOD_REC3 := mCOD_REC3
   vVLR_REC1 := mVLR_REC1
   vVLR_REC2 := mVLR_REC2
   vVLR_REC3 := mVLR_REC3
   if 'MINERACAO' $ upper(NEMPRESA)
      vDATA_CONT = vDATA_REC
	endif  
   repl_var()
   *** Auditoria de alteracao ***
   AuditAlt(procname())
   DbCommit()
   DbUnlock()            
   *** Lanca credito no movimento bancario ***
   if vLANCA_MB='X'
      sele MOVBANCO
      DbSetOrder(0)
      adireg(.f.)     
      vHIST     = 'Rec '+left(cadcli->CLIENTE,14)+'-'+vCOD_CONTA+'-'+receber->TIPO_DOC+' '+transf(receber->NUM_DOC,'9999999')+'-P:'+receber->PARC+'-Vcto '+dtoc(receber->DATA_VENC)
      *** Verifica se sistema esta configurado para baixar conta em outro caixa ***
      vCCDestBX = vCUSTEIO+vD
      if !empty(setup->CCBXCR) .and. setup->CCBXCR>'00' .and. setup->CCBXCR<'99'
         vCCDestBX = setup->CCBXCR
      endif
      repl movbanco->BANCO    with vBANCO   , movbanco->AGENCIA   with vAGENCIA  ,;
           movbanco->CONTA    with vCONTABCO, movbanco->NUM_DOC   with vCHEQUE   ,;
           movbanco->CUSTEIO  with vCCDestBX, movbanco->HIST      with vHIST     ,;
           movbanco->DATA_MOV with vDATA_MOV, movbanco->VALOR     with vVALOR    ,;
           movbanco->DEB_CRED with 'C'      , movbanco->COD_CONTA with vCOD_CONTA,;
           movbanco->NROVENDA with 'R'+vCOD_CONTA
           *** Auditoria de alteracao ***
           AuditAlt(procname())
           DbCommit()
           DbUnlock()            
   endif
   *** verifica em quantos pagamentos ***
   RECEBTOS:=CONTADOR:=1
   do case
      case vVLR_REC1>0.and.vVLR_REC2>0.and.vVLR_REC3>0
           RECEBTOS=3
      case vVLR_REC1>0.and.vVLR_REC2>0
           RECEBTOS=2
      case vVLR_REC1>0
           RECEBTOS=1
   endcase
   *** ver se lanca automatico recebimento no caixa ***
   if vBX_CR_CX
      vLANCA_CX='X'
      if 'NAOBXCX' $ vSACCESS
         if MsgAlert('Atencao !!! '+alltrim(vUSUARIO)+' o sistema esta configurado '+;
                     'para Lancamento Automatico de Recebimento no caixa, e seu nivel '+;
                     'de acesso permite NAO lancar o recebimento desta conta. '+;
                     'Lancar no caixa ? ',' Recebimento de Conta ',{' Sim ',' Nao '})=2
            vLANCA_CX=' '
         endif
      endif
   endif
   *** Lanca no Movimento de Caixa as Parcelas ***
   if vLANCA_CX='X'
      do while CONTADOR <= RECEBTOS
         sele MOVCX
         ARQCX=dbf()
         sele ARQUIVOS
         seek ARQCX
         reglock(.f.)
         repla ULT_COD with ULT_COD+1
         dbcommit()
         vREG_CX=ULT_COD
         dbunlock()               
         VALOR_REC = 'vVLR_REC'-ltrim(str(CONTADOR))
         FORMA_REC = 'vCOD_REC'-ltrim(str(CONTADOR))
         
         sele MOVCX
         set orde to 0
         adireg(.f.)
         vHISTORICO   ='Rec '+left(cadcli->CLIENTE,14)+'-'+vCOD_CONTA+'-'+vTIPO_DOC+'-'+str(vNUM_DOC,7)+'-Vc '+dtoc(vDATA_VENC)
         if vJUROS>0
            vHISTORICO='Cred.Conta+Juros '+vCOD_CONTA+'-'+vTIPO_DOC+'-'+str(vNUM_DOC,7)+'-'+left(cadcli->CLIENTE,14)
         endif

         *** Verifica se sistema esta configurado para baixar conta em outro caixa ***
         vCCDestBX = vCUSTEIO+vD
         if !empty(setup->CCBXCR) .and. setup->CCBXCR>'00' .and. setup->CCBXCR<'99'
            vCCDestBX = setup->CCBXCR
         endif
         if vDATA_REC>date()
            vDATA_REC=date()
         endif
         repla movcx->REGISTRO  with vREG_CX   , movcx->DATA     with vDATA_REC,;
               movcx->HISTORICO with vHISTORICO, movcx->DEB_CRED with 'C'      ,;
               movcx->VALOR     with &VALOR_REC, movcx->CUSTEIO  with vCCDestBX,;
               movcx->D         with vD        , movcx->DT_BLOQ  with date()   ,;
               movcx->COD_PAG   with &FORMA_REC, movcx->NROVENDA with 'R'+vCOD_CONTA,;
               movcx->HORA      with time()    , movcx->USER     with vUSUARIO
         
               *** Auditoria de alteracao ***
               AuditAlt(procname())
         CONTADOR++
         dbcommit()
         dbunlock()
      enddo
   endif

   sele RECEBER
   vCONTA_ANT := COD_CONTA

   if CAD_DIF='S' .and. vVALOR_REC < vVALOR_ARC + vTOT_JUR - vTOT_DESC .and. vVALOR_REC > 0
      vVALOR_ANT := vVALOR_ARC

      *** calculo o valor dos juros sobre o valor total se tiver vencida ***
      if vDATA_REC > vDATA_VENC .and. vCJUR_DIF
         vJUR_PARC  := DIAS * ((JUR_DIA/100) * vVALOR_ARC )
         vMULTA_PARC:= vVALOR_ARC * (MULTA/100)
         vVALOR_ARC := vVALOR_ARC + vJUR_PARC + vMULTA_PARC
         if !'TOURIS' $ upper(NEMPRESA)
            vDATA_VENC := vDATA_REC
         endif
      endif
      vVALOR_ARC := vVALOR_ARC - vVALOR_REC

      reglock(.f.)
      repla VALOR_ARC with vVALOR_REC

      *** Auditoria de alteracao ***
      AuditAlt(procname())
      DbCommit()
      DbUnlock()            

      sele ARQUIVOS
      seek ARQUIVO
      reglock(.f.)
      repl ULT_COD with ULT_COD+1
      dbcommit()
      dbunlock()
      vCOD_CONTA = strzero(ULT_COD,6)

      sele RECEBER
      set orde to 0
      adireg(.f.)

      if vTOT_JUR > 0 .and. vCJUR_DIF
         *** caso o sistema calcule os juros dos valores pagos, para que NAO recalcule
         *** sobre o saldo que ficou JA com juros, troca-se a data de vencimento
         *** original pela data do pagamento e passa-se a corrigir novamente
         set centu off
         vHIST   := 'Sld+'+str(DIAS,3)+' DD Juros ' + vCONTA_ANT+'-Vc'+dtoc(vDATA_VENC)
         set centu on
      else
         vHIST   := 'Diferenca Conta ' + vCONTA_ANT
      endif
      vCOD_VEND  := mCOD_VEND

      *** Registro da diferenca ***     
      vMULTA     := 0    // Zero a multa pois ja foi cobrada na diferenca 
      vVALOR_REC := vBANCO    := vCHEQUE   := 0
      vCOD_COB   := vCOD_REC1 := vCOD_REC2 := vCOD_REC3  := 0
      vVLR_REC1  := vVLR_REC2 := vVLR_REC3 := 0
      vANTEC     :=.f.
      vDATA_REC  := ctod('')
      vCUSTEIO   := mCUSTEIO
      vD         := mD
      vDATA_CAD  := date()
      repl_var()

      *** Auditoria de alteracao ***
      AuditAlt(procname())
      dbcommit()
      unlock
   endif
   
   *** Lancamento de JUROS em CONTA especifica ***
   if CAD_JUR='S' .and. vJUROS>0 .and. vCONTABIL
      sele ARQUIVOS
      seek ARQUIVO
      reglock(.f.)
      repl ULT_COD with ULT_COD+1
      dbcommit()
      dbunlock()
      vCOD_CONTA = strzero(ULT_COD,6)

      sele RECEBER
      DbSEtOrder(0)
      adireg(.f.)
      vHIST      = 'Juros Conta '+vCONTA_ANT
      vDATA_CAD  = date()
      vVALOR_ARC = vJUROS
      vVALOR_REC = vJUROS
      vVLR_REC1  = vJUROS
      vVLR_REC2  = 0
      vVLR_REC3  = 0
      vCOD_VEND  = mCOD_VEND
      vCONTA     = vCONTA_JUR
      vCUSTEIO   = mCUSTEIO
      vD         = mD
      repl_var()
      *** Alteracao de Auditoria ***
      AuditAlt(procname())
      dbcommit()
      dbunlock()
   endif
   *** Marca como lancamento de rateio ***
   vVLR_ORI=vVALOR_ARC
   vORIGEM ='R'+vCOD_CONTA
   sele RATEIO
   set orde to 1
   seek vORIGEM
   do while !eof() .and. vORIGEM=ORIGEM
      reglock(.t.)
      repla DATA_BX with vDATA_REC, ENVIADO with .f.
      dbcommit()
      unlock
      skip
   enddo
enddo
*** auditoria de alteracao ***
set key -40 to
Return(nil)


funct BuscaCR()
*********************************************************
* Realiza a busca de CR pelo Codigo,Boleto,Cliente,etc...
* Usada para CANC_CR e BAIXA_CR
*********************************************************
do while .t.
	set key -39 to VerBloqueio   &&  Alt+F10
   centra_msg(24,'DIGITE O CODIGO DA CONTA ou <ESC> P/RETORNAR')
   vCOD_CONTA=0
   @ 07,02 say 'Codigo da Conta Äþ'     get vCOD_CONTA pict '999999'
   @ 07,40 say 'Nosso Numero Boleto Äþ' get vNROBANCO                 when(empty(vCOD_CONTA))
   @ 08,02 say ' Codigo Cliente Äþ'     get vCOD_CLI   pict '99999'   when(empty(vCOD_CONTA).and.empty(vNROBANCO))    valid(iif(!empty(vCOD_CLI), p_cliente(vCOD_CLI,.t.),.t.))
   @ 09,02 say '  Tipo do Docto Äþ'     get vTIPO_DOC  pict '!!'      when(empty(vCOD_CONTA).and.empty(vNROBANCO))
   @ 10,02 say '   N§ Documento Äþ'     get vNUM_DOC   pict '9999999' when(empty(vCOD_CONTA).and.empty(vNROBANCO))
   @ 11,02 say '        Parcela Äþ'     get vPARC      pict '99/99'   when(empty(vCOD_CONTA).and.empty(vNROBANCO))
   read
   if lastkey()=27
      return(.f.)
   endif
   set key -39 to         &&  Alt+F10
   mCOD_CONTA=vCOD_CONTA
   set key -11 to
   Desl_efes()
   sele RECEBER
   do case
      case !empty(mCOD_CONTA)
           mCOD_CONTA=strzero(mCOD_CONTA,6)
           @ 07,21 say mCOD_CONTA
           DbSetOrder(2)
           seek mCOD_CONTA
      case !empty(vNROBANCO)
           DbSetOrder(8)
           seek vNROBANCO
      other
           DbSetOrder(6)
           seek str(vCOD_CLI,5)+vTIPO_DOC+str(vNUM_DOC,7)+vPARC
   endcase
   if eof()
      mensagem('Conta NAO cadastrada...')
      loop
   endif
   igual_var()
   @ 07,02 say 'Codigo da Conta Äþ'     get vCOD_CONTA pict '999999'
   @ 07,40 say 'Nosso Numero Boleto Äþ' get vNROBANCO               
   @ 08,02 say ' Codigo Cliente Äþ'     get vCOD_CLI   pict '99999'   
   p_cliente(vCOD_CLI,.t.)
   @ 09,02 say '  Tipo do Docto Äþ'     get vTIPO_DOC  pict '!!'      
   @ 10,02 say '   N§ Documento Äþ'     get vNUM_DOC   pict '9999999'
   @ 11,02 say '        Parcela Äþ'     get vPARC      pict '99/99'  
   exit
enddo
return(.t.)


funct DadosRec()
*****************************************
* Apresenta dados do recebimento da conta
*****************************************
@ 18,02       say ' Dt Recbto Äþ'   get vDATA_REC                     valid(Juros_fut())   when(Juros_fut())
@ 18,col()+10 say 'N§ Banco Äþ'     get vBANCO     pict '999'                                                                    when(mens_campo('1=dinheiro ou o numero do banco'))
@ 18,col()+6  say 'N§ Docto Äþ'     get vCHEQUE    pict '9999999'                                                                when(mens_campo('1=dinheiro ou o numero do documento'))

@ 19,02       say 'Vlr Recbdo Äþ'   get vVLR_REC1  pict '99999999.99' valid(calcula_rec(vVLR_REC1,vVLR_REC2,vVLR_REC3,17,40))    when(mens_campo('o valor recebido'))
@ 19,col()+5  say 'Forma Recbto Äþ' get vCOD_REC1  pict '99'          valid(p_formapag(vCOD_REC1,.T.) .and. RecTEF(vVLR_REC1))   when(mens_campo('a forma de recebimento'))

@ 20,02       say 'Vlr Recbdo Äþ'   get vVLR_REC2  pict '99999999.99' valid(calcula_rec(vVLR_REC1,vVLR_REC2,vVLR_REC3,17,40))    when(vVLR_REC1>0 .and. mens_campo('o valor recebido'))
@ 20,col()+5  say 'Forma Recbto Äþ' get vCOD_REC2  pict '99'          valid(p_formapag(vCOD_REC2,.T.) .and. RecTEF(vVLR_REC2))   when(vVLR_REC2>0 .and. mens_campo('a forma de recebimento'))

@ 21,02       say 'Vlr Recbdo Äþ'   get vVLR_REC3  pict '99999999.99' valid(calcula_rec(vVLR_REC1,vVLR_REC2,vVLR_REC3,17,40))    when(vVLR_REC2>0 .and. mens_campo('o valor recebido'))
@ 21,col()+5  say 'Forma Recbto Äþ' get vCOD_REC3  pict '99'          valid(p_formapag(vCOD_REC3,.T.) .and. RecTEF(vVLR_REC3))   when(vVLR_REC3>0 .and. mens_campo('a forma de recebimento'))

@ 22,02       say '  Cobrador Äþ'   get vCOD_COB   pict '99'          valid(iif(vCOD_COB>0,p_cobrador(vCOD_COB,.t.),.t.))       when(mens_campo('o codigo do cobrador ou <ENTER> p/nhenhum'))
@ 22,col()+16 say ' Lancar CX Äþ'   get vLANCA_CX  pict '!'           valid(vLANCA_CX$' X')                                     when(mens_campo('X se for para lancar para o CAIXA ou <ENTER> p/NAO lancar'))
@ 22,col()+4  say ' Lancar MB Äþ'   get vLANCA_MB  pict '!'           valid(vLANCA_MB$' X')                                     when(mens_campo('X se for para lancar para o MOVIMENTO BANCARIO ou <ENTER> p/NAO lancar'))
@ 23,02       say 'Observacao Äþ'   get vOBS
return(.t.)


func CALCULA_REC(vVLR_REC1,vVLR_REC2,vVLR_REC3,LL,CC)
*****************************************************************
* Funcao para somar as parcelas e atualiza o valor recebido do CR
*****************************************************************
vVALOR_REC = vVLR_REC1 + vVLR_REC2 + vVLR_REC3
@ LL,CC say 'VALOR RECEBIDO Äþ' +transf(vVALOR_REC,'@E 9,999,999.99')
return(.t.)


func JUROS_FUT
**************************************
* Calcular Juros para pagamento futuro
**************************************
vTOT_JUR := vTOT_DESC := 0
if vDATA_REC>=vDATA_VENC
   DIAS        = vDATA_REC - vDATA_VENC
   COR_FUT     = setcolor()
   vTOT_JUR    = DIAS * ((JUR_DIA/100) * vVALOR_ARC)      && Multiplica n§ dias com a taxa vezes o valor
   VLR_MULTA   = (MULTA/100) * vVALOR_ARC
   if TJ='V'
      vTOT_JUR = DIAS * JUR_DIA                           && Se os Juros da Conta for VALOR, Multiplica pelos n§ dias
   endif
   if (vDATA_REC - vDATA_VENC) > vCARENCIA
      vTOT_JUR = vTOT_JUR + VLR_MULTA
   else
      vTOT_JUR = 0
   endif
   setcolor(COR_JUROS)
   @ 12,40 say ' Juros+Multa R$ Äþ ' + transf( vTOT_JUR , '@E 9,999,999.99')
else
   DIAS        = vDATA_VENC - vDATA_REC
   COR_FUT     = setcolor()
   vTOT_DESC   := DIAS * ((vP_DESC/100) * vVALOR_ARC)
   setcolor(COR_JUROS)
   @ 12,40 say '    Desconto R$ Äþ ' + transf( vTOT_DESC, '@E 9,999,999.99')
endif
vVLR_REC1  := vVALOR_ARC + vTOT_JUR - vTOT_DESC
setcolor(COR_FUT)
@ 17,02 say 'TOTAL A RECEBERÄþ '  + transf(vVALOR_ARC + vTOT_JUR - vTOT_DESC,'@E 999,999.99')
return(.t.)

------------------------------------------------------------------------------------------------------
Nota da Moderação(Sygecom): Topico editado para colocar o codigo dentro da TAG [ CODE ]

[sygecom]

Olá Wagner,
Saberia dizer em que parte do seu codigo esta dando errado ou em que parte do seu codigo não esta acontecendo o que deveria acontecer.

[wagner aragao]

Ola Leonardo,

O problema está que informo os dados da baixa e confirmo se informar logo em seguida o mesmo codigo não aparece os dados da baixa, mais dentro de cada registro gravo uma auditoria de alteracao e esta auditoria fica atualizada, e o processo é feito na mesma hora. vou detalhar..


*** Baixa Lancamento ***
sele RECEBER
DbSetOrder(2)
seek mCOD_CONTA
reglock(.f.)
if RespBaixa=2
vANTEC=.T.
endif
*** Grava data do recebimento p/retirada do SPC
if !empty(receber->DT_E_SPC)
vDT_R_SPC = vDATA_REC
endif
*** devido a conta do banco ***
vENVIADO := .f.
vDATA_CAD := mDATA_CAD
vCUSTEIO := mCUSTEIO
vD := mD

****** JA SALVEI EM OUTRAS VARIAVEIS E RECUPERO AQUI NA TENTATIVA DE NAO SER SOBREPOSTA EM OUTRO LUGAR DA ROTINA ****
vDATA_REC := mDATA_REC
vVALOR_REC:= mVALOR_REC
vBANCO := mBANCO
vCHEQUE := mCHEQUE
vCOD_COB := mCOD_COB
vCOD_REC1 := mCOD_REC1
vCOD_REC2 := mCOD_REC2
vCOD_REC3 := mCOD_REC3
vVLR_REC1 := mVLR_REC1
vVLR_REC2 := mVLR_REC2
vVLR_REC3 := mVLR_REC3
if 'MINERACAO' $ upper(NEMPRESA)
vDATA_CONT = vDATA_REC
endif
repl_var() ------------ rotina que grava o que esta na memoria para os campos.... (vou coloca-la abaixo)
*** Auditoria de alteracao ***
AuditAlt(procname()) *-------> neste ponto gravo a auditoria do registro e fica atualizado
DbCommit()
DbUnlock()
*** Lanca credito no movimento bancario ***





function REPL_VAR()
****************************
* Repassa Variaveis p/Campos
****************************
A=fcount()
for X=1 to A
if type(field(X))<>"M"
NOMECAMPO=field(X)
NOMEVAR ="v"+NOMECAMPO
if type("&NOMEVAR")<>"U".and.&NOMEVAR<>&NOMECAMPO
repl &NOMECAMPO with &NOMEVAR
endif
endif
next
return(.t.)

[sygecom]

Com xHarbour 1.0.0 tambem acontece o problema ou somente com 1.2.0 ?

[wagner aragao]

Olá,

Sim Leo, na realidade acontece com a 1.0.0, pois somente nela liberei uma versão para testes quando aconteceu o problema. A Versao 1.2.0 veio junto com a FWH que comprei e to so estudando e apanhando para migrar para visual. A versão Clipper não tenho problema nenhum de perda de dados, ou dados não gravado. A minha versão principal continua sendo em clipper então qualquer alteração que faço, primeiro faço nela e depois repasso para versão xH. Então com exceção de posicionamento de telas, as rotinas de processamento e gravação de dados são as exataqmente as mesmas. A Diferença que na versão clipper uso rdd SIXCDX e na xH uso DBFCDX nativo. Será que pode ser o RDD ?
t+

[sygecom]

Você recriou os indice em xHarbour ?
Você esta usando em conjunto um EXE em clipper e outro EXE em xharbour usando os mesmo DBF e INDICE ?
Já tentou realizar os testes com Harbour ? atualmente o Harbour esta mais compativel com Clipper do que o xHarbour.

[wagner aragao]

Olá,


Não são programas que não estão rodando juntos não quando coloco num cliente deixo uma versão ou a outra... No clipper tive problemas com o DBFCDX que dava uns pau doido, troquei para SIXCDX e nunca mais me preocupei com indices... Que outro RDD poderia usar o xHARBOUR... Acho que o problema esta aí...
Como usaria a SIXCDX no xHarbour...

[Hasse]

Boa noite colegas.

Faz muitos anos que uso o xHarbour com DBFCDX nativo e não tenho problemas. Tenho arquivos DBF com mais de 4 milhões de registros.

Então não acredito que o problema seja do CDX. Eu já nem faço mais manutenção nos prg's para eventualmente compilar com o Clipper x Blinker. Migrei tudo para o xHarbour.

É bom ficar de olho, pois é muito provável que o problema esteja em algum outro detalhe.

[wagner aragao]

Ola Hasse,

Bom, se você já usa o DBFCDX a muito tempo e tem tabelas desse tamanho, vou desconsiderar que seja um bug e comecar a testar mudancas na minha rotina em pontos chaves para testar o funcionamento, o que voce acha do uso do SIXCDX no xHarbour. ?

[Hasse]

Bom dia Wagner.

Eu usei o SIXCDX, na época do Clipper, quando eu migrei do NTX para o CDX. Foi um sucesso total, pois definitivamente acabaram-se os problemas de índices corrompidos. Os únicos problemas que continuaram eram sempre por motivos de hardware ou alimentação. Aliás, estes últimos ainda são responsáveis pela grande maioria das corrupções de arquivos e índices.

Tanto quanto eu sei o SIX ainda não foi portado para o xHarbour, mesmo porque este possui quase a totalidade das funções do SIX. Quanto ao CDX nativo do xHarbour, eu imagino, que seja exatamente o mesmo do CDX do SIX. Algum colega do Fórum certamente poderá confirmar ou não este detalhe.

Verifique se realmente o índice adequado está ativo no momento da pesquisa. Eu já tive casos em que eu pensava que o ativo era o 2 e na realidade era o 1...

Você usa índices com TAG ? Se não, considere a sua implantação, pois a segurança é maior.

Outro detalhe: Como você ja afirmou, considere seriamente a possibilidade de rever e checar integralmente a parte do código envolvido com o teu problema. Se ele não for muito extenso, e se isto for possível, refaça as funções envolvidas com o problema. Com a tua experiência de hoje certamente farás um código mais enxuto, mais eficiente e mais seguro.

Fatalmente, mais cedo ou mais tarde você acabará encontrado o motivo do problema. Na maioria das vezes são detalhes tão simples e insignificantes que o nosso cérebro, involuntariamente, se recusa a reconhecê-lo nas primeiras análises.

Bom trabalho e sucesso.

[sygecom]

Concerteza o problema não esta com o DBFCDX, eu támbem uso sem probelmas a tempos.
Se quiser pode testar a SIX com Harbour, veja o link abaixo:
viewtopic.php?f=4&t=6633&hilit=sixcdx

Se quiser testar o Harbour, pode usar o instalador do Rodrigo Moreno:
http://www.4shared.com/file/107117779/5 ... setup.html

[wagner aragao]

Olá Pessoal,

Me desculpem a insistência, mais descobri mais um ponto de perda de dados no meu sistema, no cadastro de clientes (são 147 campos), algumas vezes também não grava os dados da memória, mesmo com o dbcommit()... Ha muitos anos não tenho esse problema com clipper,nem mesmo de corrupçào de dados, pois uso o SIXCDX com TAGs e os sistemas mais pesados deixo no agendador de tarefas do windows para indexar TODOS os dias as tabelas. E portei, depois de revisar a adequar as exigências do xHarbour, as mesmas funções para lá. Será que o xHarbour muda alguma coisa no cabeçalho dos dados e dos memos (FPT) ? E isso pode estar causando perda de dados na gravação ? Quando altero alguma coisa nas bases de dados na versão clipper, só copio as tabelas para a pasta com a versão em xHarbour e faço as alterações lá no fonte também, será que pode ser isso
T+

[Itamar M. Lins Jr.]

O RDD da nova versão xHarbour não esta confiavel. Porque o pessoal do xH andou copiando e colando coisas do Harbour sem o devido conhecimento.
Dica, mude para o Harbour e teste.

Saudações,
Itamar M. Lins Jr.

[Hasse]

Usa a versão 1.0.0. Eu a uso desde o seu lançamento, e nunca me deu dor de cabeça.

Ainda não testei a versão 1.1.0 em clientes.

E como você faz com os índices ?

Você re-indexa quando os DBF's são transferidos ? Os CDX's do Clipper/Six não funcionam com o xHarbour...

[Itamar M. Lins Jr.]

Usa a versão 1.0.0. Eu a uso desde o seu lançamento, e nunca me deu dor de cabeça.

O responsável é o Przmek.
Ele saiu do xHarbour, está no harbour somente.
NSX funciona no Harbour desde essa época:

Código: Selecionar todos

2008-12-24 09:45 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
  + harbour/include/hbrddnsx.h
  + harbour/source/rdd/dbfnsx
  + harbour/source/rdd/dbfnsx/dbfnsx1.c
  + harbour/source/rdd/dbfnsx/Makefile
  * harbour/config/global.cf
  * harbour/make_b32.mak
  * harbour/make_vc.mak
  * harbour/make_gcc.mak
  * harbour/common.mak
    + added new DBFNSX RDD. Those of you who knows SIX3 should also
      know NSX index format. It's very interesting format and in some
      cases much better then CDX. I hope you will find it interesting.
      In hbrddnsx.h you can find detail information about Harbour NSX
      implementation.
      It's a small gift from me for Christmas ;-)

      I would like to wish all of you Marry Christmas and Happy new Year.

      best regards,
      Przemek

E esta sendo emplementado constantimente conforme podemos observar:

Código: Selecionar todos

2009-04-28 19:45 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
  * harbour/ChangeLog
    * removed TOVERIFY note - Viktor checked it.

  * harbour/contrib/hbct/ctwin.c
    ! redraw windows after each WCENTER() call

  * harbour/contrib/rddads/ads1.c
    + added support for ADS_VARCHAR_FOX and ADS_VARBINARY_FOX fields
      in ADS_VFP tables

  * harbour/include/dbinfo.ch
  * harbour/include/hbrdddbf.h
  * harbour/include/hbrddcdx.h
  * harbour/include/hbrddnsx.h
  * harbour/include/hbrddntx.h
  * harbour/source/rdd/dbf1.c
  * harbour/source/rdd/workarea.c
    + added support for VFP tables with VARCHAR and VARBINARY fields
    + added support for VFP tables with NULLABLE fields
    + added new dbFieldInfo() action to check if given field is NULL, f.e.:
         ? dbFieldInfo( DBS_ISNULL, FieldPos( <cFieldName> ) )
      The above modifications were not tested with real VFP files. I do
      not have VFP. VFP users should make some real life tests with tables
      created by VFP.

Infelizmente o pessoal do xH estava copiando e colando estas coisas no rdd do xH e está dando erros.
O Miguel Marchuet está implementando muitas coisas boas no xHarbour, vamos ver se ficará estável.

Código: Selecionar todos

   + include\hbrddmdx.h
   + source\rdd\dbfmdx\Makefile
   + source\rdd\dbfmdx\dbfmdx1.c
     + Added dbfmdx version IV, dbf works, but by the moment mdx is a clone of cdx
       please don't use yet.

   * source\rdd\dbf1.c
   * source\rdd\dbffpt\dbffpt1.c
     + Added field type "O" double compatible with dbase IV, and added too field type
       binary "B" that works as a memo "M" but with no translation field type of
       dBase V.
       Now we full support dBase IV,V dbf file.

Please don't use dbase IV rdd with mdx yet. Is work in progress.

Saudações,
Itamar M. Lins Jr.