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.
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