Programa em Rede XP

Fórum sobre a linguagem CA-Clipper.

Moderador: Moderadores

ERCS123
Usuário Nível 2
Usuário Nível 2
Mensagens: 95
Registrado em: 28 Jul 2007 19:54
Localização: franca

Programa em Rede XP

Mensagem por ERCS123 »

Olá

Depois de muito tempo tentanto rodar meu sistema no XP, este final de semana consegui, com a ajuda do Maligno, Pringles, Eolo, Pablo Cesar e outros.

Minha proxima etapa seria colocar em rede.

No forum tem muita coisa sobre redes, mas eu sou muito leigo no assunto. Se não for pedir muito, alguem poderia me enviar uma rotina simples de cadastro de clientes (inclusao, alteracao e exclusao) para estudar o código fonte. Só pra ter um noção melhor dos comandos que são usados em Rede.

----------------------------------------
Estou fazendo assim, mas não sei se é a melhor maneira:

Cadastro de clientes:

Do while .t.

sele 1
use clientes alias cli shar
set index to ind_cod, ind_emp

sele 2
use vendedor alias ven shar
set index -------
---
---
--
--
confirma a inclusão? S/N

sele 1
if .not. rlock()
Mensagem: não foi possivel bloquear
dbcloseall()
loop
endif
append blank
repl ---- with --
repl ----with ---
dbunlock()
---
--
enddo
-----------------------------------------------------

Atenciosamente

Ewerton
Editado pela última vez por ERCS123 em 30 Jul 2007 08:55, em um total de 2 vezes.
Avatar do usuário
Pablo César
Usuário Nível 7
Usuário Nível 7
Mensagens: 5312
Registrado em: 31 Mai 2006 10:22
Localização: Curitiba - Paraná

Mensagem por Pablo César »

Oi colega, se você tem dúvidas sobre essas questões em rede, dê uma olhada neste link http://www.caclipperwebsite.com/howto/topico01.htm que está em português. Também veja que existe material sobre isso aqui mesmo no forum (na página principal, seção download).

Baixe estes exemplos do forum para ver se te interessam e resolvem o seu problema de rede: https://pctoledo.org/download/cop ... t&deonde=2
Um clip-abraço !

Pablo César Arrascaeta
Compartilhe suas dúvidas e soluções com todos os colegas aqui do fórum.
Evite enviar as dúvidas técnicas por MPs ou eMails, assim todos iremos beneficiar-nos.
Avatar do usuário
Pablo César
Usuário Nível 7
Usuário Nível 7
Mensagens: 5312
Registrado em: 31 Mai 2006 10:22
Localização: Curitiba - Paraná

Mensagem por Pablo César »

Ví que você re-editou a sua mensagem e adicionou o seu código fonte. Alias, seria melhor você utilizar os recursos de edição especialmente marcar bloco desse seu código e clicar no botão "code" para que a visualização seja melhor endentando seu código.

Eu diria que não há necessidade de você colocar o USE DBF... dentro do DO WHILE. Mas básicamente, o que eu tenho para comentar que o RLOCK serviria para fazer REPLACEs de algo que já existia, quando você utiliza o APPEND BLANK este ja faz o travamento automaticamente (isto foi comentado aqui no forum, e é assim).
Um clip-abraço !

Pablo César Arrascaeta
Compartilhe suas dúvidas e soluções com todos os colegas aqui do fórum.
Evite enviar as dúvidas técnicas por MPs ou eMails, assim todos iremos beneficiar-nos.
ERCS123
Usuário Nível 2
Usuário Nível 2
Mensagens: 95
Registrado em: 28 Jul 2007 19:54
Localização: franca

Mensagem por ERCS123 »

Pablo, essa é uma de minhas principais duvidas: Pode deixar os Uses dentro do While .t., o sistema não vai ficar lento. Eu deixei assim por causa do loop, entendeu? Mas agora depois de mudar umas 12 rotinas de cadastro, esta dando erro (C2024 Unclosed control structures)será que esta ficando muito pesado o programa?
Outra coisa no USE e coloquei o SHAR no lugar do comando NEW, tá certo?
Eu esta vendo uma explicacao no forum, com relacao ao DELE e ZAP, o USE tem que ser EXCLUSIVE, mas se dixo assim dá erro, e se mudo para SHAR funciona. Por isso que queria uma rotina simples, mas completa de um cadastro de clientes, apenas para facilitar a explicação.

Obrigado de novo

Ewerton
Avatar do usuário
Pablo César
Usuário Nível 7
Usuário Nível 7
Mensagens: 5312
Registrado em: 31 Mai 2006 10:22
Localização: Curitiba - Paraná

Mensagem por Pablo César »

Ewerton escreveu:Pablo, essa é uma de minhas principais duvidas: Pode deixar os Uses dentro do While .t.
Nunca, deve ser colocado. Pois assim você estaria "abrir" sucessivamente seu banco de dados repetetivamente, não há necessidade de colocar os USE dentro. O DO WHILE deixa, mas mova os USE para antes do DO WHILE, certo ?.
Ewerton escreveu:Mas agora depois de mudar umas 12 rotinas de cadastro, esta dando erro (C2024 Unclosed control structures)
Você poderia postar novamente seu código, não fique preocupado em postar seu código. Mas pelo que me parece esse erro é porque falta um ENDDO ou algo assim.
Ewerton escreveu:Outra coisa no USE e coloquei o SHAR no lugar do comando NEW, tá certo?
Alias o SHARED é necessário para que você abra o arquivo de forma compartilhado. O NEW, faz parte do nome que quer dar a essa nova áera. Qunado você abre um DBF o sistema cria uma nova área com NEW irá assumir uma nova áerea. Mas pode utilizar assim:

