Página 1 de 2

Clipper Summer87

Enviado: 09 Abr 2005 15:45
por Rusimar Pessanha Pereira
Eu não consegui migrar para outro programa e por isso estou com um problema, é o seguinte:
Gostaria de colocar no início do programa uma tela de senha, onde teria o nome usuário e a senha, quando o programa fosse aberto pela 1ª vez, o usuário teria de se cadastrar e depois, em algum menu, poderia trocar a senha e até cadastrar outros usuários.
Outra Dúvida:

Estou comecando a me complicar no Summer87. E o seguinte:
Tenho um banco de dados com os seguintes campos:
Emissão – data
Codcli – Caracter – espaco 6
CodPro – Caracter – Espaço 5
Tem mais campo, mas não vem ao caso no momento.
Eu gostaria de fazer o seguinte:
Digitar o código e aparece o nome do cliente
Digitar a data da emissão
Digitar o código do produto e aparecer o nome do produto
Agora que vem o problema!!!!
Quando eu digitar a data, o sistema procura se o cliente pegou o produto e que data ele apanhou. Eu gostaria q se o cliente pegou o mesmo produto antes de 30 dias, o sistema me avisasse: “ Cliente pegou esse produto em ___/___/___.””
Exemplo: Suponhamos que o cliente de código nº 001251 pegou o produto nº 21524 no dia 21/01/2005, so q o mesmo cliente 001251 quer pegar o produto 21524 em 15/02/2005, ai que vêm o aviso: Cliente pegou esse produto em 21/01/2005.”

Ai vai o código fonte:

Código: Selecionar todos

set intensity off
set confirm off
set color to w+/b+
@ 3, 1 to 3, 78 double
@ 21, 1 to 21, 78
select (1)
use paciente index codpaci, paciente, datanasc
select (2)
use saidas index codcli3, codpaci1, indemis

select (3)
use marpec index codigo, produto

select (4)
use estoque index estoque1, estoque2, estoque3

set color to gr++/b+
@ 2, 1 clear to 2, 78
do alinha with ' S A I D A S D E M E D I C A M E N T O S ', 2

do mensagem with ' '
set color to gr++/b+
@ 4, 1 clear to 20, 78

@ 6, 1 say 'Pront...........: ' 
@ 8, 1 say 'Paciente .......: ' 
@ 10, 1 say 'Data da Saida ..: ' 
@ 12, 1 say 'Cod.Medicamento : ' 
@ 14, 1 say 'Medicamento ....: ' 
@ 16, 1 say 'Quant. da Saida : Quantidade Atual: ' 

save screen to telasaida
do while .t.
restore screen from telasaida
set delimiters off
do mensagem with '<F1> Consulta, <ENTER> Sai ou entre com o Codigo'
set color to r/w
cod = space (6)

select (1)
set key 28 to hcliente
set color to r/w
@ 6, 19 get cod picture '@K 999999'
read

if lastkey () = 27
close all
return
endif

if cod <= '000000' .or. cod = space (6)
close all
return
endif

find (cod)

if eof ()
aviso = 'PACIENTE não CADASTRADO!!'
do aviso
set cursor on
loop
endif

xpaci = paciente
set color to r/w
@ 8, 19 say xpaci 
xemi = ctod (' ')
@ 10, 19 get xemi
read

if xemi = ctod (' ')
@ 18, 14 to 20, 58 double
@ 19, 15 clear to 19, 57
set color to r/w
sn1 = ' '
@ 19, 15 say 'CAMPO DA DATA ESTA EM BRANCO. PROSSEGUIR?' get sn1 valid (sn1$"SNsn") 
tone (600, 2)
read
if sn1 = 'N' .or. sn1 = 'n'
loop
else 
set color to gr++/b+
@ 18, 14 clear to 20, 58
endif
endif

save screen to telasaida2
do while .t.
restore screen from telasaida2

select (3)
set key 28 to hmercad1
set color to r/w
xcod = space (5)
@ 12, 19 get xcod picture '99999'
read

if lastkey () = 27
close all
return
endif

if xcod <= '00000'
exit
endif

find (xcod)
prod = produto
xdesc = descricao
xcodtipo = tipo
xqatual = qatual

if eof ()
aviso = 'CODIGO não CADASTRADO'
do aviso
set delimiters off
set intensity on
set deleted on
set cursor on
set color to r/w
loop
endif

@ 14, 19 say prod 

select (2)

busca = cod + xcod + dtoc(Xemi)

find (busca)
dias = xemi - emissao

save screen to telasaida1
if dias <= 30
set cursor off
set color to r/w
@ 18, 15 clear to 19, 65
@ 17, 14 to 20, 66 double
set color to r*/w
@ 18, 15 say ' PACIENTE JA PEGOU O MEDICAMENTO NO DIA ' + dtoc (emissao) + ' ' 
tone (600, 2)
set color to r/w
set cursor on
xsn = ' '
@ 19, 15 say 'Prosseguir (S/N):' get xsn picture '@!' valid (xsn$"SNsn") 
set color to r/b+
read
set color to r/w
set cursor on
if xsn = 'N'
restore screen from telasaida2
loop
endif
restore screen from telasaida1
endif

