EXPIRAR EM ACCESS
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.
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.
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
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
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
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
meu email (e msn) é jean@mormaii.com.br
qual a sua dúvida?
qual a sua dúvida?
Tópico encerrado , respostas não são mais permitidas