... Assinatura do site por 3 anos + Kit MontaRibbons + 3 Livros em PDF + Diversas Revistas (pdf) de brinde, por apenas R$145,00
(
podendo parcelar em até 10 vezes no cartão de crédito)...

Clique aqui e obtenha mais detalhes do nosso kit completo e de como comprar.


Sistema Shareware por limitação de Registros

Ofereço neste link um tutorial sobre sistema Shareware com liberação Online, mas o grau de complexidade, o torna inviável para maioria dos usuários menos experientes em programação VBA.  Resolvi, então, criar esta versão de Shareware, que é infinitamente mais simples.  A ideia é a de  limitar a quantidade de registros permitidos para cada formulário de cadastro envolvido. 

Baixe o arquivo:

Clique aqui e baixe o arquivo exemplo.

Abra o formulário frmClientes, tente registrar um novo cliente e constate que o limite permitido neste exemplo é de até 3 registros. 

Usando Access - Limitar Registro

Limitar a entrada de registro em um formulário é bem simples, basta alterar a propriedade Permitir adições (AllowAdditions) para Não (false).

Vamos analisar o código aplicado no evento No atual (Current) do formulário

Private Sub Form_Current()
Me.AllowAdditions = Not Me.RecordsetClone.RecordCount >= fncLimiteRegistros
End Sub

Me.RecordsetClone.RecordCount retorna a quantidade total de registros do formulário, que no nosso exemplo está em 3.  A função fncLimiteRegistros(), que veremos mais adiante, está retornando o valor de 3.  Então temos o seguinte comparativo no código:

Private Sub Form_Current()
Me.AllowAdditions = Not 3 >= 3
End Sub

A expressão 3 >=3 retorna o valor True (verdadeiro).   Então teremos:

Me.AllowAdditions = Not True

Not True (não verdadeiro) retorna o valor False.  A propriedade do formulário AllowAddtions (Permitir adições) setado para False, impede a entrada de novos registros.

Agora, se tivéssemos apenas com dois registros cadastrados, teríamos a expressão 2 >= 3, o que retornaria False.

Me.AllowAdditions = Not False

Not False (não falso) retorna o valor True (verdadeiro). A propriedade do formulário AllowAddtions setado para True permitiria a entrada de um novo registro.

Acompanhe a seguinte seqüência:

- Ao abrir o aplicativo, a macro AutoExec dispara a função fncGerarChave()

- A função fncGerarChave() gera uma chave de 8 dígitos e a grava na tabela tblRegistro.  A função também grava na tabela o nome do Usuário e o nome do Computador.  Caso haja uma troca de Usuário ou de Computador, a função precisa gerar uma nova chave e para isso exige um novo registro de liberação.  Esse é o mecanismo bem simples para impedir a clonagem do projeto.

- É preciso informar o número de registro na tabela tblRegistro para que o aplicativo rode sem restrição.  De posse do número chave, você pode gerar o número de registro com o aplicativo GerarRegistro.accdb.  Ao gerar o número, digite-o  no campo Registro da tabela tblRegistro.  Abra o formulário frmClientes e observe que está liberado para inserção de novos registros.

Veja, a função que gera a chave de 8 dígitos e que é disparada pela macro AutoExec:

Public Function fncGerarChave()
Dim blnUsuario As Boolean
Dim blnMaquina As Boolean
Dim varChave As Variant
'----------------------------------------------------------
'verifica se houve troca de Usuário ou de Computador
'----------------------------------------------------------
blnUsuario = Nz(DLookup("Usuario", "tblRegistro")) = Environ("UserName")
blnMaquina = Nz(DLookup("Maquina", "tblRegistro")) = Environ("ComputerName")

Randomize
'-----------------------------------------
'gera nova chave de comprimento 8
'------------------------------------------
varChave = Int(Rnd * 99999999)
If Len(varChave) < 8 Then varChave = varChave & String(8 - Len(varChave), "0")
'------------------------------------------------------------------------------------
'grava chave, nome do Usuário e nome do Computador na tabela tblRegistro
'------------------------------------------------------------------------------------
If DCount("*", "tblRegistro") = 0 Then
    'insere novo registro
    CurrentDb.Execute "INSERT INTO tblRegistro (chave,usuario,maquina) VALUES ('" & varChave & "','" _
    & Environ("UserName") & "','" & Environ("ComputerName") & "');"
ElseIf IsNull(DLookup("chave", "tblRegistro")) Or blnUsuario = False Or blnMaquina = False Then
    'atualiza o registro existente
    CurrentDb.Execute "UPDATE tblRegistro SET chave = '" & varChave & "',usuario ='" _
    & Environ("UserName") & "',maquina ='" & Environ("ComputerName") & "';"
End If
End Function

E a função que verifica o número de registro se está correto para liberar a limitação é a seguinte:

Public Function fncLimiteRegistros() As Long
If fncRegistro(2, 4, 15674, DLookup("chave", "tblRegistro")) = Nz(DLookup("registro", "tblRegistro"), 0) Then
    fncLimiteRegistros = 20000000
Else
    'aqui você determina o limite máximo de cadastro, enquanto não houver registro válido.
    fncLimiteRegistros = 3
End If
End Function

Desafio

Para melhorar o nível de segurança, as informações gravadas na tabela tblRegistro devem ser criptografadas.  Busque aqui no site sobre a criptografia e tente implementá-la neste projeto.


Bom estudo!


 

 


2 comentário(s)

Eduardo   12/02/2017 07:16:07

Não funciona no access 2016.
O que deve ser inserido no campo gerar número ?

Avelino Sampaio   12/02/2017 12:15:57

Eduardo,

funcione no 2016 sim. Os passo para liberação do aplicativo

- abra a tabela tblRegistro
- anote o número do campo CHAVE
- abra a aplicativo GerarRegistro.accdb
- informe no campo o número da chave, que está na tabela tblRegistro. Clique no botão Gerar Registro
- Anote o número de registro
- volte a tabela tblRegistro e no campo REGISTRO escreva o número de registro anotado.

Bom estudo!


Envie seu comentário: