Laserje18
Junior Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Простая функция шифрования XOR (исключающее ИЛИ). При первом запуске скрипта в папке, где находится сам скрипт, создаётся пустой файл pass.txt, в него записываем ключ, при помощи которого и будет зашифрован файл. Как расшифровать зашифрованный файл при потере ключа не знаю. После сохранения ключа в файле pass.txt, файл, который нужно зашифровать, перетягиваем на скрипт, этот файл будет зашифрован и перезаписан, копий исходного, не зашифрованного файла, создаваться не будет. Повторно перетянув зашифрованный файл на скрипт, при правильном ключе, этот файл перезаписывается уже расшифрованным. Можно одновременно шифровать несколько файлов, перетянув их все на скрипт, файлы могут находиться в разных местах, при этом ключ будет один для всех.
Xor.vbs
Код: Option Explicit
Dim FSO
Dim WshShell
Dim objArgs
Dim P
Dim List
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
Set objArgs = WScript.Arguments
P=FSO.GetParentFolderName(WScript.ScriptFullName)&"\"&"pass.txt"
If Not FSO.FileExists(P) Then FSO.OpenTextFile(P,2,True,-1).Close
If Len(ReadAll(P,encoding(P))) = 0 Then WshShell.Popup "Ключ отсутствует.",1,WScript.ScriptName,16+4096: Wscript.Quit
If objArgs.Count = 0 Then WshShell.Popup "Файл для шифрования отсутствует.",1,WScript.ScriptName,16+4096: Wscript.Quit
For Each List In objArgs
WriteText List,cryptXOR(List,P),encoding(List)
Next
WshShell.Popup "Ok",1,WScript.ScriptName,64+4096
'----------
Function cryptXOR(ByVal file,ByVal pass)
Dim txt,key,i,j
txt = ReadAll(file,encoding(file))
key = ReadAll(pass,encoding(pass))
j = 1
For i = 1 To Len(txt)
If j = Len(key)+1 Then j = 1
cryptXOR = cryptXOR & Chr(Asc(Mid(txt,i,1)) Xor Asc(Mid(key,j,1)))
j = j + 1
Next
End Function
'----------
Function encoding(ByVal file)
Dim a
With WScript.CreateObject("Scripting.FileSystemObject")
a = .OpenTextFile(file,1,False,0).Read(3)
End With
Select Case True
Case Left(a,2) = Chr(&HFF) & Chr(&HFE) Or Left(a,2) = Chr(&HFE) & Chr(&HFF)
encoding = "utf-16"
Case a = Chr(&HEF) & Chr(&HBB) & Chr(&HBF)
encoding = "utf-8"
Case Else
encoding = "windows-1251"
End Select
End Function
'----------
Function ReadAll(ByVal file,encoding)
With CreateObject("ADODB.Stream")
.Type = 2: .Charset = encoding: .Open
.LoadFromFile(file)
ReadAll = .ReadText(-1)
.Close
End With
End Function
'----------
Sub WriteText(ByVal file,txt,encoding)
With CreateObject("ADODB.Stream")
.Type = 2: .Charset = encoding: .Open
.WriteText(txt)
.SaveToFile file, 2
.Close
End With
End Sub
'----------
Wscript.Quit |
|
