by Sullivan Dane (1 Submission)
Category: String Manipulation
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Wed 28th March 2001
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
XOR encription/decription of a string OR file
VBcoders
'I hope it is usefull to someone
'
'Sullivan Dane
'
'[email protected]
Sub CryptFile(txtfilepath As String, tipeofoperation As Integer)
Dim filesysob , fileob
dim inputtext as String
Dim outputtext As String
'Creates a F.S.O. Object
Set filesysob = CreateObject("Scripting.FileSystemObject")
Set fileob = filesysob.GetFile(txtfilepath)
If Not fileob.Size = 0 Then
fileob.Close
If tipeofoperation = 0 Then 'Encripts
Set fileob = filesysob.OpenTextFile(txtfilepath, 1, False)
inputtext = fileob.ReadAll
fileob.Close
outputtext = Encrypt inputtext, "ThiS Is A 3xAmPlE K3y - :)"
Set fileob = filesysob.OpenTextFile(txtfilepath, 2, False)
fileob.Write outputtext
fileob.Close
Else
Set fileob = fs.OpenTextFile(txtfilepath, 1, False)
inputtext = fileob.ReadAll
fileob.Close
outputtext = Decrypt inputtext, "ThiS Is A 3xAmPlE K3y - :)"
Set fileob = filesysob.OpenTextFile(txtfilepath, 2, False)
fileob.Write outputtext
fileob.Close
End If
End If
End Sub
Private Function Decrypt(PlainStr As String, key As String)
Dim Char As String, KeyChar As String, NewStr As String
Dim Pos As Integer
Dim i As Integer, Side1 As String, Side2 As String
Pos = 1
'This is a little trick to make it slightly harder to crack.
'However, the length of the string must be divisable by 2.
'So if that is not the case It adds an extra character to the string
If Len(PlainStr) Mod 2 = 0 Then
Side1 = StrReverse(Left(PlainStr, (Len(PlainStr) / 2)))
Side2 = StrReverse(Right(PlainStr, (Len(PlainStr) / 2)))
PlainStr = Side1 & Side2
End If
If Right(PlainStr, 1) = "X" Then
PlainStr = Left(PlainStr, Len(PlainStr) - 1)
End If
'This loop decrypts the data.
For i = 1 To Len(PlainStr)
Char = Mid(PlainStr, i, 1)
KeyChar = Mid(key, Pos, 1)
NewStr = NewStr & Chr(Asc(Char) Xor Asc(KeyChar))
If Pos = Len(key) Then Pos = 0
Pos = Pos + 1
Next i
Decrypt = NewStr
End Function
Private Function Encrypt(PlainStr As String, key As String)
Dim Char As String, KeyChar As String, NewStr As String
Dim Pos As Integer
Dim i As Integer, Side1 As String, Side2 As String
Pos = 1
'This loop encrypts the data.
For i = 1 To Len(PlainStr)
Char = Mid(PlainStr, i, 1)
KeyChar = Mid(key, Pos, 1)
NewStr = NewStr & Chr(Asc(Char) Xor Asc(KeyChar))
If Pos = Len(key) Then Pos = 0
Pos = Pos + 1
Next i
'This is a little trick to make it slightly harder to crack.
'However, the length of the string must be divisable by 2.
'So if that is not the case It adds an extra character to the string
If Len(NewStr) Mod 2 = 0 Then
Side1 = StrReverse(Left(NewStr, (Len(NewStr) / 2)))
Side2 = StrReverse(Right(NewStr, (Len(NewStr) / 2)))
NewStr = Side1 & Side2
Else
NewStr = NewStr & "X"
Side1 = StrReverse(Left(NewStr, (Len(NewStr) / 2)))
Side2 = StrReverse(Right(NewStr, (Len(NewStr) / 2)))
NewStr = Side1 & Side2
End If
Encrypt = NewStr
End Function
