Rotina de esta travando quando aberta pela segunda estação

[Marcio Antonio Ril]

Caro Amigos,

Tenho uma rotina simples de baixa de parcelas, acontece que no servidor está funciona normalzinho e bem rapida por sinal, mais o segundo micro quando abre essa mesma rotina simplesmente quando vai selecionar o cupom para baixar a parcela o sistema trava e inclusive trava o outra estação lá no servidor.

Gostaria que alguem desse uma olhadinha nela e me auxilia-se se possivel.

Obrigado

Marcio Ril


* TITULO : SISCREDI - SISTEMA DE CREDIARIO
* DATA : 18/10/2005
* PROGRAMA : BXCARNE.PRG
* COMENTARIO : BAIXA TITULO COM CARNE

SETCOLOR("B/W,W/N+,,,B/W")
WKTELA2 := SAVESCREEN(00,00,24,79)

IF !FILE("INDCLI1.IDX")
SELECT 1
USE CLIENTE ALIAS CLIENTE
INDEX ON COD_CLI TO INDCLI1
INDEX ON NOME_CLI TO INDCLI2
SET INDEX TO INDCLI1, INDCLI2
ELSE
SELECT 1
USE CLIENTE ALIAS CLIENTE
SET INDEX TO INDCLI1, INDCLI2
ENDIF

IF !FILE("INDVE1.IDX")
SELECT 3
USE VENDEDOR ALIAS VENDEDOR
INDEX ON COD_VEN TO INDVE1
INDEX ON NOME_VEN TO INDVE2
SET INDEX TO INDVE1, INDVE2
ELSE
SELECT 3
USE VENDEDOR ALIAS VENDEDOR
SET INDEX TO INDVE1, INDVE2
ENDIF

IF !FILE("INDME1.IDX")
SELECT 13
USE MENSAGEM ALIAS MENSA
INDEX ON COD_MEN TO INDME1
SET INDEX TO INDME1
ELSE
SELECT 13
USE MENSAGEM ALIAS MENSA
SET INDEX TO INDME1
ENDIF

IF !FILE("INDCO1.IDX")
SELECT 4
USE CONTRATO ALIAS CONTRATO
INDEX ON COD_CON TO INDCO1
INDEX ON COD_CON + COD_CLI TO INDCO2
SET INDEX TO INDCO1, INDCO2
ELSE
SELECT 4
USE CONTRATO ALIAS CONTRATO
SET INDEX TO INDCO1, INDCO2
ENDIF

IF !FILE("INDCX1.IDX")
SELECT 5
USE CAIXA ALIAS CAIXA
INDEX ON COD_CON TO INDCX1
INDEX ON COD_CON + VALOR_CON TO INDCX2
INDEX ON COD_CON + COD_CLI TO INDCX3
INDEX ON DTEM_CON TO INDCX4
SET INDEX TO INDCX1, INDCX2, INDCX3, INDCX4
ELSE
SELECT 5
USE CAIXA ALIAS CAIXA
SET INDEX TO INDCX1, INDCX2, INDCX3, INDCX4
ENDIF

IF !FILE("INDCA1.IDX")
SELECT 2
USE CARNE ALIAS CARNE
INDEX ON NUM_PAR TO INDCA1
INDEX ON COD_CON TO INDCA2
INDEX ON COD_CLI TO INDCA3
INDEX ON DTVEN_PAR + NUM_PAR TO INDCA4
INDEX ON COD_CON + COD_CLI TO INDCA5
INDEX ON COD_CON + NUM_PAR TO INDCA6
SET INDEX TO INDCA1, INDCA2, INDCA3, INDCA4, INDCA5, INDCA6
ELSE
SELECT 2
USE CARNE ALIAS CARNE
SET INDEX TO INDCA1, INDCA2, INDCA3, INDCA4, INDCA5, INDCA6
ENDIF

IF !FILE("INDCH1.IDX")
SELECT 6
USE CHEQUE ALIAS CHEQUE
INDEX ON NUM_CH TO INDCH1
INDEX ON COD_CLI TO INDCH2
INDEX ON NUM_CH + COD_CLI TO INDCH3
INDEX ON NUM_CH + COD_CON TO INDCH4
INDEX ON COD_CON TO INDCH5
SET INDEX TO INDCH1, INDCH2, INDCH3, INDCH4, INDCH5
ELSE
SELECT 6
USE CHEQUE ALIAS CHEQUE
SET INDEX TO INDCH1, INDCH2, INDCH3, INDCH4, INDCH5
ENDIF

