XOR De/Encoding

Category:

String Manipulation

Type:

Snippets

Difficulty:

Beginning

Author: Anonymous

Version Compatibility: Visual Basic 6, Visual Basic 5, Visual Basic.NET

More information:

XOR En/Decryption that gives you a readable string (doesnt contain any special chars) that can be saved as preference or somewhat else, there are other routines that make a nice XOR but the encoded string is not usable because it contains special chars that make your string unusable and undecodable

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
' (None)

Code:

Public Function XORDecryption(CodeKey As String, DataIn As String) As String
    
    Dim lonDataPtr As Long
    Dim strDataOut As String
    Dim intXOrValue1 As Integer
    Dim intXOrValue2 As Integer

For lonDataPtr = 1 To (Len(DataIn) / 2)
        'The first value to be XOr-ed comes from the data to be encrypted
        intXOrValue1 = Val("&H" & (Mid$(DataIn, (2 * lonDataPtr) - 1, 2)))
        'The second value comes from the code key
        intXOrValue2 = Asc(Mid$(CodeKey, ((lonDataPtr Mod Len(CodeKey)) + 1), 1))
        
        strDataOut = strDataOut + Chr(intXOrValue1 Xor intXOrValue2)
    Next lonDataPtr
   XORDecryption = strDataOut
End Function

Public Function XOREncryption(CodeKey As String, DataIn As String) As String
    
    Dim lonDataPtr As Long
    Dim strDataOut As String
    Dim temp As Integer
    Dim tempstring As String
    Dim intXOrValue1 As Integer
    Dim intXOrValue2 As Integer

For lonDataPtr = 1 To Len(DataIn)
        'The first value to be XOr-ed comes from the data to be encrypted
        intXOrValue1 = Asc(Mid$(DataIn, lonDataPtr, 1))
        'The second value comes from the code key
        intXOrValue2 = Asc(Mid$(CodeKey, ((lonDataPtr Mod Len(CodeKey)) + 1), 1))
        
        temp = (intXOrValue1 Xor intXOrValue2)
        tempstring = Hex(temp)
        If Len(tempstring) = 1 Then tempstring = "0" & tempstring
        
        strDataOut = strDataOut + tempstring
    Next lonDataPtr
   XOREncryption = strDataOut
End Function

'USAGE
'Private Sub cmdEncryptdecrypt_Click()
'    Dim strCodeKey As String
'    strCodeKey = InputBox("Please enter your password", "XOr Encryption")
'    txtSource.Text = XOREncryption(strCodeKey, txtSource.Text)
'End Sub
'
'Private Sub cmdDecryptdecrypt_Click()
'    Dim strCodeKey As String
'    strCodeKey = InputBox("Please enter your password", "XOr Decryption")
'    txtSource.Text = XORDecryption(strCodeKey, txtSource.Text)
'End Sub