String Encryption with matrixes

Introduction

First of all this isn't a great form of encryption, because it doubles the length of the string. However, it is hard to decrypt because even if the person decrypting it knew it was done using these functions they would also need the parameters. For those of you who don't know a matrix is an array of numbers set in an X by X table.

[1 4 6]    [5 7 4 8]    [4 5]
[3 7 3]    [5 2 6 1]    [3 7]
           [4 7 2 5]    [2 6]
2 by 3      3 by 4      3 by 2

These functions takes a matrix given as a parameter and then takes whatever amount of characters necessary out of the string to encrypt gets the ANSI values of the code to make a second matrix, then multiplies the two to get a third matrix. You can find plenty of other resources on how to multiply matrixes, so I not going to explain it hear. To decrypt instead of multiplying the function first has to find the inverse of the given matrix the doing the same thing as before.

Special Notes:

  • Because we are dealing with ANSI we can't have values that are over 255, so don't put values over 3 in the matrix.
  • Currently these function only support 2 by 2 matrixes, this will change eventually.
  • Send a matrix in a string format like this '1,2,3,4'


'****
' Author: Nick Avery, liserdarts@yahoo.com
' Date: October 25, 2001
' Description: Text Encryption
'****
Public Function Encrypt(Text As String, Matrix As String)
   If Len(Text) = 2 Then
       Encrypt = Text
       Exit Function
   End If
Dim Mat() As Integer
Dim Code() As Integer
Dim Txt() As Integer
Dim AmountOfRows As Integer

   'Get the numbers from Matrix and put them in Mat
   ReDim Preserve Mat(0 To 0)
   Do Until Matrix = ""
       ReDim Preserve Mat(0 To UBound(Mat) + 1)

       If InStr(Matrix, ",") <> 0 Then
           Mat(UBound(Mat)) = Left(Matrix, InStr(Matrix, ",") - 1)
           Matrix = Right(Matrix, Len(Matrix) - InStr(Matrix, ","))
       Else
           Mat(UBound(Mat)) = Matrix
           Matrix = ""
       End If
   Loop
   Do Until Int(Sqr(UBound(Mat))) = Sqr(UBound(Mat))
       ReDim Preserve Mat(0 To UBound(Mat) + 1)
       Mat(UBound(Mat)) = 3
   Loop
   AmountOfRows = Int(Sqr(UBound(Mat)))
   
   
   ReDim Preserve Txt(1 To AmountOfRows)
   ReDim Preserve Code(1 To AmountOfRows)
   Do Until Len(Text) < AmountOfRows
       'Get values from text
       For X = 1 To UBound(Code)
           Txt(X) = Asc(Left(Text, 1))
           Text = Right(Text, Len(Text) - 1)
       Next
       
       'Multiply the matrixes
       For X = 1 To UBound(Txt)
           Code(X) = 0
           For Y = 1 To AmountOfRows
               Code(X) = Code(X) + (Mat(((UBound(Mat) / AmountOfRows) * (Y - 1)) + X) * Txt(Y))
           Next
       Next
       
       'Put the new values in the text
       For X = 1 To UBound(Txt)
           'More often then not, the value after being run
           'through the matrix is over 255. Because we can't
           'use the Chr function with numbers over 255 we need
           'a more complex way to put the value in the text.
           'Hear we will do it by finding a number to divide
           'it by then insert that number and the result. This
           'doubles the length, but what can you do?
           Y = 1
           Do Until Code(X) / Y <= 256 And Round(Code(X) / Y, 0) * Y = Code(X)
               Y = Y + 1
               If Code(X) = Y Then 'The number is prime. Now we have to
                                   'assign a number to every prime number
                                   'above 255(1-257,2-263,3-269,ect). Then
                                   'insert an identifier character and the
                                   'prime number id.
                   Y = 0
                   X2 = 255
                   Do
                       X2 = X2 + 1
                       For Y2 = 2 To Code(X)
                           If Int(X2 / Y2) = X2 / Y2 Then GoTo NextNum
                           If Y2 = X2 - 1 Then
                               Y = Y + 1
                               If X2 = Code(X) Then
                                   X2 = 0
                               End If
                               GoTo NextNum
                           End If
                       Next
NextNum:
                       
                       If X2 = 0 Then Exit Do
                   Loop
                   Encrypt = Encrypt & Chr$(255) & Chr$(Y) 'Chr$(255) will be the identifier
                   Y = 0
                   Exit Do
               End If
           Loop
           If Y <> 0 Then Encrypt = Encrypt & Chr$(Y) & Chr$(Code(X) / Y)
       Next
   Loop
   Encrypt = Encrypt & Text