set order to 1
do while .t.
qun = 0
@ 16, 19 get qun picture '99999'
@ 16, 48 say xqatual 
read

if lastkey () = 27
exit
endif

if qun <= 0
exit
endif

if qun > xqatual
aviso = 'Quantidade Superior ao Estoque '
do aviso
set cursor on
exit
endif
select (3)
xquan = qatual - qun

set color to gr++/b+
set delimiters on
sn = ' '
@ 22, 10 say space (69) 
@ 22, 11 say 'Confirma a Saida (S/N):' get sn picture '@!' valid (sn$"SNsn") 
read

if upper (sn) = 'S'
select (2)
append blank 
replace codcli with cod
replace codpro with xcod
replace quantidade with qun
replace emissao with xemi
replace codtipo with xcodtipo
replace produto with prod
replace paciente with xpaci
replace descricao with xdesc

select (4)
append blank 
replace codigo with xcod
replace saidas with qun
replace dataestoq with substr (dtoc (xemi), 4, 7)
replace produto with prod
replace estoqant with xqatual

select (3)
replace qatual with xquan
exit
else 
select (2)
delete
endif
enddo
enddo
enddo
close all
return
Se alguem puder me ajudar valeu!!!!
:-O

Resposta

Enviado: 09 Abr 2005 20:34
por marbio
Ola,

Eu tenho um sistema de farmacia publica para prefeitura

o meu sistema trabalha na seguinte forma, eu tenho um DBF que fica quardado o medicamento pego pelo paciente.

Ex: o paciente pegou o medicamento no dia 01/01/2005 e voutou para pegar o medicamento no dia 15/01/2005 o sistema avisa que ja retirou o medicamento e me avia que aquele medicamento da para 30dias, como funciona tenho uma tela de saida(venda) lanca todo o medicamento da receita e fecho na hora de fazer abaixa ele vai no banco de dados onde fica arquivado os medicamentos saido para os paciente. e verica se a dada e menor que esta la etc...

e basica mente isso ok...

t+

Enviado: 10 Abr 2005 10:24
por Rusimar Pessanha Pereira
marbio, blz!!! O código conte q postei está legal ou tem q mexer em algo?
Qualque coisa ai vai o meu E-Mail.
jpbertin@ig.com.br
andre-nilson@ig.com.br
jpbertin@hotmail.com

Enviado: 11 Abr 2005 22:20
por Rusimar Pessanha Pereira
marbio blz!!!
Me ajuda por favor, como faço para fazer uma tela para o usuario colocar seu nome e senha para entrar no programa? Ele poderá alterar sua senha em outro menu do programa?

Resposta

Enviado: 11 Abr 2005 23:40
por marbio
Boa Noite,,,

Vou te passar uma idea, que eu uso nos HOSPITAL

T+
:*
-:]
:xau

Summer 87

Enviado: 14 Abr 2005 11:51
por Rusimar Pessanha Pereira
Blz marbio!! Conseguiu alguma coisa!!!??

