AJUDA PARA EXPIRAR PROGRAMA

LEANDRO.BUENO 01/06/2005 07:43:52
#86302
Caros Amigos,
Fiz este código para deixar o programa funcionando por um ano, mas.....
Se o usuário alterar a data do windows, ele poderá usar o programa denovo.
Tem como eu fazer com que isto não posso ocorrer?
Segue o código abaixo para analizarem...
Dim resultado As String
Dim vDataInicial As String
Dim vDataFinal As String
Dim vPeríodo As String
'estou definindo por padrão que a cada ano irá pedir novamente um código
vPeríodo = "365"
vDataInicial = GetSetting("HKEY_LOCAL_MACHINE", "Vb_Sistema", "Data Doc")
vDataFinal = Format(Date, "dd/mm/yyyy")
If vDataInicial = "" Then
vDataInicial = Format(Date, "dd/mm/yyyy")
SaveSetting "HKEY_LOCAL_MACHINE", "Vb_Sistema", "Data Doc", vDataInicial
Exit Sub
End If
If vDataFinal = "" Then
resultado = "0"
Else
resultado = DateDiff("d", Format(vDataInicial, "dd/mm/yyyy"), Format(vDataFinal, "dd/mm/yyyy"))
End If
If vPeríodo <= resultado Then
MsgBox "O Prazo de Licença expirou, entre em contato com o Administrador para nova instalação"""
' aqui vc pede o novo código, utilizando aquele código que te enviei
' na verdade teria que mostrar uma mensagem solicitando que seja
' entrado em contato com vc, para solicitar o novo código. ai vc passa
' o código que é gerado a partir do mês e ano atual
SaveSetting "HKEY_LOCAL_MACHINE", "Vb_Sistema", "Data Doc", vDataInicial
End If

Grato pela atenção de vocês.
Obrigado
JEAN.JEDSON 01/06/2005 07:51:15
#86305
Resposta escolhida
quando vc entrar no programa a primeira vez, ele irá gravar a data atual no registro do windows. passando 365 dias, ele irá solicitar uma nova chave para liberar o programa.

quando vc mostrar a mensagem que precisa de nova chave, vc grava um novo dado no registro do windows:

SaveSetting "HKEY_LOCAL_MACHINE", "Vb_Sistema", "Travar", "Sim"

se for digitado o código, vc grava "Não" nesta mesma chave. se não digitar ou digitar errado, não deixe entrar no sistema. se o cara tentar entrar novamente, simplesmente verifique se "Travar" tem o valor "Sim". se tiver, peça novamente o código...

por sinal: vc não fez a rotina de travamento nem de aceitação de código... certo?
LEANDRO.BUENO 01/06/2005 08:01:34
#86306
Sim,
Amigo Jean eu entendi, só que tentei fazer ontem a noite e quebrei a cabeça só dava erro ai apaguei tudo e tentei de novo mas não dava certo.
Se não for te incomodar você pode montar a rotina pra mim e ficarei grato.
JEAN.JEDSON 01/06/2005 08:19:32
#86307
bem...
aí vai:

Private Sub Form_Load()
Dim resultado As String
Dim vDataInicial As String
Dim vDataFinal As String
Dim vPeríodo As String
Dim vChave As String
Dim vTravar As String
vPeríodo = "365"
vTravar = GetSetting("NomeDoSistema", "Registro", "Travar")
vDataInicial = GetSetting("NomeDoSistema", "Registro", "Data")
vDataFinal = Format(Date, "dd/mm/yyyy")
If vTravar = "" Or vTravar = "Não" Then
If vDataInicial = "" Then
SaveSetting "NomeDoSistema", "Registro", "Travar", "Não"
SaveSetting "NomeDoSistema", "Registro", "Data", vDataFinal
Exit Sub
End If
End If
If vDataFinal = "" Then
resultado = "0"
Else
resultado = DateDiff("d", Format(vDataInicial, "dd/mm/yyyy"), Format(vDataFinal, "dd/mm/yyyy"))
End If
If vPeríodo <= resultado Or vTravar = "Sim" Then
If vTravar = "" Or vTravar = "Não" Then
SaveSetting "NomeDoSistema", "Registro", "Travar", "Sim"
MsgBox "O Prazo de Licença expirou." & vbCrLf & _
"Entre em contato com o Administrador para nova Instalação" & vbCrLf & _
"Forneça os dados a seguir: " & Month(vDataInicial) & " / " & Year(vDataInicial), _
vbCritical, "Atenção!!!"
End If
vChave = InputBox("Digite o Código de Registro: ", "Registro", "")
If vChave = CalculaChave(Month(vDataInicial) & Year(vDataInicial)) Then
SaveSetting "NomeDoSistema", "Registro", "Travar", "Não"
SaveSetting "NomeDoSistema", "Registro", "Data", vDataFinal
MsgBox "Chave Validada com Sucesso. Obrigado por usar nosso Sistema.", vbCritical, "Atenção!!!"
Else
MsgBox "Chave Incorreta. O sistema somente será liberado quando for inserida a Chave correta.", vbCritical, "Atenção!!!"
End
End If
End If
End Sub