Código: Selecionar todos

SELE 1 // Aqui você define que a área será com nome 1->
USE CLIENTES SHARED // E aqui está abrindo em modo compartilhado
SELE 2
USE NF SHARED
Quando você quer alternar as áerea é simplesmente SELE 1 ou SELE 2, ou se ainda quer atribuir o valor de um campo (de outra área) a uma variável, faça assim:

Código: Selecionar todos

VCLI:=(1->nome)
VNF:=(2->vence)
Ewerton escreveu:Eu esta vendo uma explicacao no forum, com relacao ao DELE e ZAP.
Quando você precisar deletar um registro, você precisará utilizar o RLOCK() e o UNLOCK para desbloquea-lo. Mas o ZAP, não é recomendado a sua utilização em ambiente de rede. Ao menos que você faça um tratamento para que o seu sistema abra de forma EXCLUSIVA o arquivo e os outros esperem para manutenção.
Ewerton escreveu:Por isso que queria uma rotina simples, mas completa de um cadastro de clientes, apenas para facilitar a explicação.
Entendo, mas seria mais interessante ver o seu código-fonte completo ou as partes críticas, para podermos exemplificar melhor a sua situação.
Um clip-abraço !

Pablo César Arrascaeta
Compartilhe suas dúvidas e soluções com todos os colegas aqui do fórum.
Evite enviar as dúvidas técnicas por MPs ou eMails, assim todos iremos beneficiar-nos.
ERCS123
Usuário Nível 2
Usuário Nível 2
Mensagens: 95
Registrado em: 28 Jul 2007 19:54
Localização: franca

Mensagem por ERCS123 »

Abaixo esta o meu codigo fonte de cadastro de clientes, e algumas funcoes que é usado no cadastro.

A razão do do while estar antes dos USER, é para outro usuario ver as alteracoes feitas. E tambem por causa do LOOP que tem dentro do IF NOT RLOCK(). Queria fazer uma função para bloquear e liberar os registros, assim fica mais facil eu alterar o sistema inteiro , que é muito grande (+- 60.000 linhas de programacao).
Sou um programador amador, fiz esse sistema para o meu pai, a mais de 6 anos, agora a empresa cresceu e ele quer colocar 3 micros em rede.

A solucao não precisa ser muito sofisticada, mas eficiente para rodar em 3 micros apenas.

Obrigado!


Código: Selecionar todos

   function prx0004()

   do while (.T.)

   sele 1    
   use clientes alias cli SHAR 
   set index to ind_cod, ind_emp 

   sele 2
   use numer1 alias nu1 SHAR 
   set index to ind_nu1

   sele 3
   use vendedor alias ven SHAR 
   set index to ind_cve, ind_nve

   sele 4
   use ercs1 alias ar2 SHAR 
   set index to ind_u01, ind_u02, ind_u03, ind_u04                

   sele 5 
   use ercs2 alias ar3 SHAR 
   set index to ind_us1, ind_us2 
       

    private m_cod, m_emp, m_end, m_bai, m_cep, m_cid, m_est, m_fon, ;
    m_fax, m_cgc, m_ins, m_abe, m_co1, m_rep, m_ob1, m_ob2


      tecli:= SaveScreen(5, 6, 20, 75)
      sele 1

      m_cod:=0
      m_emp:= Space(40)
      m_end:= Space(40)
      m_bai:= Space(25)
      m_cep:= "00.000-000"
      m_cid:= Space(35)
      m_est:= Space(2)
      m_fon:= "(000) 000-0000"
      m_fax:= "(000) 000-0000"
      m_cgc:= "00.000.000/0000-00"
      m_ins:= space(15)
      m_abe:= Date()
      m_co1:= 0
      m_rep:= Space(30)
      m_ob1:= Space(51)
      m_ob2:= Space(51)


     sele 2   //coloca o codigo do cliente 
      rlock() 
      m_cod:= cod + 1
      repl cod with m_cod  
      dbunlock()


      nomepro()
      centra(2, "®¯ MENU INCLUSAO DE CLIENTE ®¯")
      mens("Inclusao de Clientes  |  <ESC> Sai  |  <F1> Help")
      setcursor(2)
      cor(4)
      @  5,  5 clear to 19, 74
      sombra(05,07,19,74)
      @  5,  5 to 19, 74
      apaga(5,60,5,68,"n/g","n/g")  
      @ 05,60 say "Inclusao"
      cor(4) 
      @ 05,59 say "["    
      @ 05,68 say "]"    
      te0004()
      cor(6)
      @  6, 21 say strzero(m_cod, 4, 0)
      sele 1
      @  6, 32 get m_emp picture "@!" valid m_emp<>space(40)
      @  7, 21 get m_end picture "@!"
      @  8, 21 get m_bai picture "@!"
      @  8, 58 get m_cep picture "##.###-###" valid completa()
      @  9, 21 get m_cid picture "@!" valid m_cid<>space(35)
      @  9, 66 get m_est picture "@!" valid m_est<>space(02)
      @ 10, 21 get m_fon picture "(###)####-####"
      @ 10, 52 get m_fax picture "(###)####-####"
      @ 11, 21 get m_cgc picture "##.###.###/####-##" valid vercgc(m_cgc)
      @ 11, 52 get m_ins picture "###############" 
      @ 13, 21 say m_abe picture "##/##/####"
      @ 14, 21 say m_co1 picture "9999"       
      @ 14, 37 say m_rep picture "##############################"
      @ 16, 21 say m_ob1 picture "@!"
      @ 17, 21 say m_ob2 picture "@!"
      read

      if (LastKey() == 27)
        sele 2     //se sair do sistema, extorna o codigo  
        rlock() 
        m_cod:= cod - 1
        repl cod with m_cod  
        dbunlock()
        dbcloseall()
        return
      endif

      pesq_rep(14,21,14,37,3)
      cor(6) 
      m_rep:=rep
      m_co1:=co1
      @ 14, 21 say strzero(m_co1, 4, 0)           
      @ 14, 37 say m_rep picture "##############################"
      @ 16, 21 get m_ob1 picture "@!"
      @ 17, 21 get m_ob2 picture "@!"
      read
      if (LastKey() == 27)
        sele 2
        rlock() 
        m_cod:= cod - 1
        repl cod with m_cod  
        dbunlock()
        dbcloseall()
        return
      endif
      confirma("Inclusao","Cliente") 
      cresp:= Space(1)
      @ 23, 78 get Cresp picture "@!" valid cresp $ "SN" 
      read
      if (cresp = "S")
         sele 1
         if .not. rlock()
           rede(2)     
           dbcloseall()      
           loop
         endif
         append blank
         repl_var()
         dbunlock()
         loop
       endif
       if (cresp = "N")
         sele 2
         rlock() 
         m_cod:= cod - 1
         repl cod with m_cod  
         dbunlock()
       endif
    enddo
    dbcloseall()
    lib_var()
    (5, 6, 20, 75, restscreen:= tecli)
    return("")

