• Home
 · 
• String Manipulation
 · 
• XOR encription/decription of a string OR file

XOR encription/decription of a string OR file

XOR encription/decription of a string OR file

Rate XOR encription/decription of a string OR file

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

'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