SET DELETED ON
DO WHILE .T.
MENSAGEM("Tecle <ESC> para retornar")
WHORA_PG := TIME()
WCOD_CLI := 0
WCOD_FOR := 0
WCODIGO := 0
WCOD_CON := 0
WCOD_DOC := 0
WQTDE_PAR := 0
WTP_PG_CON := 3
WNUM_PAR := 0
WVL_PAR := 0
WDTEM_CON := DATAATU
WDTBASE := DATAATU
WDTVEN_PAR := DATAATU
WVL_PAR_PG := 0
WDT_PAR_PG := DATAATU
WCOD_VEN := 0
WENTRADA := 0
WVALOR_CON := 0
WRESTO := 0
WCAIXA := 0
WTIPOB := "D"
WTIPO := "P"
WCONTA := "R"
WCONTADOR := 0

JANELA(04,10,20,69," BAIXA PARCELAS - CARNES ")
COR("MENU")

@ 06,13 SAY "Posicao(P/T).: (P)endentes ou (T)odos"
@ 08,13 SAY "Cliente......:"
@ 09,13 SAY "Contrato.....:"
@ 10,13 SAY "Data Emissao.:"
@ 11,13 SAY "Valor........:"
@ 11,40 SAY "Vencimento...:"
@ 12,13 SAY "Valor Juros..:"
@ 12,40 SAY "Dias Atraso..:"
@ 13,13 SAY "Valor Desc...:"
@ 14,13 SAY "Valor Pago...:"
@ 14,40 SAY "Data Baixa...:"
@ 16,13 SAY "Tipo Pagto...: [D-Dinheiro/Cheque, B-Banco, A-Acerto]"

@ 06,28 GET WTIPO PICT "@!" VALID WTIPO $ "PT"
READ

IF LASTKEY() = 27
EXIT
CLS
ENDIF

SELE CLIENTE
SET ORDER TO 1
@ 08,28 GET WCOD_CLI VALID (WCOD_CLI>0) PICT "999999"
READ

WCODIGO := WCOD_CLI
MENSAGEM(" ")
SEEK WCODIGO
IF FOUND()
WNOME := NOME_CLI
WDADOS1_CLI := DADOS1_CLI
WDADOS2_CLI := DADOS2_CLI
WDADOS3_CLI := DADOS3_CLI
@ 08,28 SAY WNOME PICT "@!"
ELSE
MENSAGEM("Cliente nao Cadastrado",2)
LOOP
ENDIF

IF LASTKEY() = 27
EXIT
CLS
ENDIF

POSFIN()

DO WHILE .T.
MENSAGEM("Tecle <ESC> para retornar")

WCONTADOR := WCONTADOR + 1
WCOD_CAR := 0
WCOD_CON := 0
WTP_PG_CON := 0
WVL_PAR := 0
WNUM_PAR := 0
WDTVEN_PAR := DATAATU
WVL_PAR_PG := 0
WDT_PAR_PG := DATAATU
WCOD_VEN := 0
WENTRADA := 0
WVALOR_CON := 0
WRESTO := 0
WCAIXA := 0
WJUROS := 0
WDESCONTO := 0
WNUM_PAR := 0
WTIPOB := "D"

JANELA(04,10,20,69," BAIXA PARCELAS - CARNES ")
COR("MENU")

@ 06,13 SAY "Posicao(P/T).: (P)endentes ou (T)odos"
@ 08,13 SAY "Cliente......:"
@ 09,13 SAY "Contrato.....: "
@ 10,13 SAY "Data Emissao.: "
@ 11,13 SAY "Valor........: "
@ 11,40 SAY "Vencimento...: "
@ 12,13 SAY "Valor Juros..: "
@ 12,40 SAY "Dias Atraso..: "
@ 13,13 SAY "Valor Desc...: "
@ 14,13 SAY "Valor Pago...: "
@ 14,40 SAY "Data Baixa...: "
@ 16,13 SAY "Tipo Pagto...: [D-Dinheiro/Cheque, B-Banco, A-Acerto]"

IF WCONTA = "R"

@ 06,28 SAY WTIPO PICT "@!"
@ 08,28 SAY WCOD_CLI PICT "999999"
@ 08,28 SAY WNOME PICT "@!"

SELE CARNE
SET ORDER TO 1
IF WTIPO = "T"
SET FILTER TO WCODIGO = COD_CLI
ELSE
SET FILTER TO WCODIGO = COD_CLI .AND. VL_PAR_PG = 0
ENDIF