*-----------------------------------------------------------------------------*

    function prx0005()


    do while (.T.) 

    sele 1
    use clientes shar index ind_cod, ind_emp 
    sele 2
    use vendedor shar index ind_cve, ind_nve
    sele 3
    use ercs1 alias ar2 shar
    set index to ind_u01, ind_u02, ind_u03, ind_u04                
    sele 4 
    use ercs2 alias ar3 shar
    set index to ind_us1, ind_us2 


    sele 1
    private m_cod, m_emp, m_end, m_bai, m_cep, m_cid, m_est, m_fon, ;
    m_fax, m_cgc, m_ins, m_abe, m_co1,m_rep, m_ob1, m_ob2 
    tecli:= SaveScreen(5, 6, 20, 75)
    nomepro()
    centra(2, "®¯ MENU ALTERACAO DE CLIENTE ®¯")
    mens("Alteracao de Cliente  |  <ESC> Sai  |  <F1> Help")
    cor(4)
    setcursor(2)
    m_cod:= 0
    setcursor(2)
    @  5,  5 clear to 19, 74
    sombra(05,07,19,74)
    @  5,  5 to 19, 74
    apaga(5,60,5,69,"n/g","n/g")  
    @ 05,60 say "Alteracao"
    cor(4) 
    @ 05,59 say "["    
    @ 05,69 say "]"    
    te0004()
    pesq_cli(06,21,06,32,1)
*****////*******
    if found()
       if .not. rlock()
          rede(2)
          close databases
          loop
      endif
    endif
*******/////*******   
    igual_var()
    cor(6)
     @  6, 21 say strzero(m_cod, 4, 0)
     @  6, 32 get m_emp picture "@!" valid m_emp<>space(40)
     @  7, 21 get m_end picture "@!"
     @  8, 21 get m_bai picture "@!"
     @  8, 58 get m_cep picture "##.###-###" 
     @  9, 21 get m_cid picture "@!" valid m_cid<>space(35)
     @  9, 66 get m_est picture "@!" valid m_est<>space(02)
     @ 10, 21 get m_fon picture "(###)####-####"
     @ 10, 52 get m_fax picture "(###)####-####"
     @ 11, 21 get m_cgc picture "##.###.###/####-##" valid vercgc(m_cgc)
     @ 11, 52 get m_ins picture "###############" 
     @ 13, 21 say m_abe picture "##/##/####"
     @ 14, 21 say m_co1 picture "9999"       
     @ 14, 37 say m_rep picture "##############################"
     @ 16, 21 say m_ob1 picture "@!"
     @ 17, 21 say m_ob2 picture "@!"
     read
     if (LastKey() == 27)
       close databases
       return
       endif
    pesq_rep(14,21,14,37,2)
    cor(6) 
    m_rep:=rep
    @ 14, 21 say strzero(m_co1, 4, 0)           
    @ 14, 37 say rep picture "##############################"
    sele 1 
    @ 16, 21 get m_ob1 picture "@!"
    @ 17, 21 get m_ob2 picture "@!"
    read
    confirma("Alteracao","Cliente") 
    cresp:= Space(1)
    @ 23, 78 get Cresp picture "@!" valid cresp $ "SN"
    read

    if (cresp = "S")
      sele 1
      if .not. rlock() 
         rede(1)     
         dbcloseall()      
         loop
      endif
      repl_var()
      dbunlock()
      loop
  endif


   if (cresp = "N")
     loop
   endif

   if (LastKey() == 27)
      loop
   endif

  enddo
  close databases
  select 1
  lib_var() 
  (5, 6, 20, 75, restscreen:= tecli)
  return("")
