Option Compare Database
Option Explicit
Public Sub SetExpiry(lMaxNumberOfTimes As Long, sCoName As String, sPresetReg As String, lNumOfDays As Long)
Dim p As Property
Dim db As DAO.Database
Set db = CurrentDb()
'set the required expiry date (defaults to 30 days from now)
On Error Resume Next
With db
'check to see if already defined
Set p = .Properties("LKExpiryDate")
If Err = 3270 Then 'property does not exist
Set p = .CreateProperty()
p.Name = "LKExpiryDate"
p.Type = dbDate
p.Value = CDate("01/01/1900")
.Properties.Append p
Err.Clear
Else
p.Value = CDate("01/01/1900")
End If
Set p = .Properties("LKMaxNumberOfTimes")
If Err = 3270 Then
Set p = .CreateProperty()
p.Name = "LKMaxNumberOfTimes"
p.Type = dbInteger
p.Value = lMaxNumberOfTimes
.Properties.Append p
Err.Clear
Else
p.Value = lMaxNumberOfTimes
End If
Set p = .Properties("LKCounter")
If Err = 3270 Then
Set p = .CreateProperty()
p.Name = "LKCounter"
p.Type = dbInteger
p.Value = 0
.Properties.Append p
Err.Clear
Else
p.Value = 0
End If
Set p = .Properties("LKCompanyName")
If Err = 3270 Then
Set p = .CreateProperty()
p.Name = "LKCompanyName"
p.Type = dbText
p.Value = 0
.Properties.Append p
Err.Clear
Else
p.Value = sCoName
End If
Set p = .Properties("LKPresetReg")
If Err = 3270 Then
Set p = .CreateProperty()
p.Name = "LKPresetReg"
p.Type = dbText
p.Value = sPresetReg
.Properties.Append p
Err.Clear
Else
p.Value = sPresetReg
End If
Set p = .Properties("LKUserKeyInReg")
If Err = 3270 Then
Set p = .CreateProperty()
p.Name = "LKUserKeyInReg"
p.Type = dbText
p.Value = " "
.Properties.Append p
Err.Clear
Else
p.Value = " "
End If
Set p = .Properties("LKUserKeyInCompany")
If Err = 3270 Then
Set p = .CreateProperty()
p.Name = "LKUserKeyInCompany"
p.Type = dbText
p.Value = " "
.Properties.Append p
Err.Clear
Else
p.Value = " "
End If
Set p = .Properties("LKNumOfDays")
If Err = 3270 Then
Set p = .CreateProperty()
p.Name = "LKNumOfDays"
p.Type = dbInteger
p.Value = lNumOfDays
.Properties.Append p
Err.Clear
Else
p.Value = lNumOfDays
End If
Set p = .Properties("LKFirstUsedDate")
If Err = 3270 Then 'property does not exist
Set p = .CreateProperty()
p.Name = "LKFirstUsedDate"
p.Type = dbDate
p.Value = CDate("01/01/1900")
.Properties.Append p
Err.Clear
Else
p.Value = CDate("01/01/1900")
End If
Set p = .Properties("LKLastUsedDate")
If Err = 3270 Then 'property does not exist
Set p = .CreateProperty()
p.Name = "LKLastUsedDate"
p.Type = dbDate
p.Value = CDate("01/01/1901")
.Properties.Append p
Err.Clear
Else
p.Value = CDate("01/01/1901")
End If
End With
On Error GoTo 0
End Sub
Public Function LKStartup()
Dim pExpDate As Property, pMax As Property, pCounter As Property
Dim db As DAO.Database
Dim pCoName As Property, pUserKeyInCoName As Property, pPresetReg As Property, pUserKeyInReg As Property
Dim pFirstUsedDate As Property, pLastUsedDate As Property, pNumOfDays As Property
Set db = CurrentDb()
With db
'check to see if already defined
Set pExpDate = .Properties("LKExpiryDate")
Set pMax = .Properties("LKMaxNumberOfTimes")
Set pCounter = .Properties("LKCounter")
Set pCoName = .Properties("LKCompanyName")
Set pUserKeyInCoName = .Properties("LKUserKeyInCompany")
Set pPresetReg = .Properties("LKPresetReg")
Set pUserKeyInReg = .Properties("LKUserKeyInReg")
Set pNumOfDays = .Properties("LKNumOfDays")
Set pFirstUsedDate = .Properties("LKFirstUsedDate")
Set pLastUsedDate = .Properties("LKLastUsedDate")
pCounter.Value = pCounter.Value + 1 'Increase the usage counter
'Check If is the first use,
If pFirstUsedDate.Value = CDate("01/01/1900") And pLastUsedDate.Value = CDate("01/01/1901") Then
'Set the expiry date and the first & last used date
pFirstUsedDate.Value = Date
pLastUsedDate.Value = Now
pExpDate.Value = DateAdd("d", pNumOfDays.Value, Date) 'Expiry date will be first used date plus num of days
Else 'If not the first use
'Check if back dated the computer
If pLastUsedDate.Value > Now Then 'If last used time greater than the current time, it means compunter has been back dated
'Penalty of one day if the computer has been back dated.
pLastUsedDate.Value = DateAdd("d", 1, pLastUsedDate.Value)
Else 'not back dated
pLastUsedDate.Value = Now
End If
End If
If Now > pExpDate.Value Or pCounter.Value > pMax.Value Or pLastUsedDate.Value > pExpDate.Value Then 'Check expiry date and the counter, either one expired, will reject the use of this db
'Check if register or not
If pCoName.Value <> pUserKeyInCoName.Value Or pPresetReg.Value <> pUserKeyInReg.Value Then
DoCmd.OpenForm "frmRegister", , , , , acDialog
End If
End If
End With
End Function
