SoFunction
Updated on 2025-04-13

VBS hexadecimal XOR encryption implementation code


Key = "www-enun-net" 'Don't use numbers

now & ", Encryption: "
MyData = ReadBin("")
EnData = Encoder(MyData)
WriteBin "E_test.jpg", EnData
now & ", Encryption: "

now & ", decryption: "
MyData = ReadBin("E_test.jpg")
UnData = Uncoder(MyData)
WriteBin "U_test.jpg", UnData
now & ", decryption: "


Function ReadBin(FileName)
 Dim Stream, ObjXML, MyNode
 Set ObjXML = CreateObject("")
 Set MyNode = ("binary")
 Set Stream = CreateObject("")
  = ""
  = 1
 
  FileName
  =
 
 ReadBin =
 Set MyNode = Nothing
 Set Stream = Nothing
 Set ObjXML = Nothing
End Function

Function WriteBin(FileName, BufferData)
 Dim Stream, ObjXML, MyNode
 Set ObjXML = CreateObject("")
 Set MyNode = ("binary")
 Set Stream = CreateObject("")
  = ""
  = BufferData
  = 1
 
 
  FileName, 2
 
 Set stream = Nothing
 Set MyNode = Nothing
 Set ObjXML = Nothing
End Function

Function Encoder(Data)
 Dim K, M
 For n = 0 To Len(Key)-1
  K = K & Asc(Left(Right(key, Len(Key)-n), 1)) & "#"
 Next
 Data = UCase(Data)
 For i = 0 To Len(Data)-1
  M = Left(Right(Mid(Data, i+1, 1), Len(Data)-i), 1)
  For j = 0 To Len(Key)-1
   If i Mod Len(Key) = j  Then
    Encoder = Encoder & Hex((Asc(M) Xor Split(K, "#")(j)))
   End If
  Next
 Next
End Function

Function Uncoder(Data)
 Dim K
 For n = 0 To Len(Key)-1
  K = K & "#" & Asc(Left(Right(key, Len(Key)-n), 1)) & "#X"
 Next
 K = K & K
 Data = UCase(Data)
 For i = 1 To Len(Data) Step 2
  For j = 1 To Len(Key) * 2
   If i Mod Len(Key)*2 = j  Then
    Uncoder = Uncoder & Chr(Split(K, "#")(j) Xor ("&H" & Mid(Data, i, 2)))
   End If
  Next
 Next
End Function