• Home
 · 
• String Manipulation
 · 
• (very) simple encryption/decryption whose key is based on milliseconds.

(very) simple encryption/decryption whose key is based on milliseconds.

(very) simple encryption/decryption whose key is based on milliseconds.

API Declarations



'This encryption algorithim first gets the day of
'the current date (including the character "0" if
'applicable in two digits), converts both characters
'into ascii values, adds them to a prime number and
'uses that as the encryption key. The value is
'encrypted under a simple ascii value addition and
'can be deduced from the first few characters of the
'encrypted string. The first character of the
'encrypted data is ALWAYS the ascii value of how many
'characters after it is the decrypt key, ie the
'length of the decrypt key is the ascii value of the
'first character.
'
'==================================================
'I realise that a better method would be to use a
'"rolling key" method, ie, changing or incrementing
'the encryption key as each character is encrypted.
'But. I'll leave that to you.
'DiskJunky
'==================================================

Declare Function GetTickCount Lib "kernel32" () As Long




Rate (very) simple encryption/decryption whose key is based on milliseconds.

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

Const AddToKey = 17 'added to help form the main key

Private Function GenerateKey() As Integer
'generates the main key use for encryption.

Dim MilliSecond As Integer

'I changed the daynum value to hold a second value
'instead of a day value for more variances.
'Changed again to an even shorter time value.
MilliSecond = (GetTickCount Mod 100)  '/ 1000)
GenerateKey = Val(Trim(Str(Format(MilliSecond, "00")))) + AddToKey 'Second(Time)
End Function

Public Function EncryptData(Text As String) As String
Dim Counter As Integer
Dim DayNum As String
Dim DayKey As Integer
Dim RetData As String
Dim Encrypt As String

'if text is empty, return empty
If Text = "" Then
    EncryptData = ""
    Exit Function
End If

DayKey = GenerateKey

'store the amount of digits daykey is, in the first
'character.
RetData = Chr(Len(Trim(Str(DayKey))))
RetData = RetData & EncryptKey(Trim(Str(DayKey)))

'encrypt the rest of the data
For Counter = 1 To Len(Text)
    DoEvents
    Encrypt = Trim(Chr((Asc(Mid(Text, Counter, 1)) + DayKey) Mod 256))
    RetData = RetData & Encrypt
Next Counter

EncryptData = RetData
End Function

Public Function DecryptData(Text As String) As String
Dim Counter As Integer
Dim DayNum As String
Dim DayKey As Integer
Dim RetData As String
Dim Decrypt As String
Dim DecryptNum As Integer

'get the amount of digits the key is and decrypt the
'key
If Text = "" Then
    Exit Function
End If
    
DayNum = GetKeyLength(Text)
DayKey = Val(DecryptKey(Mid(Text, 2, Val(DayNum))))
'DayKey = DayKey

'Dim test As Variant
'decrypt the rest of the data
For Counter = (Val(DayNum) + 2) To Len(Text)
    DoEvents
'    test = Mid(Text, Counter, 1)
'    test = Asc(Mid(Text, Counter, 1)) - DayKey
'    test = Chr(Asc(Mid(Text, Counter, 1)) - DayKey)
    DecryptNum = (Asc(Mid(Text, Counter, 1)) - DayKey) Mod 255
    If DecryptNum < 0 Then
        DecryptNum = 255 + DecryptNum
    Else
        DecryptNum = DecryptNum Mod 256
    End If
    
    Decrypt = Right(Chr(DecryptNum), 1)
    RetData = RetData & Decrypt
Next Counter

DecryptData = RetData
End Function

Public Function GetKeyLength(Text As String) As String
Dim KeyLength As Integer
'get the amount of digits the key is and decrypt the
'key
If Text = "" Then
    Exit Function
End If
    
KeyLength = Len(Str(Asc(Mid(Text, 1, 1))))

GetKeyLength = KeyLength
End Function

Private Function EncryptKey(Key As String) As String
'adds the encryption key to the ASCII value of each
'character.

Dim Counter As Integer
Dim NewKey As String

On Error Resume Next

For Counter = 1 To Len(Key)
    NewKey = NewKey & Right(Chr(Asc(Mid(Key, Counter, 1)) + BaseKey), 1)
Next Counter

EncryptKey = NewKey
End Function

Private Function DecryptKey(Key As String) As String
'subtracts the encryption key from the ASCII value
'of each character.

Dim Counter As Integer
Dim NewKey As String
Dim test As Variant

On Error Resume Next

For Counter = 1 To Len(Key)
    test = Mid(Key, Counter, 1)
    test = Asc(Mid(Key, Counter, 1))
    test = Chr(Asc(Mid(Key, Counter, 1)) - BaseKey)
    test = Right(Chr(Asc(Mid(Key, Counter, 1)) - BaseKey), 1)
    NewKey = NewKey & Right(Chr(Asc(Mid(Key, Counter, 1)) - BaseKey), 1)
Next Counter

If Key = "" Then NewKey = ""

DecryptKey = NewKey
End Function