Setting Expiry Dates For Trial Version Using Registry

kamulegs

Registered User.
Local time
Today, 22:14
Joined
Aug 23, 2010
Messages
12
Greetings

I have been searching on how to set expiry date of a trial version of DB

I have come a cross the code below

If i run the sub SetExpirationDate, and check in the registry, i do not see the entry.
If i run the sub UpdateLastUseddDate, i get a runtime error: Invalid root in registry key

Please have a look at the code below, and guide me on how to make it work.
Code:
Option Compare Database

Option Explicit
'Registry constants
Private Const REG_EXPDATE As String = _
"HKCU \ Software \ MyCompany \ MyApplication \ ExpirationDate"
Private Const REG_LASTUSED As String = _
"HKCU \ Software \ MyCompany \ MyApplication \ LastUsedDate"
Private Const REG_SZ As String = "REG_SZ"
Private Const EXPIRATION_LENGTH_DAYS As Long = 30

 Sub SetExpirationDate()
' update the last use date
Dim objShell As Object
Dim expDate As Date
Set objShell = CreateObject("WScript.Shell")
On Error Resume Next
expDate = CDate(objShell.RegRead(REG_EXPDATE))
If (err = &H80070002) Then
' key does not exist, create it
objShell.RegWrite REG_EXPDATE, Now() + EXPIRATION_LENGTH_DAYS, REG_SZ
End If
On Error GoTo 0
Set objShell = Nothing
End Sub
 Sub UpdateLastUsedDate()
Dim objShell As Object
' write the key value
Set objShell = CreateObject("WScript.Shell")
objShell.RegWrite REG_LASTUSED, Now(), REG_SZ
Set objShell = Nothing
End Sub
Public Function IsExpired() As Boolean
' determines whether the expiration date has passed
Dim expDate As Date
Dim lastUsed As Date
Dim objShell As Object
Set objShell = CreateObject("WScript.Shell")
' read the values
On Error Resume Next
expDate = objShell.RegRead(REG_EXPDATE)
' first use
If (err) Then
SetExpirationDate
IsExpired = False
Exit Function
End If
 'check the last used date
lastUsed = objShell.RegRead(REG_LASTUSED)
If (err) Then
UpdateLastUsedDate
IsExpired = False
Exit Function
End If
On Error GoTo 0
 'if the current system date is less than the last use date then
'the user messed with their system clock
If (Now() < lastUsed) Then
IsExpired = True
Else
' system clock is ok so check the expiration date
' against the last use date
IsExpired = (lastUsed >= expDate)
 'update the last usage date
If (Not IsExpired) Then
UpdateLastUsedDate
End If
End If
Debug.Print lastUsed
Set objShell = Nothing
End Function
 
use SaveSetting() and GetSetting() functions to read/write in registery
 

Users who are viewing this thread

Back
Top Bottom