End Function

Public Function Decrypt(Text As String, Matrix As String)
   If Len(Text) = 2 Then
       Decrypt = Text
       Exit Function
   End If
Dim Mat() As Double
Dim Mat2() As Double
Dim Determinant As Integer
Dim Code() As Integer
Dim Txt() As Integer
Dim AmountOfRows As Integer

   'Get the numbers from Matrix and put them in Mat
   ReDim Preserve Mat(0 To 0)
   Do Until Matrix = ""
       ReDim Preserve Mat(0 To UBound(Mat) + 1)

       If InStr(Matrix, ",") <> 0 Then
           Mat(UBound(Mat)) = Left(Matrix, InStr(Matrix, ",") - 1)
           Matrix = Right(Matrix, Len(Matrix) - InStr(Matrix, ","))
       Else
           Mat(UBound(Mat)) = Matrix
           Matrix = ""
       End If
   Loop
   Do Until Int(Sqr(UBound(Mat))) = Sqr(UBound(Mat))
       ReDim Preserve Mat(0 To UBound(Mat) + 1)
       Mat(UBound(Mat)) = 3
   Loop
   AmountOfRows = Int(Sqr(UBound(Mat)))
   
   'Find the inverse of mat
       'The inverse of the matrix [a b]  is [1 / (a * d - c * b) * d          1 / (a * d - c * b) * (b * -1)]
       '                          [c d]     [1 / (a * d - c * b) * (c * -1)   1 / (a * d - c * b) * a       ]
       'a * d - c * b is called the determinant
   
   'Get the determinant
   Determinant = (Mat(1) * Mat(4)) - (Mat(2) * Mat(3))
   
   'Put the inverse of Mat into Mat2
   ReDim Mat2(1 To UBound(Mat))
   For X = 1 To UBound(Mat)
       If X = 1 Then
           Mat2(X) = (1 / Determinant) * Mat(4)
       ElseIf X = 4 Then
           Mat2(X) = (1 / Determinant) * Mat(1)
       Else
           Mat2(X) = (1 / Determinant) * (Mat(X) * -1)
       End If
   Next
   
   'Put valuse of Mat2 in Mat
   For X = 1 To UBound(Mat)
       Mat(X) = Mat2(X)
   Next
   
   ReDim Preserve Txt(1 To AmountOfRows)
   ReDim Preserve Code(1 To AmountOfRows)
   Do Until Len(Text) < AmountOfRows
       'Get values from code
       For X = 1 To UBound(Txt)
           If Asc(Left(Text, 1)) = 255 Then
               Y = 0
               Code(X) = Asc(Right(Left(Text, 2), 1))
               X2 = 255
               Do
                   X2 = X2 + 1
                   Y2 = 1
                   Do
                       Y2 = Y2 + 1
                       If Int(X2 / Y2) = X2 / Y2 Then Exit Do
                       If Y2 * 2 > X2 - 1 Then
                           Y = Y + 1
                           If Y = Code(X) Then
                               Code(X) = X2
                               X2 = 0
                           End If
                           Exit Do
                       End If
                   Loop
                   If X2 = 0 Then Exit Do
               Loop
           Else
               Code(X) = Asc(Left(Text, 1)) * Asc(Right(Left(Text, 2), 1))
           End If
           Text = Right(Text, Len(Text) - 2)
       Next
       
       'Multiply the matrixes
       For X = 1 To UBound(Txt)
           Txt(X) = 0
           For Y = 1 To AmountOfRows
               Txt(X) = Txt(X) + (Mat(((UBound(Mat) / AmountOfRows) * (Y - 1)) + X) * Code(Y))
           Next
       Next
       
       'Take value from the Txt and make text
       For X = 1 To UBound(Txt)
           Decrypt = Decrypt & Chr$(Txt(X))
       Next
   Loop
   Decrypt = Decrypt & Text
End Function

You might also like...

Comments

Nick Avery I am as a web developer for a small company, working for a small company. I work on banking websites and verious related projects.

Contribute

Why not write for us? Or you could submit an event or a user group in your area. Alternatively just tell us what you think!

Our tools

We've got automatic conversion tools to convert C# to VB.NET, VB.NET to C#. Also you can compress javascript and compress css and generate sql connection strings.

“We better hurry up and start coding, there are going to be a lot of bugs to fix.”