*-----------------------------------------------------------------------------*

  function prx0007()
   
  do while (.T.)

  sele 1    
  use clientes alias cli SHAR
  set index to ind_cod, ind_emp 

  sele 2
  use ercs1 alias ar2 SHAR
  set index to ind_u01, ind_u02, ind_u03, ind_u04                

  sele 3 
  use ercs2 alias ar3 SHAR
  set index to ind_us1, ind_us2 

  private m_cod,m_emp,m_rep

    tecli:= SaveScreen(5, 6, 20, 75)
    nomepro()
    centra(2, "®¯ MENU EXCLUSAO DO CLIENTE ®¯")
    mens("EXCLUSAO de Cliente  |  <ESC> Sai  |  <F1> Help")
    m_cod:= 0
    sele 1
    cod:= 0
    m_emp:=space(40)
    m_rep:=space(30)
    setcursor(2)
    cor(4)
    @  5,  5 clear to 19, 74
    sombra(05,07,19,74)
    @  5,  5 to 19, 74
    apaga(5,60,5,68,"n/g","n/g")  
    @ 05,60 say "Exclusao"
    cor(4) 
    @ 05,59 say "["    
    @ 05,68 say "]"    
      te0004()
      cor(6)
      set softseek on 
      @  6, 21 get m_cod picture "9999"
      read
      if (LastKey() == 27)
        close databases
        return
      endif
      set softseek off
      keyboard Chr(13)
      pesq_cli(06,21,06,32,1)
     if found()
        if .not. rlock()
           rede(2)
           close databases
           loop
       endif
     endif
     m_cod:=cod 
      cor(6)
      @  6, 21 say strzero(m_cod, 4, 0)
      @  6, 32 say emp picture "@!"
      @  7, 21 say end picture "@!"
      @  8, 21 say bai picture "@!"
      @  8, 58 say cep picture "##.###-###"
      @  9, 21 say cid picture "@!"
      @  9, 66 say est picture "@!"
      @ 10, 21 say fon picture "(###)####-####"
      @ 10, 52 say fax picture "(###)####-####"
      @ 11, 21 say cgc picture "##.###.###/####-##" 
      @ 11, 52 say ins picture "###############" 
      @ 13, 21 say abe picture "##/##/####"
      @ 14, 21 say co1 picture "9999"
      @ 14, 37 say rep picture "##############################"
      @ 16, 21 say ob1 picture "@!"
      @ 17, 21 say ob2 picture "@!"
      read
      m_emp:=emp
      m_rep:=rep     
      confirma("Exclusao","Cliente") 
      cresp:= Space(1)
      @ 23, 78 get Cresp picture "@!" valid cresp $ "SN"
      read
      if (cresp = "S")
      sele 1
      if .not. rlock() 
          rede(3)     
          dbcloseall()      
          loop
      endif
      dele
      dbunlock()
      loop
    endif

    if (cresp = "N")
      loop
    endif

   if (LastKey() == 27)
      loop
   endif

 enddo
 close databases
 select 1
 lib_var() 
 (5, 6, 20, 75, restscreen:= tecli)
 return
------------------------------------------------------------------

 function lib_var()

 a=fcount()
 for i = 1 to a
   if type(field(i))<>"m_"
     nomevar="m_"+field(i)
     release &nomevar
   endif
 next
 release nomevar

-------------------------------------------------
 function repl_var()

 a=fcount()
 for i = 1 to a
   if type(field(i))<>"m_"
      nomecampo=field(i)
      nomevar="m_"+nomecampo
      if type("&nomevar")<>"u"
         repl &nomecampo with &nomevar
      endif
    endif
  next
**********************************************
 function rede(r_rede)

  if pcount() != 1
     verifica()
  endif
  do case
    case r_rede == 1
        setcolor("gr+*/b")
        setcursor(0)
        @ 23,13 say "                                                        " 
        @ 23,13 say " Nao foi possivel concluir - Arquivo nao Bloqueado!"
        tone(900,9)
        tone(900,9)
        inkey(0)
    case r_rede == 2
        setcolor("gr+*/b")
        setcursor(0)
        @ 23,13 say "                                                        " 
        @ 23,13 say  " Arquivo sendo usado por outro Usuario!"
        tone(900,7)
        inkey(0)
    case r_rede == 3
        setcolor("gr+*/b")
        setcursor(0)
        @ 23,13 say "                                                        " 
        @ 23,13 say  " Arquivo esta em uso, nao pode ser EXCLUIDO! "
        tone(900,9)
        inkey(0)
    endcase   
    return("")
**************************************************************************
 function indice()  //faz a criacao dos indices

 set cursor off       
 save screen to index
 nomepro()
 setcolor("w+/b")
 abrebox(12,09,14,65,"b/b") 
 sombra(12,09,14,65)
 valor:=0
 ultimo:=171
 termoh(valor)
 t:=0
 c:=0

use numer1 exclusive new
trava()
pack
index on cod to ind_nu1
mens("Indexando Arquivo 001 - Controle")
valor=(++c)*100/ultimo
termoh(valor)

use numer2 exclusive new
trava()
pack
index on codi to ind_nu2
mens("Indexando Arquivo 002 - Controle")
valor=(++c)*100/ultimo
termoh(valor)
---
---
--
--

