VBA實現 加解密文件

[mini]

===解密: Decode.vbs===

Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fsot, ft
Dim ValCrypt
Dim BoolMsg
On Error Resume Next

ValCrypt = Cint(InputBox("請輸入當初設定之文件解密密碼(正整數)"))
BoolMsg = MsgBox("是否解密所有.Crypt文件(答""是""的話會根據Crypt.List文件列表;答""否""的話請輸入單一文件)",vbYesNoCancel,"指定解密文件")
If BoolMsg = vbYes Then
Set fsot = CreateObject("Scripting.FileSystemObject")
Set ft = fsot.OpenTextFile("Crypt.List", ForReading, False, TristateUseDefault)
While Not ft.AtEndOfStream
ReadWriteFile ft.ReadLine, ValCrypt
Wend
ElseIF BoolMsg = vbNo Then
ReadWriteFile InputBox("請輸入文件完整名稱"), ValCrypt
End IF
On Error GoTo 0

Sub ReadWriteFile(FileNameStr, ByValCrypt)
Dim fso, f1, f2, i
Dim NewText, ReadAllTextFile
Dim ValTristate, ValLen

Set fso = CreateObject("Scripting.FileSystemObject")
Set f1 = fso.OpenTextFile(FileNameStr + ".Crypt", ForReading, False, TristateUseDefault)
Set f2 = fso.OpenTextFile(FileNameStr + ".Crypt", ForReading, False, TristateTrue)

ReadAllTextFile = f1.ReadAll
NewText = f2.ReadAll
If StrComp(ReadAllTextFile, NewText) Then
ValTristate = TristateUseDefault '開啟檔案為系統預設狀態
Else
ValTristate = TristateTrue 'Unicode
End If
f2.Close
NewText = Empty

ValLen = Len(CStr(ByValCrypt))
For i = 1 to Len(ReadAllTextFile) Step ValLen
NewText = NewText + ChrB(CInt(Mid(ReadAllTextFile, i, ValLen))- ByValCrypt)
Next
NewText = StrReverse(NewText)

Set f1 = fso.OpenTextFile("Decode_" + FileNameStr, ForWriting, True, ValTristate)
f1.Write NewText
End Sub