Jump to content
Fivewin Brasil

Perda de Dados no xHarbour

wagner1361303176

By wagner1361303176
in Programação

 Share

Recommended Posts

wagner1361303176 Newbie

wagner1361303176

Posted
Posted

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+

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 ' =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 'Ã=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 p/continuar')

inkey(0)

ResultAlert = MsgAlert('Conta JA foi recebida... 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 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_RECVALOR_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 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 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 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 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 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.)

Link to comment
Share on other sites
wagner1361303176 Newbie

wagner1361303176

Posted
  • Author
Posted

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+

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 ' =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 'Ã=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 p/continuar')

inkey(0)

ResultAlert = MsgAlert('Conta JA foi recebida... 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 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_RECVALOR_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 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 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 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 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 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.)

Link to comment
Share on other sites
tiaoFW Newbie

tiaoFW

Posted
Posted

Ao Migrar de versão do Xharbour voce recriou os Indices?

Digo isso porque existem diferenças e correções de um RDD de uma versão para outra. A tendencia é que de uma versão mais velha para mais nova aja a correção de bugs, fazendo com que seja necessário uma reavaliação da rotina que apresentar problemas.

Outra coisa, me parece que a versão 1.20.01 do xharbour esta apresentando problemas, segundo o que postou o Villian aqui mesmo no forum, então por enquanto não é recomendavel a migração da 1.0.0 para 1.20.01.

T+

FWXH 9.02, PELLESC, MYMAKE 1.9J, DBF

Belzonte - Minas Gerais

Link to comment
Share on other sites
wagner1361303176 Newbie

wagner1361303176

Posted
  • Author
Posted

Olá Tião,

Na realidade trabalho com 3 versões do mesmo programa, a que está em produção em clipper, a Beta em xHarbour 1.0.0 simplex e a que estou brincando com FWH 9.4 usando a 1.2.1 A que está apresentando problema é com 1.0.0, e os indices foram recriados sim, será que muda alguma coisa na estutura dos DBFs ??? Pois qualquer alteração que faço na versão clipper copio os DBF para a versão xHarbour e indexo novamente.

Outra coisa uso indices com TAG.

t+

Clipper 5.2e/xHarbour 1.0.0 Simplex / xHarbour 1.2.1 Simplex / FWH 9.04

Link to comment
Share on other sites
Ladinilson Rookie

Ladinilson

Posted
Posted

Amigo tive uma experiência que achei bastante estranha mas acho que pode servir como um teste para você, quando meu aplicativo estava em 16 bits (FW 2.3/Blinker) usava o CDXLOCK.OBJ e não tinha nenhum problema, quando passei para 32 bits (FWH 8.1/xHB 1.1.0) não coloquei mas este OBJ na lista para compilar e tive problemas com registros que sumiam ou erros de atualização, ai coloquei ele de volta e o problema foi sanado, experimente colocar este OBJ e teste várias vezes sua rotina.

FWH 8.1 / xHB 1.1.0 / Pelles /xDev

Link to comment
Share on other sites
wagner1361303176 Newbie

wagner1361303176

Posted
  • Author
Posted

Olá Tião,

Nesse trecho bloqueio o registro e atualizo o valor do lançamento do novo com o valor que foi recebido. O problema não esta so no valor recebido que fica ZERO. Tenhos outros campos que sinalizam o recebimento. Para considerar uma conta recebida, preciso que os campos BANCO, CHEQUE, VALOR_REC, DATA_REC, COD_REC1, VLR_REC1 estejam preenchidos e nesse caso TODOS ficam em zerados, so que no mesmo registro tenho dados da gravacao do registro que gravo com a função AuditAlt(procname()) nela gravo Data, Maquina, Hora, Usuario e rotina que alterou o registro e os dados são atualizados normalmente.

Vou testar o que o amigo falou sobre o CdxLock.

t+

Clipper 5.2e/xHarbour 1.0.0 Simplex / xHarbour 1.2.1 Simplex / FWH 9.04 xDEV 0.70 / Workshop 4.5

Link to comment
Share on other sites
tiaoFW Newbie

tiaoFW

Posted
Posted

Fiz o questionamento porque achei que voce perceberia o problema, não sei o que a função reglock faz, mas me parece que ela trava o registro, correto? Se é isso voce esta dando replace incondicionalmente no registro mesmo sem ter certeza de que ele foi travado.

O correto a meu ver seria o seguinte:

if reglock(.f.)

repla VALOR_ARC with vVALOR_REC

dbunlock()

dbcommit() // dbskip(0)

endif

Tenho um sistema em modo console usando xharbour 1.0.0 e não tenho tido problemas até o momento!

t+

FWXH 9.02, PELLESC, MYMAKE 1.9J, DBF

Belzonte - Minas Gerais

Link to comment
Share on other sites
wagner1361303176 Newbie

wagner1361303176

Posted
  • Author
Posted

Olá Tião,

Essa funçào reglock() com o parâmetro .f., não deixa o usuário abandonar o registro enquanto não estiver travado, internamente ela mostra a mensagem de que o usuario X, a maquina Y está travando aquele registro, então não seria ali o problema. Outra coisa você coloca o dbcommit() DEPOIS do unlock ??? Sempre coloco antes será que faz diferença ?

Clipper 5.2e/xHarbour 1.0.0 Simplex / xHarbour 1.2.1 Simplex / FWH 9.04 xDEV 0.70 / Workshop 4.5

Link to comment
Share on other sites
tiaoFW Newbie

tiaoFW

Posted
Posted

Bem, não sei se é ai o problema, mas adotei essa maneira de escrever ao ver dessa forma nos códigos do Alexandre, parece fazer sentido, o dbcommit() grava as alterações no registro, e o dbunlock() desbloqueia o registro, como o dbunlock() não deixa de ser de qualquer forma uma alteração no estado do registro o melhor seria que o dbcommit() viesse depois do dbunlock() para que os outros usuarios pudessem acessar o registro que hora estava bloqueado.

Mas não creio ser esse o motivo de seu problema.

Notei algumas coisas no seu código que não entendi:



seek ARQUIVO


reglock(.f.)


repl ULT_COD with ULT_COD+1


dbcommit()


dbunlock()


 
id=code>id=code>
Nesse trecho, quem garante que ele localizou o registro no comando seek? E se não encontrou e voce esta posicionado no fim do arquivo? O que acontece?


Outra coisa: Essa função, AuditAlt(procname()), não pode estar mudando o registro corrente?


Bem, é isso por enquanto!


t+


FWXH 9.02, PELLESC, MYMAKE 1.9J, DBF


Belzonte - Minas Gerais



			
		


		
			

				
					
						

	
	
		

			
				
				

					
				

			
			
			
		

	


					
				
				
			

		

		
			

		
	


	

	





	
Link to comment

	
		
	
	
	

	
	
Share on other sites

	

	


	

	

	




	



					
					
					
				

					

					
					






	

	

	

		

			

				


	
		wagner1361303176
	

				
				
					
						
Newbie
					
				
			

		

		

			

				


wagner1361303176
			

			

				Posted 
				
			

		

	

	
	

		




	

		

			

				
    
					
						
  • Author
    • 
					
					
					
					
					
				

			

			
		


		

			Posted 
			
			
				
				
			
		

	


	

    

	

		
		

			

Olá Tião,


Nesse trecho do código, ele busca o último código do arquivo em uso, nesse ponto a busca sempre retorna .T. por isso não testo. Hoje tenho as duas versões em clipper e xHarbour se preciso alterar a estrutura das tabelas altero na versão clipper e depois copio essas tabelas para a pasta do xHarbour, só que em clipper uso o SIXCDX e no xHARBOUR uso o DBFCDX (nativo) será que não gera incompatibilidade na gravação dos dados ??? Principalmente nas tabelas com MEMO (FPT)?. Estou tendo problema também na perda de dados na gravação de clientes (são 147 campos no arquivo). To frito, preciso colocar o sistema em produção confiável para eu parar de mexer com clipper.


T+


Clipper 5.2e/xHarbour 1.0.0 Simplex / xHarbour 1.2.1 Simplex / FWH 9.04 xDEV 0.70 / Workshop 4.5



			
		


		
			

				
					
						

	
	
		

			
				
				

					
				

			
			
			
		

	


					
				
				
			

		

		
	


	

	





	
Link to comment

	
		
	
	
	

	
	
Share on other sites

	

	


	

	

	




	



					
					
					
				

					

					
					






	

	

	

		

			

				


	
		tiaoFW
	

				
				
					
						
Newbie
					
				
			

		

		

			

				


tiaoFW
			

			

				Posted 
				
			

		

	

	
	

		




	

		

			

				
    
					
					
					
					
					
				

			

			
		


		

			Posted 
			
			
				
				
			
		

	


	

    

	

		
		

			

Pode ser sim esse o motivo! Acho que vale um estudo do que é possivel num RDD e não é possivel em outro. Seria prudente voce criar uma massa de dados pra testes com dbf´s criados puramente no RDDCDX.


Creio que esta ai o motivo dos seus problemas.


E outra, um CDX criado em FOX, outro criado em clipper/dos e outro criado em xharbour não são intercambiaveis.


t+


FWXH 9.02, PELLESC, MYMAKE 1.9J, DBF


Belzonte - Minas Gerais



			
		


		
			

				
					
						

	
	
		

			
				
				

					
				

			
			
			
		

	


					
				
				
			

		

		
			

		
	


	

	





	
Link to comment

	
		
	
	
	

	
	
Share on other sites

	

	


	

	

	




	



					
					
					
				

					

					
					






	

	

	

		

			

				


	
		wagner1361303176
	

				
				
					
						
Newbie
					
				
			

		

		

			

				


wagner1361303176
			

			

				Posted 
				
			

		

	

	
	

		




	

		

			

				
    
					
						
  • Author
    • 
					
					
					
					
					
				

			

			
		


		

			Posted 
			
			
				
				
			
		

	


	

    

	

		
		

			

Olá,


Acho que o que está acontecendo, é o seguinte, hoje uso o programa BroPlus 2.51 do Peter Volz para manutenção das bases de dados, so que é DOS, e manipula os arquivos CDX do fox. Na versào clipper uso o SIXCDX e a versão que tenho do Bro, tem esse drive na tela mais não esta disponível, e continuo usando o mesmo programa para Clipper, e xHarbour que volto a usar as mesmas bases com  DBFCDX e que não são as mesmas do fox.  Gostaria de saber que ferramenta posso usar fácil como o Bro para manter a base de dados nessas plataformas, pois acho que estou tendo problema no cabecalho dos arquivos, ou mesmo nos arquivos de MEMO.


t+


Clipper 5.2e/xHarbour 1.0.0 Simplex / xHarbour 1.2.1 Simplex / FWH 9.04 xDEV 0.70 / Workshop 4.5



			
		


		
			

				
					
						

	
	
		

			
				
				

					
				

			
			
			
		

	


					
				
				
			

		

		
	


	

	





	
Link to comment

	
		
	
	
	

	
	
Share on other sites

	

	


	

	

	




	



					
					
					
				

					

					
					






	

	

	

		

			

				


	
		mpcrj1806
	

				
				
					
						
Newbie
					
				
			

		

		

			

				


mpcrj1806
			

			

				Posted 
				
			

		

	

	
	

		




	

		

			

				
    
					
					
					
					
					
				

			

			
		


		

			Posted 
			
			
				
				
			
		

	


	

    

	

		
		

			
Estou passando por problema semelhante. Em alguns clintes aparece uma duplicaco ou criacao de dados sem qualquer explicacao. Meu Sistema tem + de 20 anos de utilizacao e no clipper puro nunca ocorreu o que vem ocorrendo ultimamente. Eh impossivel simular tal evento. O numero de registros gravados nos clientes ultrapassa a casa e 2 milhoes/mes, mas em um cliente qualquer o dado de um venda se duplica ou triplica sozinho em uma rotina sem loop de passagem pelo ponto da gravacao. O cliente nao quer saber se isso ocorre 1vez a cada 3meses, ele quer tudo certo sempre. Coloquei um log de tempo e maquina e houve duas gravacoes fantasmas com intervalo de 5seg apos a gravacao da original e feita na mesma maquina, ou seja impossivel sem um loop pre-programado. Uso xharbour com indice NTX. Antes que falem que o problema eh o NTX ja estou migrando para a interface grafica com CDX, contudo o que estou vendo descrito acima me faz acreditar que, pouco importa o tipo de indice, e sim o fato do aparececimento de registros fantasmas. Estava para alterar o Sistema incluido dbcommit, uso commit, apos todos os replaces, por achar que este problema estava relacionado com memoria. Contudo nosso amigo acima ja fez isso e nada adiantou. A COISA HE MUITO SERIA E NAO VEJO SOLUCAO PARA UM PROBLEMA QUE PODE ESTAR FORA DE NOSSA MAOS.


			
		


		
			

				
					
						

	
	
		

			
				
				

					
				

			
			
			
		

	


					
				
				
			

		

		
	


	

	





	
Link to comment

	
		
	
	
	

	
	
Share on other sites

	

	


	

	

	




	



					
					
					
				

					

					
					






	

	

	

		

			

				


	
		wagner1361303176
	

				
				
					
						
Newbie
					
				
			

		

		

			

				


wagner1361303176
			

			

				Posted 
				
			

		

	

	
	

		




	

		

			

				
    
					
						
  • Author
    • 
					
					
					
					
					
				

			

			
		


		

			Posted 
			
			
				
				
			
		

	


	

    

	

		
		

			

Ola,


É meu jovem estou batendo cabeça nesse problema e a única coisa que concluo é que pode ser o programa que uso para manutenção da base, e a transferência das bases de uma versão em clipper para xHabour. 


Já to pensando em migrar para SQL usando a SQLLib parece uma ótima solução.


t+


Clipper 5.2e/xHarbour 1.0.0 Simplex / xHarbour 1.2.1 Simplex / FWH 9.04 xDEV 0.70 / Workshop 4.5



			
		


		
			

				
					
						

	
	
		

			
				
				

					
				

			
			
			
		

	


					
				
				
			

		

		
	


	

	





	
Link to comment

	
		
	
	
	

	
	
Share on other sites

	

	


	

	

	




	



					
					
					
				

					

					
					





					
					
					
				

					

					
					






	

	

	

		

			

				


	
		wagner1361303176
	

				
				
					
						
Newbie
					
				
			

		

		

			

				


wagner1361303176
			

			

				Posted 
				
			

		

	

	
	

		




	

		

			

				
    
					
						
  • Author
    • 
					
					
					
					
					
				

			

			
		


		

			Posted 
			
			
				
				
			
		

	


	

    

	

		
		

			

Olá,


Criei um programa para pegar cada arquivo do meu sistema e executar um COPY STRUCTURE e depois nele executar um APPEND FROM para recriar as tabelas dentro do xHARBOUR e se tiver problema de cabecalho ou coisa parecida recuperar. Se alguem tiver outra idéia por favor podem dizer, vou tentar tudo.


AT+


Clipper 5.2e/xHarbour 1.0.0 Simplex / xHarbour 1.2.1 Simplex / FWH 9.04 xDEV 0.70 / Workshop 4.5



			
		


		
			

				
					
						

	
	
		

			
				
				

					
				

			
			
			
		

	


					
				
				
			

		

		
	


	

	





	
Link to comment

	
		
	
	
	

	
	
Share on other sites

	

	


	

	

	




	



					
					
					
				

					

					
					






	

	

	

		

			

				


	
		wagner1361303176
	

				
				
					
						
Newbie
					
				
			

		

		

			

				


wagner1361303176
			

			

				Posted 
				
			

		

	

	
	

		




	

		

			

				
    
					
						
  • Author
    • 
					
					
					
					
					
				

			

			
		


		

			Posted 
			
			
				
				
			
		

	


	

    

	

		
		

			

Olá,


Para a leitura e a gravação de dados em arquivos criei funções para automatizar esse processo para não ter que informar os campos que darei o replace ou mesmo criar as variáveis de memória. Será que o problema que estou tendo pode ser pela maneira que faço isso. Uso as mesmas funções em clipper e nunca deram problema, mais o problema n"ao está so na gravação dos dados, mais também na hora de mostrar os dados na tela (say, get) após ler a tabela. As funções que uso são :


 




************************************************


* Funcoes de Usuario p/Operacoes com Variaveis *


************************************************


function CRIA_VAR()


***************************************


* Cria Variaveis baseado no arquivo da área atual, verifico 


* quantos campos tem, e faço laço jogando cada campo para a 


* memoria com contéudo correspondente vazio com prefixo "V"


* Ex: CLIENTE -> vCLIENTE = space(40)


*     DT_NASC -> vDT_NASC = ctod(""")


***************************************


A=fcount()


for X=1 to A


    if type(field(X))<>"M"


       NOMECAMPO=field(X)


       NOMEVAR="v"+NOMECAMPO


       publi &NOMEVAR


       do case


          case type(field(X))="C"


               &NOMEVAR=spac(len(&NOMECAMPO))


          case type(field(X))="N"


               &NOMEVAR=0


          case type(field(X))="D"


               &NOMEVAR=ctod("")


          case type(field(X))="L"


               &NOMEVAR=.F.


       endcase


    endif


next


return(.t.)


function IGUAL_VAR()


***************************


* Iguala Variaveis baseado no arquivo da área atual, 


* verifico quantos campos tem, e faço laço jogando cada 


* campo para a memoria com contéudo correspondente do campo 


* com prefixo "V"


* Ex: CLIENTE -> vCLIENTE = CLIENTE


*     DT_NASC -> vDT_NASC = DT_NASC


***************************


A=fcount()


for X=1 to A


    if type(field(X))<>"M"


       NOMECAMPO=fieldname(X)


       NOMEVAR="v"+NOMECAMPO


       public &NOMEVAR


       &NOMEVAR=&NOMECAMPO


    endif


next


return(.t.)


function REPL_VAR()


****************************


* Grava no arquivo as variaveis que estão na memória com o * mesmo nome do campo com o prefixo "V"


****************************


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.)


 
id=code>id=code>
Será que existe alguma incompatibilidade com xHarbour ???


Valeu T+


Clipper 5.2e/xHarbour 1.0.0 Simplex / xHarbour 1.2.1 Simplex / FWH 9.04 xDEV 0.70 / Workshop 4.5



			
		


		
			

				
					
						

	
	
		

			
				
				

					
				

			
			
			
		

	


					
				
				
			

		

		
	


	

	





	
Link to comment

	
		
	
	
	

	
	
Share on other sites

	

	


	

	

	




	



					
					
					
				
			
			



		

	


	
	
	
	
	
		
	

			
				
				

	
		

			
Join the conversation

			

	
				
					You can post now and register later.
				
				If you have an account, sign in now to post with your account.
				
			

	
		

	




	
	
		
	
		
	
		
	
	
		
		
	
	

		

		


	
		Guest
	


		

			
				
					
				
					
						
    
							
  • 
								


	
	
	
	

								
							
    • 
						

					
				
					
				
			
			
				
					
						
							
						
						



    

		
		

			
		

		
			
 Reply to this topic...

		
		

			

				
					×
					  Pasted as rich text.   Paste as plain text instead
				
			

		

		

			

				  Only 75 emoji are allowed.
			

		

		

			

				×
				  Your link has been automatically embedded.   Display as a link instead
			

		

		

			

			

		

		

			

				×
				  Your previous content has been restored.   Clear editor
			

		

		

			

				×
				  You cannot paste images directly. Upload or insert images from URL.
			

		

		


	

		

			
			

				Loading...
			

		
		
	



	

	

		

			×
			
		

		

	



						
					
				
					
				
					
				
			
			
    
				
					
						
					
						
					
						
							
  • 
								

    
	

    
								
							
    • 
						
					
				
				
					
  • 

	

    • 
				
			

		

	



			
		

	

	
		

			

				
					


    
          Share
    

    

        
        
            

            
        
    


				
				
                

                




				
			

		

	







	

		
			
				Go to topic listing
			
		
	

	




						


					

					


					

				

			

			
		

		
		


	

		×
		

			
				

					
				

			

			

			

			
		

	






	

		×
		

			
    
				
  • Create New...
    •