use mapa3 exclusive new
trava()
pack
index on pres to ind_pr9
valor=(++c)*100/ultimo
termoh(valor)

use bancaria exclusive new
trava()
pack
index on emi to ind_ch8
index on doc to ind_ch7
mens("Indexando Arquivo 001 - Impressao Cheque")
valor=(++c)*100/ultimo
termoh(valor)

setcursor(0)
@ 23,13 say "                                                        " 
mens("Aguarde, Finalizando Rotina...")
valor=(++c)*100/ultimo
termoh(valor) 
dbcloseall()
tone(900,1)
restore screen from index                   
cor(4)
set cursor off       
return 
-----------------------
 function trava()

 if neterr()
    rede(2) 
    dbcloseall()
    return .f.
    endif
 return("")
Avatar do usuário
Pablo César
Usuário Nível 7
Usuário Nível 7
Mensagens: 5312
Registrado em: 31 Mai 2006 10:22
Localização: Curitiba - Paraná

Mensagem por Pablo César »

Ewerton, experimenta com estas correções (foram muito poucas), não deu para eu poder compilar e executar, pois não tenho os DBFs, seria bom se me pudesse passar a estrutura dos arquivos caso não tenha resolvido:

Código: Selecionar todos

FUNCTION PRX0004()
sele 1
use clientes alias cli SHAR
set index to ind_cod, ind_emp

sele 2
use numer1 alias nu1 SHAR
set index to ind_nu1

sele 3
use vendedor alias ven SHAR
set index to ind_cve, ind_nve

sele 4
use ercs1 alias ar2 SHAR
set index to ind_u01, ind_u02, ind_u03, ind_u04

sele 5
use ercs2 alias ar3 SHAR
set index to ind_us1, ind_us2


private m_cod, m_emp, m_end, m_bai, m_cep, m_cid, m_est, m_fon, ;
m_fax, m_cgc, m_ins, m_abe, m_co1, m_rep, m_ob1, m_ob2

tecli:= SaveScreen(5, 6, 20, 75)

do while (.T.)
   sele 1

   m_cod:=0
   m_emp:= Space(40)
   m_end:= Space(40)
   m_bai:= Space(25)
   m_cep:= "00.000-000"
   m_cid:= Space(35)
   m_est:= Space(2)
   m_fon:= "(000) 000-0000"
   m_fax:= "(000) 000-0000"
   m_cgc:= "00.000.000/0000-00"
   m_ins:= space(15)
   m_abe:= Date()
   m_co1:= 0
   m_rep:= Space(30)
   m_ob1:= Space(51)
   m_ob2:= Space(51)


   Sele 2   //coloca o codigo do cliente
   rlock()
   m_cod:= cod + 1
   repl cod with m_cod
   dbunlock()

   nomepro()
   centra(2, "®¯ MENU INCLUSAO DE CLIENTE ®¯")
   mens("Inclusao de Clientes  |  <ESC> Sai  |  <F1> Help")
   setcursor(2)
   cor(4)
   @  5,  5 clear to 19, 74
   sombra(05,07,19,74)
   @  5,  5 to 19, 74
   apaga(5,60,5,68,"n/g","n/g")
   @ 05,60 say "Inclusao"
   cor(4)
   @ 05,59 say "["
   @ 05,68 say "]"
   te0004()
   cor(6)
   @  6, 21 say strzero(m_cod, 4, 0)
   sele 1
   @  6, 32 get m_emp picture "@!" valid m_emp<>space(40)
   @  7, 21 get m_end picture "@!"
   @  8, 21 get m_bai picture "@!"
   @  8, 58 get m_cep picture "##.###-###" valid completa()
   @  9, 21 get m_cid picture "@!" valid m_cid<>space(35)
   @  9, 66 get m_est picture "@!" valid m_est<>space(02)
   @ 10, 21 get m_fon picture "(###)####-####"
   @ 10, 52 get m_fax picture "(###)####-####"
   @ 11, 21 get m_cgc picture "##.###.###/####-##" valid vercgc(m_cgc)
   @ 11, 52 get m_ins picture "###############"
   @ 13, 21 say m_abe picture "##/##/####"
   @ 14, 21 say m_co1 picture "9999"
   @ 14, 37 say m_rep picture "##############################"
   @ 16, 21 say m_ob1 picture "@!"
   @ 17, 21 say m_ob2 picture "@!"
   read

   if (LastKey() == 27)
     sele 2     //se sair do sistema, extorna o codigo
     rlock()
     m_cod:= cod - 1
     repl cod with m_cod
     dbunlock()
     dbcloseall()
     return
   endif

   pesq_rep(14,21,14,37,3)
   cor(6)
   m_rep:=rep
   m_co1:=co1
   @ 14, 21 say strzero(m_co1, 4, 0)
   @ 14, 37 say m_rep picture "##############################"
   @ 16, 21 get m_ob1 picture "@!"
   @ 17, 21 get m_ob2 picture "@!"
   read
   if (LastKey() == 27)
     sele 2
     rlock()
     m_cod:= cod - 1
     repl cod with m_cod
     dbunlock()
     dbcloseall()
     return
   endif
   confirma("Inclusao","Cliente")
   cresp:= Space(1)
   @ 23, 78 get Cresp picture "@!" valid cresp $ "SN"
   read
   if (cresp = "S")
      sele 1
      if .not. rlock()
        rede(2)
        dbcloseall()
        loop
      endif
      append blank
      repl_var()
      dbunlock()
      loop
    endif
    if (cresp = "N")
       sele 2
       rlock()
       m_cod:= cod - 1
       repl cod with m_cod
       dbunlock()
    endif
