Enum CryptLevel
[32-Bit] = 0
[64-Bit] = 1
End Enum

Public Function Encode(Data As String, Optional Depth As Integer) As String
Dim TempChar As String
Dim TempAsc As Integer
Dim NewData As String
Dim vChar As Integer

For vChar = 1 To Len(Data)
TempChar = Mid$(Data, vChar, 1)
TempAsc = Asc(TempChar)
If Depth = 0 Then Depth = 40 ' default djup
If Depth > 123 Then Depth = 48
TempAsc = TempAsc + Depth
If TempAsc > 123 Then TempAsc = TempAsc - 75
If TempAsc = 107 Then TempAsc = 125
If TempAsc = 91 Then TempAsc = 35
If TempAsc = 92 Then TempAsc = 43
If TempAsc = 93 Then TempAsc = 36
If TempAsc = 94 Then TempAsc = 40
If TempAsc = 95 Then TempAsc = 33
If TempAsc = 96 Then TempAsc = 36
TempChar = Chr(TempAsc)
NewData = NewData & TempChar
Next vChar
Encode = NewData
End Function

Public Function GetPassCode(sUsername As String, _
cEncryptionLevel As CryptLevel, iWidth As Integer, _
iMaxOutput As Integer, Optional sCompanyName)

Dim DTS1 As Variant
Dim DTS2 As String

If sUsername = "" Then
MsgBox "Beklagar, Skriv ett användarnamn", vbExclamation, "Fel"
Exit Function
End If

DTS1 = "BTM-" & iWidth + 21
If Len(sCompanyName) <= 0 Then
If cEncryptionLevel = [32-Bit] Then
For I = 0 To 31
DTS2 = Encode(sUsername, 48)
' DO NOT CHANGE THE 48
sUsername = DTS2
Next
Else
For I = 0 To 63
DTS2 = Encode(sUsername, 48)
' DO NOT CHANGE THE 48
sUsername = DTS2
Next
End If
Else
If cEncryptionLevel = [32-Bit] Then
For I = 0 To 31
DTS2 = Encode(sUsername & sCompanyName, 48)
' DO NOT CHANGE THE 48
sUsername = DTS2
Next
Else
For I = 0 To 63
DTS2 = Encode(sUsername & sCompanyName, 48)
' DO NOT CHANGE THE 48
sUsername = DTS2
Next
End If
End If

If Len(DTS1 & DTS2) >= iMaxOutput Then
DTS3 = Mid(DTS1 & DTS2, 1, iMaxOutput)
GetPassCode = DTS3
Else
GetPassCode = DTS1 & DTS2
End If
End Function

Public Function CheckPassCode(sUsername As String, _
cEncryptionLevel As CryptLevel, sPasscode As String, _
iWidth As Integer, iMaxOutput As Integer, _
Optional sCompanyName As String) As Boolean

Dim DTS1 As Variant
Dim DTS2, DTS3, TempDump As String
If sUsername = "" Then
MsgBox "Beklagar, Ange ett användarnamn.", vbExclamation, "Fel"
Exit Function
End If
DTS1 = "BTM-" & iWidth + 21

If Len(sCompanyName) <= 0 Then
If cEncryptionLevel = [32-Bit] Then
For I = 0 To 31
DTS2 = Encode(sUsername, 48)
' DO NOT CHANGE THE 48
sUsername = DTS2
Next
Else
For I = 0 To 63
DTS2 = Encode(sUsername, 48)
' DO NOT CHANGE THE 48
sUsername = DTS2
Next
End If
Else
If cEncryptionLevel = [32-Bit] Then
For I = 0 To 31
DTS2 = Encode(sUsername & sCompanyName, 48)
' DO NOT CHANGE THE 48
sUsername = DTS2
Next
Else
For I = 0 To 63
DTS2 = Encode(sUsername & sCompanyName, 48)
' DO NOT CHANGE THE 48
sUsername = DTS2
Next
End If
End If

If Len(DTS1 & DTS2) >= iMaxOutput Then
DTS3 = Mid(DTS1 & DTS2, 1, iMaxOutput)
DTS4 = DTS3
Else
DTS4 = DTS1 & DTS2
End If

If DTS4 = sPasscode Then
CheckPassCode = True
Else
CheckPassCode = False
End If

End Function