:(

Enviado: 14 Abr 2005 17:18
por Daniel
este e exemplo que eu uso

Código: Selecionar todos

* Prog.: gravasen.prg
* Acessorios para o DII 1.00
* Daniel Denobie
* 10/02/2004
****************************************
Function gravasen

Private xte[36], tw[7], tx[7], libera_senha[7,5]

xft1:= xft2:= xft3:= xft4:= xft5:= xft6:= xft7:= snv:= " "
Telacor("W+,W+/B+","W,N/W")
Select consen
Go Top
limpa1()
Telacor("N/W","W")
sp1:= sp
   While (.T.)
      Telacor("W+,W+/B+","W,N/W")
      xlin:= 8
      lin:= 18
      a:=  90
      c:= 100
      b:= 115
      xcol:= 10
      While .T.
         @ xlin, xcol  Say "Codigo: " + codop
         @ xlin, xcol + 15 Say "Nome: " + nome
         @ xlin, xcol + 32 Say "Senha: *  *  *  *  *  *"
         Skip
			If Eof()
				Exit
			EndIf		
         xlin++
         If xlin == 17
				InKey(5)
				@ 8, 1 Clear To 17, 78
				xlin:= 8
			EndIf		
      End
      @ lin - 1, xcol - 1 To lin + 3, xcol + 60
      codigo:= Space(3)
      xnome:= Space(10)
      @ 24, 0 Clear
      @ 24, 13 Say "Entre com o Codigo!  [Esc]-Retorna !"
      @ lin, xcol Say "Operador Nr:" Get codigo
      @ lin, xcol + 20 Say "Nome:" Get xnome Picture "@!"
      @ lin, xcol + 40 Say "Senha:"
		@ lin, xcol + 47 Say "           "
      Read
      If (LastKey() == 27)
         Return 
      EndIf
      Seek codigo
      If (!Eof())
         Set Console Off
         @ lin, xcol + 40 Say "Senha:"
			@ lin, xcol + 47 Say ""
         Wait To xtw1
         tone(100, 1)
         @ lin, xcol + 47 Say "*"
         Wait To xtw2
         tone(300, 1)
         @ lin, xcol + 49 Say "*"
         Wait To xtw3
         tone(500, 1)
         @ lin, xcol + 51 Say "*"
         Wait To xtw4
         tone(700, 1)
         @ lin, xcol + 53 Say "*"
         Wait To xtw5
         tone(900, 1)
         @ lin, xcol + 55 Say "*"
         Wait To xtw6
         tone(1000, 1)
         @ lin, xcol + 57 Say "*"
         Set Console On
         lin:= 10
         senha:= Chr(Val(xtw1) + a + a) + Chr(Val(xtw2) + c + c) + ;
            Chr(Val(xtw3) + b + b) + Chr(Val(xtw4) + a + a) + ;
            Chr(Val(xtw5) + b + b) + Chr(Val(xtw6) + c + c)
         beep()
         @ 24, 10 Clear
			If snv  == "N"
				nv_senha()
			Else
				nv_senha1()
				nv_senha()
			EndIf
         xtw7:= Chr(Gfrand_senha(10) + a)
         xtw8:= Chr(Gfrand_senha(10) + b)
         xtw9:= Chr(Gfrand_senha(10) + c)
         xtw10:= Chr(Gfrand_senha(10) + a + b)
         senha:= senha + xtw7 + xtw8 + xtw9 + xtw10
         While .T.
            If RegLock(5)
               Replace codsen With senha
               Replace nome With xnome
					Replace ft1 With xft1
					Replace ft2 With xft2
					Replace ft3 With xft3
					Replace ft4 With xft4
					Replace ft5 With xft5
					Replace ft6 With xft6
					Replace ft7 With xft7
               Commit
               UnLock
					Go Top
					snv:= " "
               Exit
            Else
               @ 24, 10 Clear
               @ 24, 13 Say "Aguarde Banco de Dados em Uso"
            EndIf
         End
      Else
         beep()
         @ 24, 10 Clear
         @ 24, 13 Say "Operador nao cadastrado"
         InKey(2)
         beep()
         @ 24, 13 Clear
         If (confirma("Cadastra este codigo de operador ?") == 1)
            While .T.
               If AdiReg(0)
                   Replace codop With codigo
                   Replace nome With xnome
						 Replace ft1 With xft1
						 Replace ft2 With xft2
						 Replace ft3 With xft3
						 Replace ft4 With xft4
						 Replace ft5 With xft5
						 Replace ft6 With xft6
						 Replace ft7 With xft7
                   Commit
                   UnLock
						 snv:= "N"
                   Exit
                Else
                   @ 24, 10 Clear
                   @ 24, 13 Say "Aguarde Banco de Dados em Uso"
               EndIf
            End
            beep()
            @ 24, 13 Say "Redigite o Codigo e o Nome, e Informe a Senha"
            InKey(4)
            @ 24, 13 Clear
				Go Top
            Loop
         EndIf
      EndIf
   End

************************************
Function nv_senha
*Private xte[36], tw[7], tx[7], libera_senha[7,5]

If snv == "N"
	For x:= 1 To 36
		xte[x]:= " "
	Next
EndIf
tela:= SaveScreen()
For g:= 1 To 7
	tx[g]:= " "
Next
an:= 99; bn:= 133; cn:= 117
Telacor("G+","W+")
While .t.
	@  5,  1 Clear To 22, 78
	@  7,  3 Say "Cliente.....:" Color "W+"
	@  6, 18 Say "Novo.....:" Get xte[1] Picture "@! A" Valid xte[1] $ "X "
	@  7, 18 Say "Altera...:" Get xte[2] Picture "@! A" Valid xte[2] $ "X "
	@  8, 18 Say "Exclui...:" Get xte[3] Picture "@! A" Valid xte[3] $ "X "
	@  9, 18 Say "Custo....:" Get xte[4] Picture "@! A" Valid xte[4] $ "X "
	@ 13,  3 Say "Fornecedor..:" Color "W+"
	@ 11, 18 Say "Novo.....:" Get xte[6] Picture "@! A" Valid xte[6] $ "X "
	@ 12, 18 Say "Altera...:" Get xte[7] Picture "@! A" Valid xte[7] $ "X "
	@ 13, 18 Say "Exclui...:" Get xte[8] Picture "@! A" Valid xte[8] $ "X "
	@ 14, 18 Say "Fiscal...:" Get xte[9] Picture "@! A" Valid xte[9] $ "X "
	@ 15, 18 Say "Debito...:" Get xte[10] Picture "@! A" Valid xte[10] $ "X "
	@ 19,  3 Say "Produto.....:" Color "W+"
	@ 17, 18 Say "Novo.....:" Get xte[11] Picture "@! A" Valid xte[11] $ "X "
	@ 18, 18 Say "Altera...:" Get xte[12] Picture "@! A" Valid xte[12] $ "X "
	@ 19, 18 Say "Exclui...:" Get xte[13] Picture "@! A" Valid xte[13] $ "X "
	@ 20, 18 Say "Entrada..:" Get xte[14] Picture "@! A" Valid xte[14] $ "X "
	@ 21, 18 Say "Saida....:" Get xte[15] Picture "@! A" Valid xte[15] $ "X "
	@  7, 35 Say "N.Fiscal....:" Color "W+"
	@  6, 50 Say "Emissao..:" Get xte[16] Picture "@! A" Valid xte[16] $ "X "
	@  7, 50 Say "Cancela..:" Get xte[17] Picture "@! A" Valid xte[17] $ "X "
	@  8, 50 Say "Exclui...:" Get xte[18] Picture "@! A" Valid xte[18] $ "X "
	@ 11, 35 Say "Duplicata...:" Color "W+"
	@ 10, 50 Say "Emissao..:" Get xte[21] Picture "@! A" Valid xte[21] $ "X "
	@ 11, 50 Say "Baixa....:" Get xte[22] Picture "@! A" Valid xte[22] $ "X "
	@ 12, 50 Say "Exclui...:" Get xte[23] Picture "@! A" Valid xte[23] $ "X "
	@ 14, 35 Say "Acessorios..:" Color "W+"
	@ 14, 50 Say "A.Preco..:" Get xte[26] Picture "@! A" Valid xte[26] $ "X "
	@ 15, 50 Say "Senha....:" Get xte[27] Picture "@! A" Valid xte[27] $ "X "
	@ 19, 35 Say "Pedido......:" Color "W+"
	@ 17, 50 Say "Novo.....:" Get xte[31] Picture "@! A" Valid xte[31] $ "X "
	@ 18, 50 Say "Altera...:" Get xte[32] Picture "@! A" Valid xte[32] $ "X "
	@ 19, 50 Say "Cancela..:" Get xte[33] Picture "@! A" Valid xte[33] $ "X "
	@ 20, 50 Say "Nota.....:" Get xte[34] Picture "@! A" Valid xte[34] $ "X "
	@ 21, 50 Say "Fatura...:" Get xte[35] Picture "@! A" Valid xte[35] $ "X "
	Read
	If LastKey() == 27
		Loop
	ElseIf LastKey() == 13
		Exit
	EndIf
End	
Telacor("W+,W+/B+","W,N/W")
y:= 1
For w:= 1 To 7
	tw1:= Chr(Gfrand_senha(10) + an)
	InKey(.02)
	tw2:= Chr(Gfrand_senha(40) + cn)
	InKey(.05)
	tw3:= Chr(Gfrand_senha(60) + cn)
	InKey(.03)
	tw4:= Chr(Gfrand_senha(30) + bn)
	InKey(.01)
	tw5:= Chr(Gfrand_senha(66) + an)
	d:= w + Val(codigo)
	For x:= 1 To 5
		If x == 1
			z:= 29
		ElseIf x == 2
			z:= 53
		ElseIf x == 3
			z:= 63
		ElseIf x == 4
			z:= 33
		Else
			z:= 43
		EndIf
		tw[x]:= Chr(Asc(xte[y]) + z + d)
		y++
	Next
	If w == 1
    	xft1:= tw1 + tw[5] + tw2 + tw[4] + tw3 + tw[3] + tw4 + tw[2] + tw5 + tw[1]
	ElseIf w == 2
		xft2:= tw1 + tw[5] + tw2 + tw[4] + tw3 + tw[3] + tw4 + tw[2] + tw5 + tw[1]
	ElseIf w == 3
		xft3:= tw1 + tw[5] + tw2 + tw[4] + tw3 + tw[3] + tw4 + tw[2] + tw5 + tw[1]
	ElseIf w == 4
		xft4:= tw1 + tw[5] + tw2 + tw[4] + tw3 + tw[3] + tw4 + tw[2] + tw5 + tw[1]
	ElseIf w == 5
		xft5:= tw1 + tw[5] + tw2 + tw[4] + tw3 + tw[3] + tw4 + tw[2] + tw5 + tw[1]
	ElseIf w == 6
		xft6:= tw1 + tw[5] + tw2 + tw[4] + tw3 + tw[3] + tw4 + tw[2] + tw5 + tw[1]
	ElseIf w == 7 
		xft7:= tw1 + tw[5] + tw2 + tw[4] + tw3 + tw[3] + tw4 + tw[2] + tw5 + tw[1]
	EndIf
Next
RestScreen(,,,,tela)
Return .t.

********************************
Function gfrand_senha(Arg1)
local Static1:= 0

Static1:= Seconds()
Static1:= (Static1 * 31415821.0) / 1000000.0
Return Int((Static1:= Static1 - Int(Static1)) * Arg1)

***************************
Function nv_senha1

For x:= 1 To 36
   xte[x]:= " "
Next
sx:= 1
For wx:= 1 To 7
   If wx == 1
      fs1= SubStr(ft1, 10, 1)
      fs2:= SubStr(ft1, 8, 1)
      fs3:= SubStr(ft1, 6, 1)
      fs4:= SubStr(ft1, 4, 1)
      fs5:= SubStr(ft1, 2, 1)
   ElseIf wx == 2
      fs1= SubStr(ft2, 10, 1)
      fs2:= SubStr(ft2, 8, 1)
      fs3:= SubStr(ft2, 6, 1)
      fs4:= SubStr(ft2, 4, 1)
      fs5:= SubStr(ft2, 2, 1)
   ElseIf wx == 3
      fs1= SubStr(ft3, 10, 1)
      fs2:= SubStr(ft3, 8, 1)
      fs3:= SubStr(ft3, 6, 1)
      fs4:= SubStr(ft3, 4, 1)
      fs5:= SubStr(ft3, 2, 1)
   ElseIf wx == 4
      fs1= SubStr(ft4, 10, 1)
      fs2:= SubStr(ft4, 8, 1)
      fs3:= SubStr(ft4, 6, 1)
      fs4:= SubStr(ft4, 4, 1)
      fs5:= SubStr(ft4, 2, 1)
   ElseIf wx == 5
      fs1= SubStr(ft5, 10, 1)
      fs2:= SubStr(ft5, 8, 1)
      fs3:= SubStr(ft5, 6, 1)
      fs4:= SubStr(ft5, 4, 1)
      fs5:= SubStr(ft5, 2, 1)
   ElseIf wx == 6
      fs1= SubStr(ft6, 10, 1)
      fs2:= SubStr(ft6, 8, 1)
      fs3:= SubStr(ft6, 6, 1)
      fs4:= SubStr(ft6, 4, 1)
      fs5:= SubStr(ft6, 2, 1)
   ElseIf wx == 7
      fs1= SubStr(ft7, 10, 1)
      fs2:= SubStr(ft7, 8, 1)
      fs3:= SubStr(ft7, 6, 1)
      fs4:= SubStr(ft7, 4, 1)
      fs5:= SubStr(ft7, 2, 1)
   EndIf
   d:= wx + val(codigo)
   For ex:= 1 To 5
      If ex == 1
         z:= 29
         xte[sx]:= Chr((Asc(fs1) - z) - d)
      ElseIf ex == 2
         z:= 53
         xte[sx]:= Chr((Asc(fs2) - z) - d)
      ElseIf ex == 3
         z:= 63
			xte[sx]:= Chr((Asc(fs3) - z) - d)
      ElseIf ex == 4
         z:= 33
         xte[sx]:= Chr((Asc(fs4) - z) - d)
      Else
         z:= 43
         xte[sx]:= Chr((Asc(fs5) - z) - d)
      EndIf
		sx++
   Next
Next
Return .t.
ela trabalhar com senhas nos menus de acesso para as funcoes

Uma ideia

Enviado: 14 Abr 2005 21:16
por marbio
Boa Noite...

Eu fiz um rotima +-, por folta de tempo, mais vc pode tirar alguma duvida nela, e logico que tem funcao melhor mais para vc quebra o galho e tirar outro idea, CERTO.


Código: Selecionar todos


* ARQUIVO DBF
* nome   c 10
* senha  c 10
* nivel  n 3
* cadusa c 1 

****** montagem de tela de abertura do seu sistema

if .not. file("usuario.dbf")
   clear
   ?"Falta arquivo do usuario, lique para 9958-5251"
   quit
endif
if .not. file("usuario.ntx")
 if netuse("usuario.dbf",.t.,10)
    pack
   index on nome to usuario
   else
*   msgab()
   return
 endif
endif

if netuse("usuario.dbf",.f.,10)
  * msgab()
  else
   return
endif

go top

**** Variavel para montagem de tela

xfirma=firma001
xcadusa=cadusa
user=space(10)
identifica=0
xsenhas=space(10)
box3dr1(00,24,01,78);box3dr2(02,04,04,75)
box3df1(07,13,18,60);box3dr1(19,23,57,76)
box3df2(17,19,03,28)
box3df2(21,23,03,28)

@08,25 say '    Farmacia Flora Quimica       '
@09,25 say '  ** M A N I P U L A C A O **    '
@11,25 say 'Baependi- MG    Cep. 37443-000   '
@12,25 say 'MATRIZ: Tel: 035-9958-5251       '
setcolor(cor4)
@20,59 say ' Sistema Vr 0.2.7'
@21,59 say " MMP Software s " 
@22,59 say '   9958-5251    ' 

empresa=xfirma

************ fim

if netuse("usuario.dbf",.f.,10)
   set index to usuario
else
   return
endif

do while .t.
user=space(10)
setcolor(cor3)
@03,15 say empresa
@18,06 say 'Usuario.: ' get user pict '@!'
@22,06 say 'PassWord: '
read

if empty(user) .or. lastkey()=27
   set color to
*   tela1()
   quit
endif

seek user

if .not. found()
*  som()
*  msgab()
   alert("Atencao!!!;Usuario nao cadastrado!!!")
   if xcadusa<>'1' ********** aqui vai verificar se ja teve o primeiro
                           *********  cadastro de usuario
   do Cadausa
   endif
  loop
endif

xcad=cadastro
xsenha=senha
xdata=dtos(data)
aniv=substr(xdata,5,8)

identifica=xcad

do while .t.
setcolor(cor3)

@22,06 say 'PassWord: '
wdig=senha(22,16)           ********* funcao de senha que peguei 
                                       *********no  PCTOLEDO
@22,06 say 'PassWord:            '

if lastkey()=27
   clear
   quit
endif

if wdig<>xsenha
*   som()
   alert("Atencao!!!;Senha invalida!!!")
   loop
endif
exit
enddo
identifica=xcad
if xhoje1=aniv
   clear
   letragrande(08,07,"PARABENS",219)
   aniv1() *** funcao de parabens para vc PCTOLEDO
endif


* do programa fonte
enddo


****************************************
function cadausa

save screen

*** montar caixa

if netuse("usuario.dbf",.t.,10)
   set index to usuario
   else
   return
endif

xusa=space(10)
xsen=space(10)

@01,01 say ' Usuario ...: ' get xusa pict '@!'
@02,01 say ' Senha......: ' get xsen pic  '9999'
read

append blank
replace nome   with xusa
replace senha  with xsen
replace nivel  with 200
replace cadusa with '1'  **** quando esse numero for gravado o 
                                   **** programa nao vai pedir a primeira senha
                                   ****  mais.

restore screen


Depois que vc cadastrar a primeira senha vc vai no menu alterar senha e pronto. para o sistema ficar mais protegido, o usuario mestre que deve cadastra a sua preira senha e manipular as outro dos usuarios.
No menu de Cadastro /Alteracao/Exclusao etc.



Funcao de senha
https://pctoledo.org/download/cop ... t&deonde=2


funcao de legra grande
https://pctoledo.org/download/cop ... t&deonde=2

Funcao de parabens
https://pctoledo.org/download/cop ... t&deonde=2

Summer 87

Enviado: 15 Abr 2005 11:45
por Rusimar Pessanha Pereira
Blz Marbio!!! Baixeia os arquivos só q estão todos em clipper 5xx!!! Não tem em Summer87? No q vc fez não entendi:
netuse("usuario.mem",.t.,10)
Tem como, se puder, fazer um mais simples, onde não apareça a senha digitada? Se vc fizer desse ponto em diante eu desenvolvo melhor

Mudancas

Enviado: 15 Abr 2005 12:42
por marbio
Ola, o netuse e uma funcao que criei para funcionar em rede, o usuairo.mem e apeas um dbf. e so renoemar para dbf, as outras funcoes e so vc color * na frente que nao da problema nas funcao

box, letragrande, aniv1


funcao para trabalhar em rede, vc pode ver que use comando do summer 87, eu tenho a colecao deste livro enteiro do autor ANTONIO GERALDO DA ROCHA VIDAL. esses comando tem no livro CLIPPER versao summer 87 vol.1

Código: Selecionar todos


* -------------------- NETUSE()
function NETUSE(arquivo,modo,segundos)
	 local psempre
	 psempre = (segundos = 0)
do while (psempre .or. segundos >0)
       if modo
	  use (arquivo) exclusive
       else
	  use (arquivo) shared
       endif
       if .not. neterr()
	  return(.t.)
       endif
	 segundos = segundos - 1
enddo
return(.f.)


Há respeito da senha e so vc excluir as linha. se nao der certo eu refaco ok.

t+
:* -:] :xau