enddo
dbcloseall()
lib_var()
(5, 6, 20, 75, restscreen:= tecli)
return("")

FUNCTION PRX0005()
sele 1
use clientes shar index ind_cod, ind_emp
sele 2
use vendedor shar index ind_cve, ind_nve
sele 3
use ercs1 alias ar2 shar
set index to ind_u01, ind_u02, ind_u03, ind_u04
sele 4
use ercs2 alias ar3 shar
set index to ind_us1, ind_us2
    
sele 1
private m_cod, m_emp, m_end, m_bai, m_cep, m_cid, m_est, m_fon, ;
m_fax, m_cgc, m_ins, m_abe, m_co1,m_rep, m_ob1, m_ob2
tecli:= SaveScreen(5, 6, 20, 75)
do while (.T.)
   nomepro()
   centra(2, "®¯ MENU ALTERACAO DE CLIENTE ®¯")
   mens("Alteracao de Cliente  |  <ESC> Sai  |  <F1> Help")
   cor(4)
   setcursor(2)
   m_cod:= 0
   setcursor(2)
   @  5,  5 clear to 19, 74
   sombra(05,07,19,74)
   @  5,  5 to 19, 74
   apaga(5,60,5,69,"n/g","n/g")
   @ 05,60 say "Alteracao"
   cor(4)
   @ 05,59 say "["
   @ 05,69 say "]"
   te0004()
   pesq_cli(06,21,06,32,1)
   *****////*******
   if found()
      if .not. rlock()
         rede(2)
                           // close databases (tirar isto, nao pode fechar BD, ainda)
         loop
     endif
   endif
   *******/////*******
   igual_var()
   cor(6)
   @  6, 21 say strzero(m_cod, 4, 0)
   @  6, 32 get m_emp picture "@!" valid m_emp<>space(40)
   @  7, 21 get m_end picture "@!"
   @  8, 21 get m_bai picture "@!"
   @  8, 58 get m_cep picture "##.###-###"
   @  9, 21 get m_cid picture "@!" valid m_cid<>space(35)
   @  9, 66 get m_est picture "@!" valid m_est<>space(02)
   @ 10, 21 get m_fon picture "(###)####-####"
   @ 10, 52 get m_fax picture "(###)####-####"
   @ 11, 21 get m_cgc picture "##.###.###/####-##" valid vercgc(m_cgc)
   @ 11, 52 get m_ins picture "###############"
   @ 13, 21 say m_abe picture "##/##/####"
   @ 14, 21 say m_co1 picture "9999"
   @ 14, 37 say m_rep picture "##############################"
   @ 16, 21 say m_ob1 picture "@!"
   @ 17, 21 say m_ob2 picture "@!"
   read
   if (LastKey() == 27)
      close databases
      return
    endif
    pesq_rep(14,21,14,37,2) 
    cor(6) 
    m_rep:=rep 
    @ 14, 21 say strzero(m_co1, 4, 0)            
    @ 14, 37 say rep picture "##############################" 
    sele 1 
    @ 16, 21 get m_ob1 picture "@!" 
    @ 17, 21 get m_ob2 picture "@!" 
    read 
    confirma("Alteracao","Cliente") 
    cresp:= Space(1) 
    @ 23, 78 get Cresp picture "@!" valid cresp $ "SN" 
    read 

    if (cresp = "S") 
       sele 1
       if .not. rlock()
          rede(1)
                            // dbcloseall()
          loop
       endif
       repl_var()
       dbunlock()
       loop
    endif
    
    if (cresp = "N")
       loop
    endif

    if (LastKey() == 27)
       loop
    endif

enddo
close databases
select 1
lib_var()
(5, 6, 20, 75, restscreen:= tecli)
return("")


FUNCTION PRX0007()
sele 1
use clientes alias cli SHAR
set index to ind_cod, ind_emp

sele 2
use ercs1 alias ar2 SHAR
set index to ind_u01, ind_u02, ind_u03, ind_u04

sele 3
use ercs2 alias ar3 SHAR
set index to ind_us1, ind_us2

private m_cod,m_emp,m_rep

