by DiskJunky (16 Submissions)
Category: String Manipulation
Compatability: Visual Basic 5.0
Difficulty: Unknown Difficulty
Originally Published: Thu 14th December 2000
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
(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
VBcoders
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
No comments have been posted about (very) simple encryption/decryption whose key is based on milliseconds.. Why not be the first to post a comment about (very) simple encryption/decryption whose key is based on milliseconds..