@ 09,28 GET WCOD_CAR VALID (WCOD_CAR>0) PICT "999999"
READ

WCOD_CON := WCOD_CAR
WNUM_PAR := NUM_PAR

IF LASTKEY() = 27
EXIT
CLS
ENDIF

SELE CARNE
SET FILTER TO WCODIGO = COD_CLI
SET ORDER TO 6
SEEK WCOD_CON + WNUM_PAR
IF FOUND()
WVL_PAR := VL_PAR
WDTVEN_PAR := DTVEN_PAR
WVL_PAR_PG := VL_PAR_PG
WDT_PAR_PG := DT_PAR_PG

SELE CONTRATO
SET ORDER TO 1
SET FILTER TO WCODIGO = COD_CLI
SEEK WCOD_CON
IF FOUND()
WDTEM_CON := DTEM_CON
WCOD_VEN := COD_VEN
WTP_PG_CON := TP_PG_CON
WVL_LIQ_CON := VL_LIQ_CON
SELE CARNE
ENDIF

SELE CARNE
SET ORDER TO 2
SET FILTER TO WCOD_CON = COD_CON
WNUM_PARX := 1
SEEK WNUM_PAR
IF FOUND()
WVL_PAR := VL_PAR
WQTDE_PAR := 0
WQTDE_PAR := (WVL_LIQ_CON / WVL_PAR)
ENDIF

ELSE
BEEP()
MENSAGEM("Cupom nÆo Existe",2)
LOOP
ENDIF

@ 10,28 SAY WDTEM_CON PICT "@D"
@ 11,28 SAY WVL_PAR PICT "@E 99,999.99"
@ 11,54 SAY WDTVEN_PAR PICT "@D"
@ 14,28 SAY WVL_PAR_PG PICT "@E 99,999.99"
@ 14,54 SAY WDT_PAR_PG PICT "@D"

IF WVL_PAR_PG <> 0

WCONF := "N"

BEEP()
MENSAGEM("Parcela j  Baixada",2)
MENSAGEM("Deseja Estorna-la ? (S/N):")
@ 24,53 GET WCONF PICT "@!" VALID WCONF $ "SN"
READ

IF LASTKEY() = 27
WCONF = "N"
ENDIF

IF WCONF = "S"

WVALOR_CON := WVL_PAR_PG
WVL_PAR := WVL_PAR
WVL_PAR_PG := 0
WDT_PAR_PG := CTOD(" / / ")

SELE CARNE
SET ORDER TO 6
SET FILTER TO WCODIGO = COD_CLI
SEEK WCOD_CON + WNUM_PAR
IF FOUND()
IF RLOCK()
REPLACE VL_PAR WITH WVL_PAR
REPLACE VL_PAR_PG WITH WVL_PAR_PG
REPLACE DT_PAR_PG WITH WDT_PAR_PG
UNLOCK
ELSE
MENSAGEM("Arquivo bloqueado por outro usuario")
ENDIF
TONE(100)
TONE(100)
TONE(100)
ELSE
MENSAGEM("Cupom nÆo existe",2)
LOOP
ENDIF

SELE CAIXA
SET ORDER TO 3
SEEK WCOD_CON + WCODIGO
IF FOUND()
IF RLOCK()
DELETE
UNLOCK
ELSE
MENSAGEM("Arquivo bloqueado por outro usuario")
ENDIF
ENDIF
SELE CARNE
LOOP
ELSE
LOOP
CLS
ENDIF
ENDIF

IF WDTVEN_PAR < DATAATU

WDIAS := 0
WTAXA := 0
WJUROS := 0
WDESCONTO := 0

WDIAS := DATAATU - WDTVEN_PAR

WTAXA := (3/30) * WDIAS
WJUROS := (WVL_PAR * WTAXA)/100
WVL_PAR_PG := WVL_PAR + WJUROS
WDT_PAR_PG := DATAATU

@ 12,54 SAY WDIAS PICT "@E 9999"
@ 12,28 GET WJUROS PICT "@E 99,999.99"
@ 13,28 GET WDESCONTO PICT "@E 99,999.99"
@ 14,28 SAY WVL_PAR_PG PICT "@E 99,999.99"
READ

IF LASTKEY() = 27
LOOP
CLS
ENDIF

IF WJUROS <> 0 .OR. WDESCONTO <> 0
WVL_PAR_PG := (WVL_PAR + WJUROS) - WDESCONTO
ELSE
WVL_PAR_PG := WVL_PAR
ENDIF