Summer 87

Enviado: 15 Abr 2005 19:15
por Rusimar Pessanha Pereira
Blz!! Eu consegui fazer do meu jeitinho, valeu pela ajuda, só q ta dando um erro!!! Vcs podem me ajudar? Nao dispensarei a ajuda de voces.
É o seguinte:
Quando vou alterar a senha de um usuario, na hora de gravar, ele esta dando o seguinte erro: lock required. O q será??

Lock

Enviado: 15 Abr 2005 20:33
por marbio
Boa Noite!!!!!

Esse erro e porque vc usa o programa em rede vc deve compartilhar o arquivo eu postei uma funcao NETUSE e para vc usar em modo compartilhado em rede.

EX:

Código: Selecionar todos

.t. => modo exclusivo
.f. => modo compartilhado

select 1                                  
if netuse("produto.dbf",.f.,10)
   set index pro001
   else
   alert("Arquivo em uso")
endif
se vc timer o livro summer87 vc vai ver que na paginas 141 tem explicacao

Qualquer duvida e so mandar

ou poste o pedaco o seu sistema a onde que esta dando o erro

t+

:* -:] :xau

Re: Summer 87

Enviado: 15 Abr 2005 22:09
por janio
Rusimar Pessanha Pereira escreveu: Quando vou alterar a senha de um usuario, na hora de gravar, ele esta dando o seguinte erro: lock required. O q será??
Olá,

