|
-
Dec 1st, 2001, 10:25 PM
#1
Thread Starter
Hyperactive Member
An encryption to analyse
I wrote a cryption class, developed and altered over a period of time, and am wondering how it measures up. It was done completely independently, and I haven't actually read anything about encryption beyond learning how to use a binary file .
So, comments would be appreciated. How good/bad is it? What could I do to improve it? etc.
Code:
'Cryptor class module
'by me
Option Explicit
Private Password As String 'The password for cryption
Private Textstring As String 'The text to crypt
Private TextString2 As String 'Stores existing textstring during initialization of a new password
Private Threads() As Long 'A dynamic array that will contain the thread values
Private TotalASCII As Long 'The ASCII value added to everything in the text, combined with the thread value
Private ThreadNum As Long 'The number of cryption threads
Private Chunk As String 'A chunk of data that is crypted by the Crypt subroutine
Private Sub Crypt()
'This private subroutine does the actual cryption of chunks
'of data fed to it by the CryptText or CryptFile methods
Dim i As Long 'A counter
Dim i2 As Long 'Another counter
Dim TempChar As Long 'Temporary storage of ascii value
i2 = 1
For i = 1 To Len(Chunk) 'For each character in the chunk...
'The new character's ASCII value will be that of the
'existing character logically Xored with the value
'of the current thread, then logically anded with
'255 to truncate it to the correct bit length for
'ASCII codes
TempChar = ((Asc(Mid$(Chunk, i, 1))) Xor Threads(i2)) And 255
'Write the new character to the chunk of data
Mid$(Chunk, i, 1) = Chr(TempChar)
'Increment the thread
i2 = IIf(i2 = ThreadNum, 1, i2 + 1)
Next i
End Sub
Public Sub CryptText()
'This subroutine splits text into chunks for the Crypt method
Dim i As Long 'A counter
Dim Location As Long 'Stores the location in the textstring
i = 1
Do While i < (Len(Textstring) + 1)
'While the end of the textstring hasn't yet been reached
Select Case (Len(Textstring) - (Location - 1))
'Select case the length of the data left in the
'textstring to be crypted
Case Is > 1048575
'If it is greater than one less than one megabyte
'Grab a one megabyte long data chunk
Chunk = String(1048576, 0)
Chunk = Mid$(Textstring, i, 1048576)
'Crypt the chunk
Crypt
'Write the chunk back into the file
Mid$(Textstring, i, 1048576) = Chunk
'Increment the location and the i counter
Location = Location + 1048576
i = Location
Case Else
'If the remaining length is less than one megabyte
'Get all of the remaining data and put it into chunk
Chunk = String((Len(Textstring) + 1 - Location), 0)
Chunk = Mid$(Textstring, i, (Len(Textstring) + 1 - Location))
'Crypt chunk
Crypt
'Write chunk back into the textstring
Mid$(Textstring, i, Len(Chunk)) = Chunk
'End the loop since that was the last data
Exit Do
End Select
Loop
End Sub
Public Sub CryptFile(ByVal FilePath As String)
'Similar to CryptText, but works with a file instead of a
'string variable
Dim i As Long 'A counter
i = 1
Open FilePath For Binary As #80 'Open the file
Do While i < LOF(80) 'While the end of the file hasn't
'been reached
Select Case (LOF(80) - (Loc(80) - 1))
'Select case the length of data left
'If there is greated than or equal to
'one megabyte
Case Is >= 1048576
'Get a one megabyte chunk from the file
Chunk = String(1048576, 0)
Get #80, i, Chunk
'Crypt the chunk
Crypt
'Write the chunk back into the file
Put #80, i, Chunk
'Increment i
i = Loc(80) + 1
Case Else
'If the remaining data is less than one
'megabyte
'Get the rest of the data
Chunk = String((LOF(80) - (Loc(80))), 0)
Get #80, i, Chunk
'Crypt chunk
Crypt
'Write chunk back into file
Put #80, i, Chunk
'Exit loop since that was the last data
Exit Do
End Select
Loop
Close #80
End Sub
Public Property Let CryptPassword(ByRef Pass As String)
'This code occurs when a new password is given to Cryptor
'Make sure it is within 4 to 64 characters
Select Case Len(Pass)
Case 4 To 128
Case Else
MsgBox "Your password must be between 4 and 64 characters long. It will later have a length 4 times that that the original had."
Exit Property
End Select
'Set the password
Password = Pass
'Initialize the cryption threads - run InitCrypt
InitCrypt
'Secure the password - run SecurePass
SecurePass
End Property
Public Property Let TextToCrypt(ByRef Textstuff As String)
'Allows the program to feed Cryptor the textstring
Textstring = Textstuff
End Property
Public Property Get TextToCrypt() As String
'Allows the program to get the text back after cryption
TextToCrypt = Textstring
End Property
Private Sub InitCrypt()
'Private sub to initialize the cryption threads
Dim i As Long 'A counter
Dim i2 As Long 'Temporary storage variable
'Set TotalASCII and Threadnum to be 0 in case cryption
'has already been run using a different password
TotalASCII = 0
ThreadNum = 0
For i = 1 To Len(Password)
'Add up all of the ASCII codes of each character in the
'password and a percentage value based on each
'character's position in the password
i2 = i2 + ((Asc(Mid$(Password, i, 1))) * (10 + (i / 10)))
Next i
i2 = i2 \ 10
'Store this value in TotalASCII
TotalASCII = i2
'The number of cryption threads is the TotalASCII divided
'by 16, plus twice the length of the password
'(which is 16 to 256 characters)
ThreadNum = (TotalASCII \ 16) + (Len(Password) * 2)
'Redimension the threads array
ReDim Threads(1 To ThreadNum) As Long
'i2 now equals TotalASCII divided by 4 divided by the length
'of the password
i2 = ((TotalASCII \ 4) \ Len(Password))
For i = 1 To ThreadNum
'Each thread equals is thread number times i2 times 7
'plus the TotalASCII, logically anded with 255
'to truncate it to 8 bits
Threads(i) = ((i * i2 * 7) + TotalASCII) And 255
Next i
End Sub
Private Sub SecurePass()
'Private sub to secure the password
'Backup the textstring
TextString2 = Textstring
PassCrypting 'Ensure that the password is secure by crypting/doubling it three times
PassCrypting
PassCrypting
'Restore the original textstring
Textstring = TextString2
End Sub
Private Sub PassCrypting()
Textstring = Password & Password 'Textstring to crypt is the password twice
CryptText 'Crypt the password
Password = Textstring 'Return crypted value
InitCrypt 'Re-initialize cryption threads again
End Sub
Last edited by Alphanos; Dec 1st, 2001 at 10:29 PM.
Alphanos
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|