Private Function CalculaChave(Parametro As String) As Boolean
'insira aqui os cálculos necessários para geração da chave
'esta mesma rotina você terá em seu sistema para poder passar
'a chave para o usuário, quando a mesma for solicitada
CalculaChave = True
End Function
JEAN.JEDSON 01/06/2005 08:39:33
#86316
aí está o código completo, já com a função de geração de chave implementada
para fazê-la funcionar, basta vc rodar o programa com a data atual. saia do programa, e avance 1 ano no seu calendário... tente entrar, irá pedir senha. saia do sistema, volte a data. você verá que continua pedindo a chave. a chave é, considerando o mês 6 de 2005 (você muda a data para 6 de 2006, após já ter entrado com a data atual), é 11007

Private Sub Form_Load()
Dim resultado As String
Dim vDataInicial As String
Dim vDataFinal As String
Dim vPeríodo As String
Dim vChave As String
Dim vTravar As String
vPeríodo = "365"
vTravar = GetSetting("NomeDoSistema", "Registro", "Travar")
vDataInicial = GetSetting("NomeDoSistema", "Registro", "Data")
vDataFinal = Format(Date, "dd/mm/yyyy")
If vTravar = "" Or vTravar = "Não" Then
If vDataInicial = "" Then
SaveSetting "NomeDoSistema", "Registro", "Travar", "Não"
SaveSetting "NomeDoSistema", "Registro", "Data", vDataFinal
Exit Sub
End If
End If
If vDataFinal = "" Then
resultado = "0"
Else
resultado = DateDiff("d", Format(vDataInicial, "dd/mm/yyyy"), Format(vDataFinal, "dd/mm/yyyy"))
End If
If vPeríodo <= resultado Or vTravar = "Sim" Then
If vTravar = "" Or vTravar = "Não" Then
SaveSetting "NomeDoSistema", "Registro", "Travar", "Sim"
MsgBox "O Prazo de Licença expirou." & vbCrLf & _
"Entre em contato com o Administrador para nova Instalação" & vbCrLf & _
"Forneça os dados a seguir: " & Month(vDataInicial) & " / " & Year(vDataInicial), _
vbCritical, "Atenção!!!"
End If
vChave = InputBox("Digite o Código de Registro: ", "Registro", "")
If vChave = CalculaChave(Month(vDataInicial) & Year(vDataInicial)) Then
SaveSetting "NomeDoSistema", "Registro", "Travar", "Não"
SaveSetting "NomeDoSistema", "Registro", "Data", vDataFinal
MsgBox "Chave Validada com Sucesso. Obrigado por usar nosso Sistema.", vbCritical, "Atenção!!!"
Else
MsgBox "Chave Incorreta. O sistema somente será liberado quando for inserida a Chave correta.", vbCritical, "Atenção!!!"
End
End If
End If
End Sub

Private Function CalculaChave(Parametro As String) As String
Dim iCount As Integer
Dim sTemp As String
For iCount = 1 To Len(Parametro)
sTemp = sTemp & Chr(Asc(Mid$(Parametro, iCount, 1) * Int(iCount * 3.14)))
Next iCount
CalculaChave = sTemp
End Function


LEANDRO.BUENO 01/06/2005 08:50:29
#86320
blz amigo jean deu certo,

só uma pergunta como você gerou o código 11007?
ele será mudado anulamente?
como saberei o código que usarei?
JEAN.JEDSON 01/06/2005 08:54:30
#86321
bem...
este código é gerado pela função CalculaChave

se você notar, na mensagem que pede para entrar em contato, ele pede para informar um dado.

quando o usuário te passar este dado, vc tem a mesma função aí com vc, e vc passa por parà¢metro para ela exatamente o mesmo dado (mes e ano, juntos, sem separador).
a diferença é que, na função que fica com vc, você simplesmente mostra o resultado na tela, e informa ao usuário.

entende?
LEANDRO.BUENO 01/06/2005 08:58:36
#86323
blz amigo jean deu certo,

só uma pergunta como você gerou o código 11007?
ele será mudado anulamente?
como saberei o código que usarei?
LEANDRO.BUENO 01/06/2005 09:06:33
#86324
no caso eu teria que ter este parametro separado pra mim?
ai por exemplo se chegar no mês 6 de 2006, ele irá pedir isso:
Forneça os dados a seguir: 6 / 2005.

Então eu abro o parametro?
JEAN.JEDSON 01/06/2005 09:41:24
#86329
ai vc tem um exe na sua máquina, que nada mais é que o código (lembre-se que vc passa apenas os valores numéricos que ele te passou - 52005, 52006, 52007 - considerando que o sistema foi instalado em maio de 2005 - e considerando que o usuário quer os registros em 2006, 2007 ou 2008):

Private Sub Form_Load()
dim vChave as String
vChave = InputBox("Digite o Código de passado pelo Usuário: ", "Registro", "")
MsgBox "Passar esta Chave ao Usuário: " & CalculaChave(vChave), VbExclamation, "Chave Gerada"
End Sub

Private Function CalculaChave(Parametro As String) As String
Dim iCount As Integer
Dim sTemp As String
For iCount = 1 To Len(Parametro)
sTemp = sTemp & Chr(Asc(Mid$(Parametro, iCount, 1) * Int(iCount * 3.14)))
Next iCount
CalculaChave = sTemp
End Function
LEANDRO.BUENO 01/06/2005 09:45:49
#86330
blz entendi obrigado mais uma vez jean
Tópico encerrado , respostas não são mais permitidas