Hi Neemi
I am posting a "module" .. you should be able to copy and paste this code below into a new module and it should work ( access 2000 ).
It is by no means fantastic but does produce some "complex" looking keys.. you can play around with the code as much as you want to add other variables or twists..like alternating each pair of numbers etc..
Look at the function ValidateProduct to see how to use the other functions, this is meant to be a starting blocl but there is no reason why it can't be used as it is.
Incidentally it mentions 2 words..if you want a licence that they can use on any machine then just use any 2 words..if you want to incorporate the serial number , then just make one of the words the serial number.
Tell me what you think...
Regards
Builderspec
Option Compare Database
' All the following functions created in MS Access 2000 13/02/2006
' by Graham Leighton
' Written to illustrate the principles of key licensing. You can play with the encoding
' as this one is fairly simple, it just adds one to each letter. You can adapt it to your
' own needs.
' I also advise that where it mentions the "two words" , you have a different two words for
' each client to prevent key swapping.
' This function creates a check digit and is used for both encoding and decoding the key
Function CreateCheckDigit(key As String)
Dim CheckDigit As Integer
For i = 1 To Len(key)
CheckDigit = CheckDigit + Val(Mid(key, i, 1))
Next i
CheckDigit = CheckDigit Mod 10
CreateCheckDigit = CheckDigit
End Function
' this function creates the key , pass it the company name and two known words
' the known words can be anything, any length and is used as part of the key
' the company name is used so that you can see which company is used
Function CreateKey(CompanyName As String, Word1 As String, Word2 As String)
Dim key As String
Dim i, j As Integer
Dim NewKey As Integer
Dim CheckDigit As Integer
dt = Replace(Date, "/", "")
key = Replace(CompanyName, " ", "") & Word1 & Word2 & dt
For i = 1 To Len(key)
Mid(key, i, 1) = Chr(Asc(Mid(key, i, 1)) + 1)
Next i
CreateKey = key & CreateCheckDigit(key)
End Function
'this function effectively reverses the key and checks:
' 1 that the check digit is correct for the key entered
' 2 that the chosen words appear in the "decoded" string
' 3 that today's date is in the string
'
Function ValidateKey(key As String, Word1 As String, Word2 As String)
Dim i, j As Integer
Dim NewKey As String
Dim valid As Boolean
Dim CheckDigit As String
Dim KeyCheck As String
Dim FoundWord1 As Boolean
Dim FoundWord2 As Boolean
valid = False
NewKey = key
KeyCheck = Left(NewKey, Len(NewKey) - 1)
CheckDigit = CreateCheckDigit(KeyCheck)
If CheckDigit <> Right(NewKey, 1) Then
ValidateKey = False
Exit Function
End If
For i = 1 To Len(NewKey)
Mid(NewKey, i, 1) = Chr(Asc(Mid(NewKey, i, 1)) - 1)
Next i
For j = 1 To Len(NewKey) - Len(Word1)
If Mid(NewKey, j, Len(Word1)) = Word1 Then
FoundWord1 = True
End If
Next j
For j = 1 To Len(NewKey) - Len(Word2)
If Mid(NewKey, j, Len(Word2)) = Word2 Then
FoundWord2 = True
End If
Next j
If FoundWord1 And FoundWord2 Then
valid = True
Else
valid = False
End If
If Not valid Then
ValidateKey = False
Exit Function
End If
dt = Left(Right(NewKey, 9), 8)
If dt = Replace(Date, "/", "") Then
valid = True
Else
valid = False
End If
ValidateKey = valid
End Function
' this is intended to show how you might use the above functions
' it creates a key then prompts you to enter a key, then validates
' the key against the key it generated itself , they should be the
' same.
' try it the day after and the key will be different
' you could alter the msgbox to display your phone number so they have to ring
' for a key!
' assumes that the company name will be held somewhere on the database or other
Function ValidateProduct()
Dim KeyGen As String
Dim ac As Integer
Dim KeyInput As String
Dim valid As Boolean
valid = False
KeyGen = CreateKey("My Company Ltd", "hstd004", "esauf02")
KeyInput = InputBox("Please enter licence key", "Key Required", "")
If Len(KeyInput) > 0 Then
If Not ValidateKey(KeyInput, "hstd004", "esauf02") Then
MsgBox "Not a valid key for this product" & vbCrLf & "Please contact ????", vbCritical
valid = False
Else
valid = True
MsgBox "Thank you registering this product with us blah blah blah"
End If
End If
ValidateProduct = valid
End Function