|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (Miscelâneas)
|
|
 |
Título da Dica: Configurar uma aplicação para ShareWare
|
 |
|
|
|
Postada em 3/2/2003 por Felipe
Option Explicit
Public Function DateGood(NumDays As Integer) As Boolean
'O Proposito desse modulo é colocar uma data limite
'na sua aplicação
'Esse modulo não pode ser destruido pela volta da data
'Apenas chame a função DateGood quando seu aplicativo for rodado a primeira vez
'passando como parametro os dias de registro '
'Ex: If DateGood(30)=False Then
' Roda Aplicação
' End if
'Parametro do Registro:
' CRD: Current Run Date
' LRD: Last Run Date
' FRD: First Run Date
Dim TmpCRD As Date
Dim TmpLRD As Date
Dim TmpFRD As Date
TmpCRD = Format(Now, "m/d/yy")
TmpLRD = GetSetting(App.EXEName, "Param", "LRD", "1/1/2000")
TmpFRD = GetSetting(App.EXEName, "Param", "FRD", "1/1/2000")
DateGood = False
'Se for o primeiro load do form escreva os sets iniciais para o registro
If TmpLRD = "1/1/2000" Then
SaveSetting App.EXEName, "Param", "LRD", TmpCRD
SaveSetting App.EXEName, "Param", "FRD", TmpCRD
End If
'Leia LRD e FRD do registro
TmpLRD = GetSetting(App.EXEName, "Param", "LRD", "1/1/2000")
TmpFRD = GetSetting(App.EXEName, "Param", "FRD", "1/1/2000")
If TmpFRD > TmpCRD Then 'Relogio do sistema sofreu alteração
DateGood = False
ElseIf Now > DateAdd("d", NumDays, TmpFRD) Then 'Prazo estourou
DateGood = False
ElseIf TmpCRD > TmpLRD Then 'Tudo OK escrever nova data LRD
SaveSetting App.EXEName, "Param", "LRD", TmpCRD
DateGood = True
ElseIf TmpCRD = Format(TmpLRD, "m/d/yy") Then
DateGood = True
Else
DateGood = False
End If
End Function
Private Sub Form_Activate()
If Not DateGood(30) Then
MsgBox "Trial Period Expired!", vbExclamation, "Unregistered application"
Unload Me
End If
End Sub
|
|
|
|
|