Este erro está acontecendo pq vc tá tentando gravar em um arquivo sem travá-lo primeiro.

Faça assim que funciona, veja:

Código: Selecionar todos

SELECT CIDADE
[color=red]RLOCK()[/color]  [color=darkblue]//  trava o arquivo para gravação[/color]
replace CIDADE with vCIDADE
replace ESTADO with vESTADO
replace POPULA with vPOPULA
[color=red]UNLOCK[/color] [color=darkblue]// destrava[/color]
Um abraço,

Janio


PS: Somente é necessário a utilização da função RLOCK(), no caso de alteração de algum dado já gravado no DBF. Para inclusão de um novo registro, a função DBAPPEND() já trava o arquivo automaticamente.

Sumer 87

Enviado: 15 Abr 2005 22:46
por Rusimar Pessanha Pereira
Boa Noite Marbio, blz!!!
De uma olhada nessa fonte, ta meio bagunçada, não repare:
Close all
procedure Senha
select (1)
use Usuario index UsaNome, UsaSenha

set color to gr++/b+
do alinha with 'CADASTRO OU ALTERACAO DE SENHA ', 2
set color to gr++/b+
@ 4, 1 clear to 20, 78
@ 22, 10 say space (69)
set color to gr++/b+
@ 06, 3 say 'Usuario ...: '
save screen to telaSenha
do while .t.

