EXPIRAR EM ACCESS

USUARIO.EXCLUIDOS 08/07/2005 00:21:54
#92826
ALOU GALERA.
MIM AJUDEM POR FAVOR, E SE POSSIVEL.
GOSTARIA DE SABER O CODIGO FONTE QUE FIZESSE ISSO:
NO ULTIMO DIA DO ANO 31/12/05, O MEU SISTEMA DESSE UMA MENSSAGEM DIZENDO QUE NÃO é MAIS POSSIVEL ABRIR O PROGRAMA! SERIA POSSIVEL? APARTIR DE HOJE, ELE TERIA QUE TRABALHAR ATé O FIM DO ANO, DEPOIS DO ULTIMO DIA DO ANO, O SISTEMA PARA.
é UM SISTEMA EM ACCESS, EU COLOCARIA O CODIGO NO FORM PRINCIPAL? COMO SERIA?
AGUARDO ANCIOSO. GRATO A TODOS.
JEAN.JEDSON 08/07/2005 07:51:53
#92839
bem... ai vai um código que não faz exatamente no dia 31 de dezembro de cada ano, mas sim a cada "x" dias, que vc define no código do programa... podendo liberar por mais "x" dias, ou liberar para uso total.

Private Function CalculaChave(Parametro As String) As String
Dim iCount As Integer
Dim iCountAux As Integer
Dim sTemp As String
Dim iAsc As Integer
If (Len(Parametro) Mod 2) <> 0 Then
Parametro = Parametro & " "
End If
Parametro = UCase(Parametro)
For iCountAux = 1 To (Len(Parametro) / 2)
sTemp = sTemp & Mid$(Parametro, iCountAux, 1)
sTemp = sTemp & Mid$(Parametro, Len(Parametro) - iCountAux + 1, 1)
Next iCountAux
Parametro = sTemp
sTemp = ""
For iCount = 1 To Len(Parametro)
iAsc = Asc(Mid$(Parametro, iCount, 1)) * iCount
For iCountAux = 1 To 56
iAsc = iAsc - iCountAux
If iAsc < 57 Then
iCountAux = 56
End If
Next iCountAux
sTemp = sTemp & Chr(iAsc + 33)
Next iCount
CalculaChave = sTemp
End Function

Private Sub Command1_Click()
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 = "30"
vTravar = GetSetting("CIA2005", "Registro", "Travar")
vDataInicial = GetSetting("CIA2005", "Registro", "Data")
vDataFinal = Format(Date, "dd/mm/yyyy")
If vTravar = "Versão Full" Then
Exit Sub
ElseIf vTravar = "" Or vTravar = "Não" Then
If vDataInicial = "" Then
SaveSetting "CIA2005", "Registro", "Travar", "Não"
SaveSetting "CIA2005", "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 "CIA2005", "Registro", "Travar", "Sim"
MsgBox "O Prazo de Licença expirou." & vbCrLf & _
"Entre em contato com o Administrador para nova Instalação.", _
vbCritical, "Atenção!!!"
End If
vChave = InputBox("Digite o Código de Registro: ", "Registro", "")
If vChave = CalculaChave("SomenteDemo") Then
SaveSetting "CIA2005", "Registro", "Travar", "Não"
SaveSetting "CIA2005", "Registro", "Data", vDataFinal
MsgBox "Chave Validada com Sucesso." & vbCrLf & _
"Você pode usar o CIA 2005 por mais: " & vPeríodo & " dias." & vbCrLf & vbCrLf & _
"Obrigado por usar nosso Sistema.", vbCritical, "Atenção!!!"
ElseIf vChave = CalculaChave("VersaoFull") Then
SaveSetting "CIA2005", "Registro", "Travar", "Versão Full"
SaveSetting "CIA2005", "Registro", "Data", vDataFinal
MsgBox "Chave Validada com Sucesso." & vbCrLf & _
"Você pode usar o CIA 2005 sem restrições." & vPeríodo & " dias." & vbCrLf & vbCrLf & _
"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 Sub Command2_Click()
MsgBox "Forneça a Chave: " & Chr(34) & CalculaChave("SomenteDemo") & Chr(34) & " para Versão Demo", vbExclamation, "Versão Demo"
End Sub

Private Sub Command3_Click()
MsgBox "Forneça a Chave: " & Chr(34) & CalculaChave("VersaoFull") & Chr(34) & " para Versão Full", vbExclamation, "Versão Full"""
End Sub
USUARIO.EXCLUIDOS 09/07/2005 14:57:07
#93133
Ola Jean Jedson.
tentei entrar em contato com você via esse email mas, não consegui. Por favor entre em contato comigo via esse email pra tirar umas duvidas sobre esse algoritimo que voce mandou pra mim, ok? aguardo
henryeduard@bol.com.br
JEAN.JEDSON 09/07/2005 18:31:06
#93154
meu email (e msn) é jean@mormaii.com.br
qual a sua dúvida?
Tópico encerrado , respostas não são mais permitidas