String XOR Encryption

[Gunner54]

Could someone post some simple String Xor encryption. When i try to Xor my strings they just get "mismatch" error.

[CVMichael]

Search in the CodeBank

[DigiRev]

Here's a simple one for strings...one of the fastest ways for large strings since it works with the original string directly.

Option Explicit

Private Sub XORIt(ByRef Text As String, ByRef key As String)
    Dim l As Long
    Dim lonLenKey As Long, lonKeyPos As Long
    lonLenKey = Len(key)
    For l = 1 To Len(Text)
        lonKeyPos = lonKeyPos + 1
        If lonKeyPos > lonLenKey Then lonKeyPos = 1
        Mid$(Text, l, 1) = Chr$(Asc(Mid$(Text, l, 1)) Xor Asc(Mid$(key, lonKeyPos, 1)))
    Next l
End Sub

Private Sub Form_Load()
    Dim data As String, key As String
    
    data = "This is some data."
    key = "Weak encryption key"
    
    Debug.Print "PLAINTEXT: " & data
    XORIt data, key
    Debug.Print "ENCRYPTED: " & data
    XORIt data, key
    Debug.Print "DECRYPTED: " & data
End Sub

[Gunner54]

Thanks! =D works a charm, and its fast like you said.

[Logophobic]

Using byte arrays is considerably faster than calling all those string functions for each character, especially with longer strings. Compared to the code DigiRev posted, the function below is 5 to 10 times faster on short strings (<100 chars) and at least 25 times faster on longer strings (>1000 chars).

Private Function Cipher(Text As String, Key As String) As String
  Dim bText() As Byte
  Dim bKey() As Byte
  Dim TextUB As Long
  Dim KeyUB As Long
  Dim TextPos As Long
  Dim KeyPos As Long
  
  bText = StrConv(Text, vbFromUnicode)
  bKey = StrConv(Key, vbFromUnicode)
  TextUB = UBound(bText)
  KeyUB = UBound(bKey)
  For TextPos = 0 To TextUB
    bText(TextPos) = bText(TextPos) Xor bKey(KeyPos)
    If KeyPos < KeyUB Then
      KeyPos = KeyPos + 1
    Else
      KeyPos = 0
    End If
  Next TextPos
  Cipher = StrConv(bText, vbUnicode)
End Function

[DigiRev]

I would have posted a byte array one but I thought he wanted one that used the string data type in the algorithm since the thread title...

[tarobf]

Using byte arrays is considerably faster than calling all those string functions for each character, especially with longer strings. Compared to the code DigiRev posted, the function below is 5 to 10 times faster on short strings (<100 chars) and at least 25 times faster on longer strings (>1000 chars).

Private Function Cipher(Text As String, Key As String) As String
  Dim bText() As Byte
  Dim bKey() As Byte
  Dim TextUB As Long
  Dim KeyUB As Long
  Dim TextPos As Long
  Dim KeyPos As Long
  
  bText = StrConv(Text, vbFromUnicode)
  bKey = StrConv(Key, vbFromUnicode)
  TextUB = UBound(bText)
  KeyUB = UBound(bKey)
  For TextPos = 0 To TextUB
    bText(TextPos) = bText(TextPos) Xor bKey(KeyPos)
    If KeyPos < KeyUB Then
      KeyPos = KeyPos + 1
    Else
      KeyPos = 0
    End If
  Next TextPos
  Cipher = StrConv(bText, vbUnicode)
End Function

What's a simple method of decrypting something like this that you provided?

[passel]

You call the function again.
XOR essentially toggles bits, based on the key values, so if you call it a second time with the same key, it toggles the bits back to their original state.