ELSE

WDIAS := 0
WTAXA := 0
WJUROS := 0
WDESCONTO := 0

WDT_PAR_PG := DATAATU
WTAXA := 10
WDESCONTO := 0
WJUROS := 0

IF WQTDE_PAR < 4
WDESCONTO := (WVL_PAR * WTAXA)/100
WVL_PAR_PG := WVL_PAR - WDESCONTO
WDT_PAR_PG := DATAATU
ELSE
WVL_PAR_PG := WVL_PAR
ENDIF

@ 12,54 SAY WDIAS PICT "@E 9999"
@ 12,28 GET WJUROS PICT "@E 99,999.99"
@ 13,28 GET WDESCONTO PICT "@E 99,999.99"
@ 14,28 SAY WVL_PAR_PG PICT "@E 99,999.99"
READ

IF LASTKEY() = 27
LOOP
CLS
ENDIF

IF WJUROS <> 0 .OR. WDESCONTO <> 0
WVL_PAR_PG := (WVL_PAR + WJUROS) - WDESCONTO
ELSE
WVL_PAR_PG := WVL_PAR
ENDIF

ENDIF

@ 14,28 GET WVL_PAR_PG VALID (WVL_PAR_PG>0) PICT "@E 99,999.99"
@ 14,54 GET WDT_PAR_PG PICT "@D"
@ 16,28 GET WTIPOB PICT "@!" VALID WTIPOB $ "DCA"
READ

IF LASTKEY() = 27
LOOP
CLS
ENDIF

WCONF := "S"

MENSAGEM("Confirma (S/N):")
@ 24,48 GET WCONF PICT "@!" VALID WCONF $ "SN"
READ

IF LASTKEY() = 27
WCONF = "N"
ENDIF

IF WCONF = "S"

WCONF := "S"

MENSAGEM("Confirma Baixa....:")
@ 24,53 GET WCONF PICT "@!" VALID WCONF $ "SN"
READ

IF LASTKEY() = 27
LOOP
CLS
ENDIF

IF WCONF = "S"

SELE CARNE
SET ORDER TO 1
SET FILTER TO WCOD_CON = COD_CON
SEEK WNUM_PAR
IF FOUND()
IF RLOCK()
REPLACE VL_PAR WITH WVL_PAR
REPLACE VL_PAR_PG WITH WVL_PAR_PG
REPLACE DT_PAR_PG WITH WDT_PAR_PG
UNLOCK
ELSE
MENSAGEM("Arquivo bloqueado por outro usuario")
ENDIF
TONE(100)
TONE(100)
TONE(100)
ELSE
MENSAGEM("Cupom nÆo existe",2)
LOOP
ENDIF

SELE CAIXA
SET ORDER TO 4
APPEND BLANK
REPLACE COD_CON WITH WCOD_CON
REPLACE DTEM_CON WITH WDT_PAR_PG
REPLACE COD_CLI WITH WCOD_CLI
REPLACE COD_VEN WITH WCOD_VEN
REPLACE TP_PG_CON WITH WTP_PG_CON
REPLACE VALOR_CON WITH WVL_PAR_PG

IF WVL_PAR_PG < WVL_PAR
IF (WVL_PAR - WDESCONTO) <> WVL_PAR_PG
WRESTO := (WVL_PAR - WDESCONTO) - WVL_PAR_PG
EXTRA()
ENDIF
ENDIF

WCONF = " "
MENSAGEM("Autentica Via Pagto(S/N):")
@ 24,53 GET WCONF PICT "@!" VALID WCONF $ "SN"
READ

IF LASTKEY() = 27
WCONF = "N"
ENDIF

IF WCONF = "S"
AUTENTICA()
ELSE
RECIBO()
IF WTIPO = "B"
VALE()
ENDIF
IF WTIPO = "A"
VALE1()
ENDIF
ENDIF
LOOP
ENDIF
ENDIF
ENDIF

ENDDO
ENDDO

PROCEDURE RECIBO()

WOPCAO = "I"
WCONF = "S"
WPOSCARNE := 0
WRECIBO = SPACE(2)

IF WCONF = "S"

SET ORDER TO 1
SET SOFTSEEK ON
SEEK WCOD_CON
SET SOFTSEEK OFF
LIN := PRow()
MARCA = 61

LIN := PRow()
MARCA = 61

IF WOPCAO = "I"
IMPRESSORA()
ELSE
SET DEVICE TO PRINTER
SET PRINTER TO RECPG.TXT
ENDIF