tecli:= SaveScreen(5, 6, 20, 75)
do while (.T.)
   nomepro()
   centra(2, "®¯ MENU EXCLUSAO DO CLIENTE ®¯")
   mens("EXCLUSAO de Cliente  |  <ESC> Sai  |  <F1> Help")
   m_cod:= 0
   sele 1
   cod:= 0
   m_emp:=space(40)
   m_rep:=space(30)
   setcursor(2)
   cor(4)
   @  5,  5 clear to 19, 74
   sombra(05,07,19,74)
   @  5,  5 to 19, 74
   apaga(5,60,5,68,"n/g","n/g")
   @ 05,60 say "Exclusao"
   cor(4)
   @ 05,59 say "["
   @ 05,68 say "]"
   te0004()
   cor(6)
   set softseek on
   @  6, 21 get m_cod picture "9999"
   read
   if (LastKey() == 27)
      close databases
      return
   endif
   set softseek off
   keyboard Chr(13)
   pesq_cli(06,21,06,32,1)
   if found()
      if .not. rlock()
          rede(2)
                              // close databases
          loop
      endif
   endif
   m_cod:=cod
   cor(6)
   @  6, 21 say strzero(m_cod, 4, 0)
   @  6, 32 say emp picture "@!"
   @  7, 21 say end picture "@!"
   @  8, 21 say bai picture "@!"
   @  8, 58 say cep picture "##.###-###"
   @  9, 21 say cid picture "@!"
   @  9, 66 say est picture "@!"
   @ 10, 21 say fon picture "(###)####-####"
   @ 10, 52 say fax picture "(###)####-####"
   @ 11, 21 say cgc picture "##.###.###/####-##"
   @ 11, 52 say ins picture "###############"
   @ 13, 21 say abe picture "##/##/####"
   @ 14, 21 say co1 picture "9999"
   @ 14, 37 say rep picture "##############################"
   @ 16, 21 say ob1 picture "@!"
   @ 17, 21 say ob2 picture "@!"
   read
   m_emp:=emp
   m_rep:=rep
   confirma("Exclusao","Cliente")
   cresp:= Space(1)
   @ 23, 78 get Cresp picture "@!" valid cresp $ "SN"
   read
   if (cresp = "S")
      sele 1
      if .not. rlock()
         rede(3)
                               // dbcloseall()
         loop
      endif
      dele
      dbunlock()
      loop
   endif

   if (cresp = "N")
     loop
   endif

   if (LastKey() == 27) 
      loop 
   endif 

enddo
close databases
select 1
lib_var()
(5, 6, 20, 75, restscreen:= tecli)
return

FUNCTION LIB_VAR()
a=fcount()
for i = 1 to a
    if type(field(i))<>"m_"
       nomevar="m_"+field(i)
       release &nomevar
    endif
next
release nomevar

FUNCTION REPL_VAR()
a=fcount()
for i = 1 to a
    if type(field(i))<>"m_"
       nomecampo=field(i)
       nomevar="m_"+nomecampo
       if type("&nomevar")<>"u"
          repl &nomecampo with &nomevar
       endif
    endif
next

FUNCTION REDE(R_REDE)
if pcount() != 1
   verifica()
endif
do case
   case r_rede == 1
        setcolor("gr+*/b")
        setcursor(0)
        @ 23,13 say "                                                        "
        @ 23,13 say " Nao foi possivel concluir - Arquivo nao Bloqueado!"
        tone(900,9)
        tone(900,9)
        inkey(0)
   case r_rede == 2
        setcolor("gr+*/b")
        setcursor(0)
        @ 23,13 say "                                                        "
        @ 23,13 say  " Arquivo sendo usado por outro Usuario!"
        tone(900,7)
        inkey(0)
   case r_rede == 3
        setcolor("gr+*/b")
        setcursor(0)
        @ 23,13 say "                                                        "
        @ 23,13 say  " Arquivo esta em uso, nao pode ser EXCLUIDO! "
        tone(900,9)
        inkey(0)
endcase
return("")

FUNCTION INDICE()  //FAZ A CRIACAO DOS INDICES
set cursor off
save screen to index
nomepro()
setcolor("w+/b")
abrebox(12,09,14,65,"b/b")
sombra(12,09,14,65)
valor:=0
ultimo:=171
termoh(valor)
t:=0
c:=0

use numer1 exclusive new 
trava() 
pack 
index on cod to ind_nu1 
mens("Indexando Arquivo 001 - Controle") 
valor=(++c)*100/ultimo 
termoh(valor) 

use numer2 exclusive new 
trava() 
pack 
index on codi to ind_nu2 
mens("Indexando Arquivo 002 - Controle") 
valor=(++c)*100/ultimo 
termoh(valor) 



use mapa3 exclusive new 
trava() 
pack 
index on pres to ind_pr9 
valor=(++c)*100/ultimo 
termoh(valor) 

use bancaria exclusive new 
trava() 
pack 
index on emi to ind_ch8 
index on doc to ind_ch7 
mens("Indexando Arquivo 001 - Impressao Cheque") 
valor=(++c)*100/ultimo 
termoh(valor) 

setcursor(0) 
@ 23,13 say "                                                        " 
mens("Aguarde, Finalizando Rotina...") 
valor=(++c)*100/ultimo 
termoh(valor) 
dbcloseall() 
tone(900,1) 
restore screen from index                    
cor(4) 
set cursor off        
return 

FUNCTION TRAVA()
if neterr()
   rede(2)
   dbcloseall()
   return .f.
endif
return("")
Um clip-abraço !

Pablo César Arrascaeta
Compartilhe suas dúvidas e soluções com todos os colegas aqui do fórum.
Evite enviar as dúvidas técnicas por MPs ou eMails, assim todos iremos beneficiar-nos.
ERCS123
Usuário Nível 2
Usuário Nível 2
Mensagens: 95
Registrado em: 28 Jul 2007 19:54
Localização: franca

Mensagem por ERCS123 »

Pablo,

Código: Selecionar todos

---
----
seek m_cod
if (!found())
   mens: cliente nao cadastrado
   loop
endif
 if found() 
      if .not. rlock()     *****AQUI   (A)
         loop 
     endif 
   endif 
