UNKNOWN '************************************** ' Name: RegCodes ' Description:This class contains two fu ' nctions which can be helpful in creating ' an online shareware registration system ' for your software projects. GenerateKeyC ' ode takes a username, or any other strin ' g, and generates a unique human-readable ' registration code (such as 9397-JQM0LD0Y ' JV from the string: Andy Carrasco). Gene ' rateKeyCode will generate a totally uniq ' ue registration code over and over again ' , even for the exact same name! VerifyKe ' yCode is the partner function, and will ' verify if a keycode matches a given name ' . ' By: Andy Carrasco ' ' ' Inputs:None ' ' Returns:None ' 'Assumes:None ' 'Side Effects:IMPORTANT NOTE! Although the codes generated from this algorithm will throughly confuse, and secure your code from, the average user, I make absolutely no gaurantee of security. The average hacker is NOT the average user, and anyone with a fairly general understanding of cyphering could quickly crack these algorithms. On the other hand, there are NO registration code utilities which gaurantee security, it would be foolish to believe that any form of encryption is totally secure. You may freely, and are encouraged to, use this algorithm in your own registration utilities, provided that you fully understand that I do not gaurantee the security of these functions, and that I will take no liability for any losses occuring from your use of these functions. They are primarily intended as a learning facility. Andy Carrasco 'This code is copyrighted and has limite ' d warranties. 'Please see http://www.Planet-Source-Cod ' e.com/xq/ASP/txtCodeId.1199/lngWId.1/qx/ ' vb/scripts/ShowCode.htm 'for details. '************************************** Option Explicit ' Name: GenerateKeyCode ' ' Description: 'This little routine generates a keycode ' for shareware registration in the 'format XXXX-YYYYYYYYYY, based on the Na ' me given as an argument. The first 'four digits are a randomly generated se ' ed value, which makes 8999 possible keyc ' odes 'for people with the same name (like Joh ' n Smith). The last four digits are 'the actual code. ' ' Written by: 'Andy Carrasco (Copyright 1998) ' Public Function GenerateKeyCode(sName As String) As String Dim sRandomSeed As String Dim sKeyCode As String Dim X As Long Dim KeyCounter As Long Dim PrimaryLetter As Long Dim CodedLetter As Long Dim sBuffer As String Randomize sRandomSeed = CStr(Int((9999 - 1000 + 1) * Rnd + 1000)) sName = UCase$(sName) KeyCounter = 1 'Clean up sName so there are no illegal ' characters. For X = 1 To Len(sName) If Asc(Mid$(sName, X, 1)) >= 65 And Asc(Mid$(sName, X, 1)) <= 90 Then sBuffer = sBuffer & Mid$(sName, X, 1) Next X sName = sBuffer 'if the name is less than 10 characters ' long, pad it out with ASCII 65 Do While Len(sName) < 10 sName = sName + Chr$(65) Loop For X = 1 To Len(sName) PrimaryLetter = Asc(Mid$(sName, X, 1)) CodedLetter = PrimaryLetter + CInt(Mid$(sRandomSeed, KeyCounter, 1)) If CodedLetter < 90 Then sKeyCode = sKeyCode + Chr$(CodedLetter) Else sKeyCode = sKeyCode + "0" End If 'Increment the keycounter KeyCounter = KeyCounter + 1 If KeyCounter > 4 Then KeyCounter = 1 Next X GenerateKeyCode = sRandomSeed + "-" + Left$(sKeyCode, 10) End Function ' Name: VerifyKeyCode ' ' Description: 'Verifies if a given keycode is valid fo ' r a given name. ' ' Parameters: 'sName- A string containing the user nam ' e to validate the key against 'sKeyCode- A string containins the keyco ' de in the form XXXX-YYYYYYYYYY. ' Public Function VerifyKeyCode(sName As String, sKeyCode As String) As Boolean Dim sRandomSeed As String Dim X As Long Dim KeyCounter As Long Dim PrimaryLetter As Long Dim DecodedKey As String Dim AntiCodedLetter As Long Dim sBuffer As String sRandomSeed = Left$(sKeyCode, InStr(sKeyCode, "-") - 1) sName = UCase$(sName) sKeyCode = Right$(sKeyCode, 10) KeyCounter = 1 'Clean up sName so there are no illegal ' characters. For X = 1 To Len(sName) If Asc(Mid$(sName, X, 1)) >= 65 And Asc(Mid$(sName, X, 1)) <= 90 Then sBuffer = sBuffer & Mid$(sName, X, 1) Next X sName = sBuffer 'if the name is less than 10 characters ' long, pad it out with ASCII 65 Do While Len(sName) < 10 sName = sName + Chr$(65) Loop 'now, decode the keycode For X = 1 To Len(sKeyCode) PrimaryLetter = Asc(Mid$(sKeyCode, X, 1)) AntiCodedLetter = PrimaryLetter - CInt(Mid$(sRandomSeed, KeyCounter, 1)) If PrimaryLetter = 48 Then 'zero DecodedKey = DecodedKey + Mid$(sName, X, 1) 'Take the corresponding letter from the name Else DecodedKey = DecodedKey + Chr$(AntiCodedLetter) End If 'Increment the keycounter KeyCounter = KeyCounter + 1 If KeyCounter > 4 Then KeyCounter = 1 Next X If DecodedKey = Left$(sName, 10) Then VerifyKeyCode = True Else VerifyKeyCode = False End If End Function