do msg with 'Para Sair Tecle <ESC> ou Digite o Usuario'

restore screen from telaSenha
set delimiters off
Set Cursor on


XUsuario = space (10)
select (1)
set color to r/w
@ 6, 16 get XUsuario Pict "@!"
read

if lastkey () = 27
close all
return
endif

if XUsuario = space (10)
close all
return
endif

find (XUsuario)

if .not. eof ()
set color to gr+/b+
@ 07, 3 Say 'Senha Atual: '
set color to r/b
@ 22,11 say ' '
set color to gr++/b
@ 07, 15 say '[@@@@@@@@@@]'
set color to n/n
set delimiters off
set confirm off
store ' ' to v01, v02, v03, v04, v05, v06, v07, v08, v09, v010

@ 07, 16 get v01 picture '@!'
read
set color to w+
@ 07, 16 say '@'
set color to n/n
@ 07, 17 get v02 picture '@!'
read
set color to w+
@ 07, 17 say '@'
set color to n/n
@ 07, 18 get v03 picture '@!'
read
set color to w+
@ 07, 18 say '@'
set color to n/n
@ 07, 19 get v04 picture '@!'
read

set color to w+
@ 07, 19 say '@'
set color to n/n
@ 07, 20 get v05 picture '@!'
read

set color to w+
@ 07, 20 say '@'
set color to n/n
@ 07, 21 get v06 picture '@!'
read