// 1 2 3 4 5 6
// 0123456789012345678901234567890123456789012345678901234567890
@ LIN,02 SAY "<<<<< SISCREDI - SISTEMA DE CREDIARIO >>>>>"
LIN = LIN+1
@ LIN,01 SAY "==============================================="
LIN = LIN+1
@ LIN,01 SAY "|==== J A N Y ' S M O D A S =====|"
LIN = LIN+1
@ LIN,01 SAY "|= AV. PR, 944 - (44) 448-1011 - MARILENA-PR =|"
LIN = LIN+1
@ LIN,01 SAY "|= =|"
LIN = LIN+1
@ LIN,01 SAY "|=== R E C I B O D E P A G A M E N T O ===|"
LIN = LIN+1
@ LIN,01 SAY "|=============================================|"

LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,03 SAY DATAATU
@ LIN,15 SAY "Recibo:"
@ LIN,23 SAY WCOD_CON
@ LIN,29 SAY "/"

WRECIBO := LTRIM(STR(WNUM_PAR))

@ LIN,30 SAY WRECIBO
@ LIN,47 SAY "|"

LIN = LIN+1
@ LIN,01 SAY "|=============================================|"

SELE CLIENTE
SET ORDER TO 1
SEEK WCOD_CLI
IF FOUND()
WNOME_CLI := CLIENTE-> NOME_CLI
WEND_CLI := CLIENTE-> END_CLI
WCID_CLI := CLIENTE-> CID_CLI
WUF_CLI := CLIENTE-> UF_CLI
WBAIRRO_CLI := CLIENTE-> BAIRRO_CLI
WCPF_CLI := CLIENTE-> CPF_CLI
WRG_CLI := CLIENTE-> RG_CLI
WFONE_CLI := CLIENTE-> FONE_CLI

LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY WCOD_CLI
@ LIN,09 SAY LEFT(WNOME_CLI,38) PICT "@!"
@ LIN,47 SAY "|"

LIN := LIN+1
@ LIN,01 SAY "|"
@ LIN,09 SAY WCPF_CLI PICT "999.999.999-99"
@ LIN,26 SAY WRG_CLI PICT "@!"
@ LIN,47 SAY "|"

LIN = LIN+1
@ LIN,01 SAY "|---------------------------------------------|"

ENDIF

LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,47 SAY "|"

LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY "Numero do Contrato....:"
@ LIN,36 SAY WCOD_CON
@ LIN,47 SAY "|"

LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY "Numero da Parcela.....:"
@ LIN,36 SAY WNUM_PAR
@ LIN,47 SAY "|"

LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY "Data Vencimento.......:"
@ LIN,36 SAY WDTVEN_PAR
@ LIN,47 SAY "|"

LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY "Data Pagamento........:"
@ LIN,36 SAY WDT_PAR_PG
@ LIN,47 SAY "|"

LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,47 SAY "|"

LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY "Valor Parcela.........:"
@ LIN,37 SAY WVL_PAR PICT "@E 99,999.99"
@ LIN,47 SAY "|"

LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY "Valor Juros...........:"
@ LIN,37 SAY WJUROS PICT "@E 99,999.99"
@ LIN,47 SAY "|"

LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY "Valor Desconto........:"
@ LIN,37 SAY WDESCONTO PICT "@E 99,999.99"
@ LIN,47 SAY "|"

LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY "Valor Pago............:"
@ LIN,37 SAY WVL_PAR_PG PICT "@E 99,999.99"
@ LIN,47 SAY "|"

LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,47 SAY "|"

POSFINREC()

LIN = LIN+1
@ LIN,01 SAY "|"
@ LIN,02 SAY "SALDO DEVEDOR--------->"
@ LIN,37 SAY WPOSCARNE PICT "@E 99,999.99"
@ LIN,47 SAY "|"

LIN = LIN+1
@ LIN,01 SAY "|=============================================|"

LIN = LIN+1

WCOD_MEN := 1

SELE MENSA
SET ORDER TO 1
SEEK WCOD_MEN
IF FOUND()
WDESC1_MEN := DESC1_MEN
WDESC2_MEN := DESC2_MEN
ENDIF

@ LIN,03 SAY WDESC1_MEN PICT "@!"
LIN = LIN+1
@ LIN,03 SAY WDESC2_MEN PICT "@!"

LIN = LIN+10
@ LIN,00 SAY " "

SetPrc(0,0)

SET DEVICE TO SCREEN

