Ales Zigon
07-14-2002, 01:44 PM
Hi!
Long time no see... so
I've seen this Q been asked many times before so here's a simple demo on how it "could" be done. It's not perfect but it "should" give someone an idea where to start. Just put this code into a standard module and call CheckForOwner sub from somewhere (SubMain or something...)
Option Explicit
Public iTimeCount As Integer 'RunTime counter
Public strMyName As String
Public Const EXP_TIME As Integer = 30 'this is your expiration time! Change it to your needs!!
Private Function IsFirstTime() As Boolean
'check if the App runs for the first time
If GetSetting(App.Title, "RunTime", "FirstTime", 0) = 0 Then 'the app didn't yet run on this PC
'notify the user
MsgBox "This is the first time you run this famous program on this computer!"
IsFirstTime = True 'return TRUE (it's the first time!)
Else
'*** see if the user wants you to display runtime counts on every start-up
If GetSetting(App.Title, "ShowTimeCount", "YesNo", "Yes") = "Yes" Then
iTimeCount = GetSetting(App.Title, "RunTime", "FirstTime") 'get the setting from the registry
'notify the user
MsgBox "This famous program has been started " & iTimeCount + 1 & " times on this computer"
End If
IsFirstTime = False 'return FALSE (it's NOT the first time!)
End If
iTimeCount = iTimeCount + 1 'add 1 to the counter
SaveSetting App.Title, "RunTime", "FirstTime", iTimeCount 'save the counter
End Function
Public Sub CheckForOwner()
If IsFirstTime Then 'check if it's the first time
RegisterProgram
Else
'*** check if the program has expired or hasn't been registered
strMyName = GetSetting(App.Title, "Owner", "Name", "Not Registered!") 'get the owner name from the registry
If iTimeCount < EXP_TIME And strMyName = "Not Registered!" Then 'the program has not expired and has not been registered
'*** notify the user and ask him to register properly
If MsgBox("This program has NOT been registered! Would you like to register now?", vbYesNo + vbQuestion) = vbYes Then
RegisterProgram
Else
'notify the user!
MsgBox "This program will expire in " & EXP_TIME - iTimeCount - 1 & " runs!"
End If
ElseIf iTimeCount > EXP_TIME And strMyName = "Not Registered!" Then
'notify the user and end the program
MsgBox "This program has EXPIRED! You're NOT allowed to use it anymore!"
End
ElseIf iTimeCount > EXP_TIME And strMyName <> "Not Registered" Then Exit Sub
ElseIf iTimeCount < EXP_TIME And strMyName <> "Not Registered" Then Exit Sub
End If
'*** if not, tell the user how many days he/she has left for using the program without the registration
End If
End Sub
Private Sub RegisterProgram()
'*** ask the user to enter his/hers name and/or registration code
strMyName = InputBox("Please enter your name!", "Registration procedure")
'*** check if the entry is empty
If strMyName = "" Then 'if it's empty
'notify the user...
MsgBox "You didn't enter your name! Without the proper registration" & vbCrLf & _
"this program will expire in " & EXP_TIME - iTimeCount & " runs!" & vbCrLf & _
"Thank you for evaluating our product!"
Else 'save the name to the registry
SaveSetting App.Title, "Owner", "Name", strMyName
'*** ask if the user wants you to display RunTimeCounts on every startup
If MsgBox("Do you want me to display RunTimCounts on every StartUp?", vbYesNo + vbQuestion) = vbNo Then
SaveSetting App.Title, "ShowTimeCount", "YesNo", "No"
End If
'*** give credits to the user
MsgBox "Thank you for registering this product!"
End If
End Sub
Hope someone will gain something...
Long time no see... so
I've seen this Q been asked many times before so here's a simple demo on how it "could" be done. It's not perfect but it "should" give someone an idea where to start. Just put this code into a standard module and call CheckForOwner sub from somewhere (SubMain or something...)
Option Explicit
Public iTimeCount As Integer 'RunTime counter
Public strMyName As String
Public Const EXP_TIME As Integer = 30 'this is your expiration time! Change it to your needs!!
Private Function IsFirstTime() As Boolean
'check if the App runs for the first time
If GetSetting(App.Title, "RunTime", "FirstTime", 0) = 0 Then 'the app didn't yet run on this PC
'notify the user
MsgBox "This is the first time you run this famous program on this computer!"
IsFirstTime = True 'return TRUE (it's the first time!)
Else
'*** see if the user wants you to display runtime counts on every start-up
If GetSetting(App.Title, "ShowTimeCount", "YesNo", "Yes") = "Yes" Then
iTimeCount = GetSetting(App.Title, "RunTime", "FirstTime") 'get the setting from the registry
'notify the user
MsgBox "This famous program has been started " & iTimeCount + 1 & " times on this computer"
End If
IsFirstTime = False 'return FALSE (it's NOT the first time!)
End If
iTimeCount = iTimeCount + 1 'add 1 to the counter
SaveSetting App.Title, "RunTime", "FirstTime", iTimeCount 'save the counter
End Function
Public Sub CheckForOwner()
If IsFirstTime Then 'check if it's the first time
RegisterProgram
Else
'*** check if the program has expired or hasn't been registered
strMyName = GetSetting(App.Title, "Owner", "Name", "Not Registered!") 'get the owner name from the registry
If iTimeCount < EXP_TIME And strMyName = "Not Registered!" Then 'the program has not expired and has not been registered
'*** notify the user and ask him to register properly
If MsgBox("This program has NOT been registered! Would you like to register now?", vbYesNo + vbQuestion) = vbYes Then
RegisterProgram
Else
'notify the user!
MsgBox "This program will expire in " & EXP_TIME - iTimeCount - 1 & " runs!"
End If
ElseIf iTimeCount > EXP_TIME And strMyName = "Not Registered!" Then
'notify the user and end the program
MsgBox "This program has EXPIRED! You're NOT allowed to use it anymore!"
End
ElseIf iTimeCount > EXP_TIME And strMyName <> "Not Registered" Then Exit Sub
ElseIf iTimeCount < EXP_TIME And strMyName <> "Not Registered" Then Exit Sub
End If
'*** if not, tell the user how many days he/she has left for using the program without the registration
End If
End Sub
Private Sub RegisterProgram()
'*** ask the user to enter his/hers name and/or registration code
strMyName = InputBox("Please enter your name!", "Registration procedure")
'*** check if the entry is empty
If strMyName = "" Then 'if it's empty
'notify the user...
MsgBox "You didn't enter your name! Without the proper registration" & vbCrLf & _
"this program will expire in " & EXP_TIME - iTimeCount & " runs!" & vbCrLf & _
"Thank you for evaluating our product!"
Else 'save the name to the registry
SaveSetting App.Title, "Owner", "Name", strMyName
'*** ask if the user wants you to display RunTimeCounts on every startup
If MsgBox("Do you want me to display RunTimCounts on every StartUp?", vbYesNo + vbQuestion) = vbNo Then
SaveSetting App.Title, "ShowTimeCount", "YesNo", "No"
End If
'*** give credits to the user
MsgBox "Thank you for registering this product!"
End If
End Sub
Hope someone will gain something...