set color to w+
@ 07, 21 say '@'
set color to n/n
@ 07, 22 get v07 picture '@!'
read

set color to w+
@ 07, 22 say '@'
set color to n/n
@ 07, 23 get v08 picture '@!'
read

set color to w+
@ 07, 23 say '@'
set color to n/n
@ 07, 24 get v09 picture '@!'
read
set color to w+
@ 07, 24 say '@'
set color to n/n
@ 07, 25 get v010 picture '@!'
read

set color to w+
se = chr(Val(v01)) + chr(val(v02)) + chr(val(v03)) + Chr(val(v04)) + chr(Val(v05)) + chr(val(v06)) + Chr(val(v07)) + Chr(val(v08)) + Chr(val(v09)) + Chr(val(v010))

Seek XUsuario


if Nome = XUsuario .and. senha = se
set color to r/b
@ 22,11 say ' '
set color to gr++/b
@ 08, 3 Say 'Senha Nova : '
@ 08, 15 say '[@@@@@@@@@@]'
set color to n/n
set delimiters off
set confirm off
store ' ' to v011, v012, v013, v014, v015, v016, v017, v018, v019, v020

@ 08, 16 get v011 picture '@!'
read
set color to w+
@ 08, 16 say '@'
set color to n/n
@ 08, 17 get v012 picture '@!'
read
set color to w+
@ 08, 17 say '@'
set color to n/n
@ 08, 18 get v013 picture '@!'
read
set color to w+
@ 08, 18 say '@'
set color to n/n
@ 08, 19 get v014 picture '@!'
read

set color to w+
@ 08, 19 say '@'
set color to n/n
@ 08, 20 get v015 picture '@!'
read

set color to w+
@ 08, 20 say '@'
set color to n/n
@ 08, 21 get v016 picture '@!'
read

set color to w+
@ 08, 21 say '@'
set color to n/n
@ 08, 22 get v017 picture '@!'
read

set color to w+
@ 08, 22 say '@'
set color to n/n
@ 08, 23 get v018 picture '@!'
read

set color to w+
@ 08, 23 say '@'
set color to n/n
@ 08, 24 get v019 picture '@!'
read
set color to w+
@ 08, 24 say '@'
set color to n/n
@ 08, 25 get v020 picture '@!'
read

se = chr(Val(v011)) + chr(val(v012)) + chr(val(v013)) + Chr(val(v014)) + chr(Val(v015)) + chr(val(v016)) + Chr(val(v017)) + Chr(val(v018)) + Chr(val(v019)) + Chr(val(v020))