------------
---------
  confirma("Alteracao","Cliente") 
    cresp:= Space(1) 
    @ 23, 78 get Cresp picture "@!" valid cresp $ "SN" 
    read 

    if (cresp = "S") 
      sele 1 
      if .not. rlock() 
         rede(1)      
         dbcloseall()      
         loop 
      endif 
      repl_var() 
      dbunlock() 
      loop 
  endif 


   if (cresp = "N")    ********AQUI  (B)
     loop 
   endif 

   if (LastKey() == 27)    *******AQUI   (C)
      loop 
   endif 

  enddo 
  close databases 
  select 1 
  lib_var() 
  (5, 6, 20, 75, restscreen:= tecli) 
  return("") 

No caso, se eu não quiser confirmar a alteracao do cliente (B), ou se teclar ESC p/ sair (C), devo colocar tambem o DBUNLOCK(), para poder liberar o DBF que foi bloqueado (A).

Ewerton
Avatar do usuário
Pablo César
Usuário Nível 7
Usuário Nível 7
Mensagens: 5312
Registrado em: 31 Mai 2006 10:22
Localização: Curitiba - Paraná

Mensagem por Pablo César »

Em nenhum deles como indicado (A, B e C), não precisam, pois alí o sistema não conseguiu travar registro.

Conseguiu algum resultado ? Isto é, compilou e funcionou bem ?
Um clip-abraço !

Pablo César Arrascaeta
Compartilhe suas dúvidas e soluções com todos os colegas aqui do fórum.
Evite enviar as dúvidas técnicas por MPs ou eMails, assim todos iremos beneficiar-nos.
ERCS123
Usuário Nível 2
Usuário Nível 2
Mensagens: 95
Registrado em: 28 Jul 2007 19:54
Localização: franca

Mensagem por ERCS123 »

Pablo,

Precisa colocar o if not rlock ( A ), sempre apos o SEEK, ou não é necessario? Pergunto, porque seria uma coisa a mesnos que eu precisaria acrescentar no programa. Qual a sua opnião?

Fiz as alteraçoes que voce me indicou, e rodou normal. OBRIGADO!

Ewerton
Avatar do usuário
Pablo César
Usuário Nível 7
Usuário Nível 7
Mensagens: 5312
Registrado em: 31 Mai 2006 10:22
Localização: Curitiba - Paraná

Mensagem por Pablo César »

Acho que é fundamental o item A, pois tem que verificar se existe o cliente. Mas não sei se o que será alterado é o arquivo de cliente ou outro DBF. Mas acho que essa verificação (se cliente existe) você ja o faz anteriormente. Se estiver redundante (pode tirar o 2º SEEK).

Outra coisa que estou percebendo, você não desabilitou o DBCLOSEALL()caso não consiga travar registro. Neste caso não haveria necessidade de fechar os BDs.

O que eu acho redundante mesmo, é o item B. Pois de todas formas irá fazer o looping e não executar o REPLACE. Mas o item C, estaria errado, porque você não está dando uma forma de saída do looping.
Um clip-abraço !

Pablo César Arrascaeta
Compartilhe suas dúvidas e soluções com todos os colegas aqui do fórum.
Evite enviar as dúvidas técnicas por MPs ou eMails, assim todos iremos beneficiar-nos.
ERCS123
Usuário Nível 2
Usuário Nível 2
Mensagens: 95
Registrado em: 28 Jul 2007 19:54
Localização: franca

Mensagem por ERCS123 »

Pablo, no caso da ( A ) eu pensei no seguinte:

Se o SEEK encontrar o cliente, ira bloquear o DBF, para outro usuario não usar ao mesmo tempo o mesmo registro.

No caso da ( B e C ), se não confirmar a ALTERACAO do registro (if cresp= "S"),o clipper vai pular para a linha de comando B ou C, e o DBF vai estar bloqueado pelo comando ( A ) , por isso pensei que na B e C teria que desbloquear ( acrescentar um dbunlock na B e C)

Deu p/ entender mais ou menos?


Ewerton
Avatar do usuário
Pablo César
Usuário Nível 7
Usuário Nível 7
Mensagens: 5312
Registrado em: 31 Mai 2006 10:22
Localização: Curitiba - Paraná

Mensagem por Pablo César »

ERCS123 escreveu:Se o SEEK encontrar o cliente, ira bloquear o DBF, para outro usuario não usar ao mesmo tempo o mesmo registro.
Você quiz dizer bloquear REGISTRO, não ARQUIVO (pois este não é necessário e nem deve.
ERCS123 escreveu:Deu p/ entender mais ou menos?
Mais ou menos... Mas entenda que o DBCLOSEALL, não debe estar dentro do DO WHILE (ao menos no caso de saída com RETURN).

Quer outro, conselho ? Mete as caras com um TBROWSE que você vai passar a programar em outro estilo. Melhor, mais prático mais estético e com mais recursos. Dê uma procurada no botão "Busca" por TBROWSE que você irá encontrar exemplos e que tenho certeza que você irá gostar.
Um clip-abraço !

Pablo César Arrascaeta
Compartilhe suas dúvidas e soluções com todos os colegas aqui do fórum.
Evite enviar as dúvidas técnicas por MPs ou eMails, assim todos iremos beneficiar-nos.
ERCS123
Usuário Nível 2
Usuário Nível 2
Mensagens: 95
Registrado em: 28 Jul 2007 19:54
Localização: franca

Mensagem por ERCS123 »

Valeu Pablo, obrigado!
Responder