by Stephen Blaising (3 Submissions)
Category: Encryption
Compatability: Visual Basic 5.0
Difficulty: Unknown Difficulty
Originally Published: Thu 7th December 2000
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Generates a shareware key. How it works: the CreateKey function: The parameter 'ApplicationKey' refers to a key that you will have to use that
API Declarations
Private Const DEFAULT_FORMAT = "&&&&-&&&&-&&&&-&&&&"
VBcoders
' for use in sFormat; use '&' to represent alpha-numeric characters
Dim intTemp As Integer
Dim strTextChar As String
Dim strKeyChar As String
Dim intEncryptedChar As String
Dim strKey As String
Dim i As Integer
Dim strUserName As String
strUserName = LCase(Trim(UserName))
If Len(strUserName) = 0 Then
Err.Raise vbError + 1001, , "Invalid Username"
Exit Function
End If
'This is an altered simple encryption algorithm
For i = 1 To CountAmpersands(sFormat)
strTextChar = Mid(strUserName, (i Mod Len(strUserName)) + 1, 1)
strKeyChar = Mid(ApplicationKey, (i Mod Len(ApplicationKey)) + 1, 1)
intTemp = (((Asc(strKeyChar) * i) * Len(ApplicationKey) + 1) Mod Len(ValidCharacters) + 1)
strTextChar = Chr(Asc(strTextChar) Xor intTemp)
intTemp = (((Asc(strKeyChar) * i) * Len(UserName) + 1) Mod Len(ValidCharacters) + 1)
strTextChar = Chr(Asc(strTextChar) Xor intTemp)
intEncryptedChar = ((Asc(strTextChar) Xor Asc(strKeyChar)) Mod Len(ValidCharacters)) + 1
strKey = strKey & Mid(ValidCharacters, intEncryptedChar, 1)
Next i
CreateKey = Format(strKey, sFormat)
End Function
Private Function CountAmpersands(ByVal Format As String) As Integer
'Counts the number of characters that need to be returned
Dim i As Integer
Dim intCount As Integer
intCount = 0
For i = 1 To Len(Format)
If Mid(Format, i, 1) = "&" Then
intCount = intCount + 1
End If
Next i
CountAmpersands = intCount
End Function
Public Function IsGoodKey(ApplicationKey As String, UserName As String, Key As String, Optional sFormat As String = DEFAULT_FORMAT, Optional ValidCharacters As String = VALID_CHARACTERS) As Boolean
'This function does not need to exist
'It is here to make testing the key just a little simpler
If LCase(Trim(Key)) = LCase(Me.CreateKey(ApplicationKey, UserName, sFormat, ValidCharacters)) Then
IsGoodKey = True
Else
IsGoodKey = False
End If
End Function
No comments have been posted about Generates a shareware key. How it works: the CreateKey function: The parameter 'ApplicationKey' ref. Why not be the first to post a comment about Generates a shareware key. How it works: the CreateKey function: The parameter 'ApplicationKey' ref.