SET DEVICE TO SCREEN
IF WOPCAO = "T"
SET PRINTER TO
CLEAR
RUN LIST RECPG.TXT
RUN DEL RECPG.TXT
ENDIF

WPOSCARNE := 0

ENDIF

RETURN

PROCEDURE EXTRA()

SELE CARNE
SET ORDER TO 2

WCONTADOR := 0
WDATAP := WDTVEN_PAR

SEEK WCOD_CON
DO WHILE WCOD_CON = COD_CON .AND. ! EOF()

WCONTADOR := NUM_PAR
WCOD_UNICO := COD_UNICO
SKIP

ENDDO

WCONTADOR := WCONTADOR+1

IF! FOUND()
APPEND BLANK
ENDIF
REPLACE COD_CON WITH WCOD_CON
REPLACE COD_UNICO WITH WCOD_UNICO
REPLACE COD_CLI WITH WCOD_CLI
REPLACE NUM_PAR WITH WCONTADOR
REPLACE VL_PAR WITH WRESTO
REPLACE DTVEN_PAR WITH WDTVEN_PAR

RETURN

PROCEDURE EXTRA1()

SELE CARNE
SET ORDER TO 2

WULTIMA := 0

SEEK WCOD_CON
DO WHILE WCOD_CON = COD_CON .AND. ! EOF()

WULTIMA := NUM_PAR
WCOD_UNICO := COD_UNICO
SKIP

ENDDO
RETURN

PROCEDURE EXTRA2()

SELE CHEQUE
SET ORDER TO 5

WULTIMA := 0

SEEK WCOD_CON
DO WHILE WCOD_CON = COD_CON .AND. ! EOF()

IF DT_PG_CH = CTOD(" / / ")
WULTIMA := 1
ENDIF

SKIP

ENDDO
RETURN

PROCEDURE PARCON()

SELE CARNE
SET ORDER TO 2

WTESTE := 0

SEEK WCOD_CON
DO WHILE WCOD_CON = COD_CON .AND. ! EOF()

WTESTE := WTESTE + VL_PAR_PG
SKIP

ENDDO

IF WTESTE <> 0
BEEP()
BEEP()
MENSAGEM("Existe Parcelas j  baixadas",2)
MENSAGEM("O processo ser  encerrado !!",2)
RETURN
END

RETURN

PROCEDURE IMP25()
SET DEVICE TO PRINTER
TECLA = 0

SetPrc(0,0)

DO WHILE (! ISPRINTER()) .AND. TECLA <> 27
SET DEVICE TO SCREEN
MENSAGEM("Verifique impressora - [ESC Retorna] [ENTER Prossegue]")
BEEP()
TECLA = 0
DO WHILE TECLA <> 13 .AND. TECLA <> 27
TECLA = INKEY(0)
ENDDO
SET DEVICE TO PRINTER
ENDDO
IF TECLA = 27
SET DEVICE TO SCREEN
ENDIF
RETURN

[AndersonR]

Caro Marcio,

deu uma olhada rapidamente no seu programa e verifiquei que você não está utilizando os comandos para abertura de arquivo compartilhado(shared).

Como você citou servidor, acredito que seja um programa em rede, portanto você deverá efetuar algumas modificações no seu prg, adaptando-o para rede, exemplo:

USE CLIENTE SHARED
** Faz a verificação se houve erro na abertura do arquivo **
IF NETERR()
?? "Problema na abertura do arquivo cliente"
ENDIF
SET INDEX TO INDCLI1, INDCLI2
ENDIF

Quando for utilizar um REPLACE, você deverá bloquear o registro com o comando RLOCK()

E logo após o REPLACE você deve utilizar o comando COMMIT, além de desbloqueá-lo através do UNLOCK.

Toda operação que tiver alteração nos registros deverão ser bloqueadas antes da gravação (replace, delete, appen blank, recall, entre outros).

Lembrando também que quando utilizamos arquivos em modo compartilhado não se pode reindexar os índices, pois eles precisam ser abertos em modo exclusivo.

Dê uma olhada aqui no Forum que existe bastante material sobre o assunto.

Bom, pelo menos foi isto que entendí.

Espero ter colaborado.


Anderson R.

[AndersonR]

Só corrigindo uma informação:

quando utilizamos o APPEND BLANK não é necessário bloquear o registro, pois o registro já fica bloqueado automaticamente, necessitando apenas de se utilizar o COMMIT e o UNLOCK para deslobqueá-lo.

Anderson R.