set color to gr++/b+
@ 22, 11 say space (69)
Set Inte On
Sn = " "
@ 22, 11 say 'Confirma os Alteracao (S/N):' get sn picture '@!'
read

if sn = 'S'
Replace Senha With Se
set color to r/w
Loop
restore screen from telaSenha
Endif
Else
Set Color to r++*/b
@ 22,11 Say 'Senha Nao Confere. '
tone (300, 8)
tone (400, 10)
set color to r/w
Loop
restore screen from telaSenha
Endif
Endif
set color to r/b
Set Inte Off
@ 22,11 say ' '
@ 07, 3 Say 'Senha : '
set color to gr++/b
@ 07, 11 say '[@@@@@@@@@@]'
set color to n/n+
set delimiters off
set confirm off
store ' ' to v01, v02, v03, v04, v05, v06, v07, v08, v09, v010
set color to w+
@ 07, 12 say '@'
set color to n/n
@ 07, 12 get v01 picture '@!'
read
set color to w+
@ 07, 12 say '@'
set color to n/n
@ 07, 13 get v02 picture '@!'
read
set color to w+
@ 07, 13 say '@'
set color to n/n
@ 07, 14 get v03 picture '@!'
read
set color to w+
@ 07, 14 say '@'
set color to n/n
@ 07, 15 get v04 picture '@!'
read

set color to w+
@ 07, 15 say '@'
set color to n/n
@ 07, 16 get v05 picture '@!'
read

set color to w+
@ 07, 16 say '@'
set color to n/n
@ 07, 17 get v06 picture '@!'
read

set color to w+
@ 07, 17 say '@'
set color to n/n
@ 07, 18 get v07 picture '@!'
read

set color to w+
@ 07, 19 say '@'
set color to n/n
@ 07, 20 get v08 picture '@!'
read

set color to w+
@ 07, 21 say '@'
set color to n/n
@ 07, 22 get v09 picture '@!'
read
set color to w+
@ 07, 22 say '@'
set color to n/n
@ 07, 23 get v010 picture '@!'
read

se = chr(Val(v01)) + chr(val(v02)) + chr(val(v03)) + Chr(val(v04)) + chr(Val(v05)) + chr(val(v06)) + Chr(val(v07)) + Chr(val(v08)) + Chr(val(v09)) + Chr(val(v010))

set color to gr++/b+
Set Inte On
@ 22, 11 say space (69)
Sn= " "
@ 22, 11 say 'Confirma os Alteracao (S/N):' get sn picture '@!'
read

if sn = 'S'
Append Blank
Replace Nome With XUsuario
Replace Senha With Se
set color to r/w
Endif
Enddo
close all
return
Será q funciona? O banco de dados é Nome c 10, Senha c 10.

Enviado: 16 Abr 2005 09:21
por marbio
Bom dia!!!

Essa Rotina vc tera melhor entendimento, as linha em vermelho e para nao dar aquele erro certo.

Código: Selecionar todos

clear
close all
set bell on
set talk off

do while .t.
telainc("Alteracao da Farmacaia")

select 1
if netuse("abfprot",.f.,10)
    set index to farmacia, farnome
    else
    alert("Atencao!!!;Arquivo Bloqueado por outro Usuario...")
   return
endif


set color to &cor21
select 1

xnumero=space(6)
@05,02 say 'Codigo.......:' get xnumero pict '@!'
read

if lastkey()=27
   return
endif

seek xnumero

if .not. found()
   msgnc()
   pese()
endif

[color=red]if rlock()      ****** Para nao dar esse erro [/color]
xnumero    = codigo
xproduto   = produto
xvenda     = venda
xminimo    = minima
xmarca     = marca
xtipo      = tipo
xembalagem = embalagem

@05,02 say 'Codigo.......:' get xnumero pict '@!'
@07,02 say 'PRODUTO......:' get xproduto pict '@!'
@08,02 say 'Venda R$.....:' get xvenda pict '@E 9,999,999.99' valid xvenda <> 0
@09,02 say 'Estq. Minimo.:' get xminimo pict '99999' valid xminimo <> 0
@10,02 say 'Marca........:' get xmarca pict '@!' valid tmarca(xmarca)
@11,02 say 'Tipo...C/L...:' get xtipo pict '@!' valid xtipo $ "CL"
@12,02 say 'Embalagem....:' get xembalagem pict '999' valid xembalagem <> 0
read

sn=' '
@23,20 say 'Confirma a Alteracao (<S>im/<N>ao)?' get sn pict '!' valid sn $ "SN"
read

if sn='N'
  [color=red] unlock[/color]
   loop
endif

if sn='S'
replace codigo  with xnumero
replace produto with xproduto
replace venda   with xvenda
replace minima  with xminimo
replace marca   with xmarca
replace tipo    with xtipo
replace embalagem with xembalagem
   [color=red]commit
   unlock
   loop[/color]endif
else
msgrg()
[color=red]unlock[/color]
endif
enddo
Qual quer duvida e so postar.

t+

:*