![]() |
VBA實現 加解密文件
以下程式碼只需存檔成 .vbs 或 .wsf 就可 滑鼠雙擊
利用 windows 內建的 Microsoft Windows Script 來執行 ※原則上建議用在不要太大的純文字檔上(.txt),畢竟 .vbs是直譯器的應用很費資源的 ※個人保證上述腳本在未經變動下是不會造成任何破壞的(病毒) ※vbs如無法執行請安裝 Microsoft Windows Script 請至 http://www.microsoft.com/downloads/d...C-0EA28C9A5D9D http://www.microsoft.com/downloads/d...playLang=zh-cn P.S. 簡體版請自行更換下方語系 缺點: 因為是用純數字字元記載加密文件,所以容易看出規則破解,及會有容量倍數成長的問題 (VBS沒有VB這麼多涵式好用,這點請有興趣的網友自己試著改進 ^^||) 腳本可改良的地方很多 比如密碼可改成文字(不過加密後的文件size會變大,當然可以用壓縮算式,不過寫起來太累人了...^^||) 或加入解密密碼混和讀寫 或文字改成 byte進制檔來存取 還有執行方式有是...(要寫絕對路徑的判讀) 列表: List.bat (為列出此地路徑下的所有.txt檔,當然也可以自己更改搜尋條件 ※生成的列表檔為Crypt.List請勿更名) ===加密: Crypt.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("請輸入加密密碼 ※需為大於等於100之正整數")) BoolMsg = MsgBox("是否指定單一文件加密(答""否""的話就是使用 Crypt.List批次處理)",vbYesNoCancel,"指定加密文件") If BoolMsg = vbNo Then Set fsot = CreateObject("Scripting.FileSystemObject") Set ft = fsot.OpenTextFile("Crypt.List", ForReading) While Not ft.AtEndOfStream ReadWriteFile ft.ReadLine Wend ElseIF BoolMsg = vbYes Then ReadWriteFile InputBox("請輸入File完整名稱") End IF On Error GoTo 0 Sub ReadWriteFile(FileNameStr) Dim fso, f1, f2, i Dim NewText, ReadAllTextFile Dim ValTristate Set fso = CreateObject("Scripting.FileSystemObject") Set f1 = fso.OpenTextFile(FileNameStr, ForReading, False, TristateUseDefault) Set f2 = fso.OpenTextFile(FileNameStr, 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 ReadAllTextFile = StrReverse(ReadAllTextFile) For i = 1 to LenB(ReadAllTextFile) NewText = NewText + CStr(AscB(MidB(ReadAllTextFile, i, 1)) + ValCrypt) Next Set f1 = fso.OpenTextFile(FileNameStr + ".Crypt", ForWriting, True, ValTristate) f1.Write NewText End Sub ===List.bat === dir /b .\*.txt > Crypt.List |
===解密: 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 |
原理還是簡單解說一下
一開始會要求輸入 密碼 再來 不論加密還是解密,都有兩個模式 一為 單一檔案 一為 處理 Crypt.List 選好後 就進入 加/解密 副程式處理 副程式內一開始做了 UTF-8、UniCode、ANSI 之文檔字碼判斷 知道是哪種文檔字碼後再以相對應的開檔模式 開啟->處理->存檔 |
所有時間均為台北時間。現在的時間是 04:25 AM。 |
Powered by vBulletin® 版本 3.6.8
版權所有 ©2000 - 2025, Jelsoft Enterprises Ltd.
『服務條款』
* 有問題不知道該怎麼解決嗎?請聯絡本站的系統管理員 *