Xor algorithm with no special characters using VBA

Question

For a project I am developing I need to use some kind of encryption algorithm to encrypt some sensitive data, where each user has a unique hex key.

Basically I have to encrypt a string and write it to a file to import to a Access database (we are not authorised to use other RDBMS as the company policies don't allow it).

So while researching what algorithms to use, I've came across this awesome sample of an XOR algorithm from VBA Express, but there are some limitations with this particular algorithm (please correct me if I'm wrong) :

For certain combinations of string vs key, a overflow happens;
Excel uses a "different" ASCII code table which causes some entropy as well (can't use the first 32 codes because they refer to special characters);

I want to avoid special characters (line feeds, carriage returns) because I want to write to a file and if they exist I can't read the file as the splits will go bad.

With this being said, I can't maintain a 1 to 1 relationship of encoding and decoding.

So should I use another encryption system or are there changes should I do to fix this bad encryption?
Should I use another reading/writing file system other than line by line?

The code to generate the keys to test

    Private Sub getDictionaryValues()

        Dim atc As String
        Dim wsheet As Worksheet
        Dim wstmp As Worksheet
        Dim rng As Range
        Dim k As Long, j As Long
        Dim arrrr(1 To 223) As String
        Dim arc()

        On Error Resume Next

        j = 2
        Set wsheet = ThisWorkbook.Worksheets("Sheet4")
        arc = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", "D", "E", "F")

        For i = 33 To 255
            arrrr(i - 32) = Chr(i)
        Next i

        For k = LBound(arc) To UBound(arc)

            For i = LBound(arrrr) To UBound(arrrr)
                atc = XorC(arrrr(i), arc(k))
                wsheet.Range(Cells(j, 1), Cells(j, 1)) = arc(k)
                wsheet.Range(Cells(j, 2), Cells(j, 2)) = i + 32
                wsheet.Range(Cells(j, 3), Cells(j, 3)) = arrrr(i)
                wsheet.Range(Cells(j, 4), Cells(j, 4)) = Right(atc, Len(atc) - 3)
                wsheet.Cells(j, 5) = XorC(atc, arc(k))
                'wsheet.Cells(j, 6) = getUnicode(arrrr(i), arc(k))
                j = j + 1
            Next i
            atc = vbNullString
        Next k
    End Sub

My version of the Xor algorithm

    Function XorC(ByVal sData As String, ByVal sKey As String) As String

        Dim l As Long, i As Long, byIn() As Byte, byOut() As Byte, byKey() As Byte
        Dim bEncOrDec As Boolean
        Dim addVal

        If Len(sData) = 0 Or Len(sKey) = 0 Then XorC = "Invalid argument(s) used": Exit Function

        If Left$(sData, 3) = "xxx" Then
            bEncOrDec = False 'decryption
            sData = Mid$(sData, 4)
        Else
            bEncOrDec = True 'encryption
        End If

        byIn = sData
        byOut = sData
        byKey = sKey

        If bEncOrDec = True Then
            addVal = 32
        Else
            addVal = 1 * -32
        End If

        l = LBound(byKey)

        For i = LBound(byIn) To UBound(byIn) - 1 Step 2

            If (((byIn(i) + Not bEncOrDec) Xor byKey(l)) + addVal) > 255 Then
                byOut(i) = (((byIn(i) + Not bEncOrDec) Xor byKey(l)) + addVal) Mod 255 + addVal
            Else
                'If bEncOrDec Then
                If ((byIn(i) + Not bEncOrDec) Xor byKey(l)) - addVal < 32 Then byOut(i) = ((byIn(i) + Not bEncOrDec) Xor byKey(l)) + addVal
                If ((byIn(i) + Not bEncOrDec) Xor byKey(l)) - addVal > 255 Then byOut(i) = ((byIn(i) + Not bEncOrDec) Xor byKey(l)) - addVal
                If ((byIn(i) + Not bEncOrDec) Xor byKey(l)) > 32 And (byIn(i) + Not bEncOrDec) Xor byKey(l) < 256 Then byOut(i) = ((byIn(i) + Not bEncOrDec) Xor byKey(l))
            End If
            l = l + 2

            If l > UBound(byKey) Then l = LBound(byKey)

        Next i

        XorC = byOut

        If bEncOrDec Then XorC = "xxx" & XorC 'add "xxx" onto encrypted text
    End Function

Xor algorithm with no special characters using VBA

0 Answers