Option Explicit
Public Function DateGood(NumDays As Integer) As Boolean
'The
purpose of this module is to allow you to place a time
'limit on the unregistered use of your shareware application.
'This module can not be defeated by rolling back the system clock.
'Simply call the DateGood function when your application is first
'loading, passing it the number of days it can be used without
'registering.
'
'Ex: If DateGood(30)=False Then
' CrippleApplication
' End if
'Register Parameters:
' 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
'If this
is the applications first load, write initial settings
'to the register
If TmpLRD = "1/1/2000" Then
SaveSetting App.EXEName, "Param",
"LRD", TmpCRD
SaveSetting App.EXEName, "Param",
"FRD", TmpCRD
End If
'Read LRD
and FRD from register
TmpLRD = GetSetting(App.EXEName, "Param", "LRD",
"1/1/2000")
TmpFRD = GetSetting(App.EXEName, "Param", "FRD",
"1/1/2000")
If TmpFRD > TmpCRD Then 'System clock rolled back
DateGood = False
ElseIf Now > DateAdd("d", NumDays, TmpFRD) Then 'Expiration expired
DateGood = False
ElseIf TmpCRD > TmpLRD Then 'Everything OK write New LRD date
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 |