• Home
 · 
• Encryption
 · 
• Generates a shareware key. How it works: the CreateKey function: The parameter 'ApplicationKey' ref

Generates a shareware key. How it works: the CreateKey function: The parameter 'ApplicationKey' ref

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 = "&&&&-&&&&-&&&&-&&&&"



Rate Generates a shareware key. How it works: the CreateKey function: The parameter 'ApplicationKey' ref

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

    ' 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