Programa em Rede XP
Moderador: Moderadores
Programa em Rede XP
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
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.
- Pablo César
- Usuário Nível 7

- Mensagens: 5312
- Registrado em: 31 Mai 2006 10:22
- Localização: Curitiba - Paraná
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
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.
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.
- Pablo César
- Usuário Nível 7

- Mensagens: 5312
- Registrado em: 31 Mai 2006 10:22
- Localização: Curitiba - Paraná
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).
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.
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.
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
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
- Pablo César
- Usuário Nível 7

- Mensagens: 5312
- Registrado em: 31 Mai 2006 10:22
- Localização: Curitiba - Paraná
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:Pablo, essa é uma de minhas principais duvidas: Pode deixar os Uses dentro do While .t.
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:Mas agora depois de mudar umas 12 rotinas de cadastro, esta dando erro (C2024 Unclosed control structures)
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:Ewerton escreveu:Outra coisa no USE e coloquei o SHAR no lugar do comando NEW, tá certo?
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 SHAREDCódigo: Selecionar todos
VCLI:=(1->nome)
VNF:=(2->vence)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:Eu esta vendo uma explicacao no forum, com relacao ao DELE e ZAP.
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.Ewerton escreveu:Por isso que queria uma rotina simples, mas completa de um cadastro de clientes, apenas para facilitar a explicaçã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.
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.
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!
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("")
- Pablo César
- Usuário Nível 7

- Mensagens: 5312
- Registrado em: 31 Mai 2006 10:22
- Localização: Curitiba - Paraná
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.
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.
Pablo,
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
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
- Pablo César
- Usuário Nível 7

- Mensagens: 5312
- Registrado em: 31 Mai 2006 10:22
- Localização: Curitiba - Paraná
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 ?
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.
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.
- Pablo César
- Usuário Nível 7

- Mensagens: 5312
- Registrado em: 31 Mai 2006 10:22
- Localização: Curitiba - Paraná
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.
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.
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.
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
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
- Pablo César
- Usuário Nível 7

- Mensagens: 5312
- Registrado em: 31 Mai 2006 10:22
- Localização: Curitiba - Paraná
Você quiz dizer bloquear REGISTRO, não ARQUIVO (pois este não é necessário e nem deve.ERCS123 escreveu:Se o SEEK encontrar o cliente, ira bloquear o DBF, para outro usuario não usar ao mesmo tempo o mesmo registro.
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).ERCS123 escreveu:Deu p/ entender mais ou menos?
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.
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.
