?? 加密.vbs
字號:
BinaryCode = Array("0000","0001","0010","0011","0100","0101","0110","0111","1000","1001","1010","1011","1100","1101","1110","1111")
HexCode = Array("0","1","2","3","4","5","6","7","8","9","A","B","C","D","E","F")
UniRangeNoBit = Array(0,7,11,16,21,26,31)
UTF8HeaderNoBit = Array(1,3,4,5,6,7)
'Main
' Put Main Code Here!
' Provide two functions:CvtStr2UTF8(byval UniString) And CvtUTF82Str(byval UTF8String)
' CvtStr2UTF8() can be used to convert a string of characters to a series of UTF8 code!
' CvtUTF82Str() can be used to convert a series of UTF8 code to a string of characters!
' Aim Convert Chinese Character File to Another coded by UTF8!
const ForReading = 1
const ForWriting = 2
const ForAppending = 8
const WindowNormal = 1
const WindowMax = 3
const WindowMin = 7
dim LineStr
set fso = CreateObject("Scripting.FileSystemObject")
set shl = CreateObject("WScript.Shell")
set netuser = CreateObject("WScript.NetWork")
fnameR = ""
do while true
fnameR = InputBox("Enter the target file name:", "Welcome " &_
netuser.UserName & "!Starting " & fso.GetBaseName(WScript.ScriptName) & "!Please Input!", "")
If fnameR = "" Then WScript.Quit(1)
if Not fso.FileExists(fnameR) then
MsgBox "The file '" & fnameR & "' does not exist."
else
exit do
end if
loop
basename = fso.GetBaseName(fnameR)
extname = fso.GetExtensionName(fnameR)
fnameW = CvtStr2UTF8(basename) & "." & extname
set streamR = fso.OpenTextFile(fnameR,ForReading)
set streamW = fso.OpenTextFile(fnameW,ForWriting,true)
do until streamR.AtEndOfStream
LineStr = streamR.ReadLine
if Left(Trim(LineStr),1) <> "'" then
if Len(LineStr) > 0 then
streamW.Write CvtStr2UTF8(LineStr) & vbLF
else
streamW.Write vbLF
end if
end if
loop
'streamW.WriteBlankLines 1
streamW.WriteLine "'The original file is: " & fso.GetAbsolutePathName(fnameR) & "."
streamW.WriteLine " 'Created by " & netuser.UserName & " at " & Time() & "."
streamR.Close
streamW.Close
set streamR = Nothing
set streamW = Nothing
set netuser = Nothing
shl.Run "notepad " & fnameW,WindowMax,True
if MsgBox("Orginal file existed at """ & fso.GetAbsolutePathName(fnameR) & """.Delete or not?",_
VbYesNo+VbExclamation, "DelOrNot") = VbYes then
fso.DeleteFile(fnameR)
end if
set fso = Nothing
'End Main
Function CvtStr2UTF8(byval UniString)
'Can deal with such input as "Exercise",and lead to mixed result such as "%45%78%65%72%63%69%73%65".
dim i,TempUniStr,UTF8CharUnit,UTF8UnitLen,OneUniChar,DecNum
CvtStr2UTF8 = ""
TempUniStr = UniString
do while Len(TempUniStr) > 0
OneUniChar = Left(TempUniStr,1)
if OneUniChar = Escape(OneUniChar) then
CvtStr2UTF8 = CvtStr2UTF8 &_
FormatUTF8(Bin2Hex(Uni2UTF8(Dec2Bin(AscW(OneUniChar)))))
else
CvtStr2UTF8 = CvtStr2UTF8 &_
FormatUTF8(Bin2Hex(Uni2UTF8(Hex2Bin(JudgeUnicode(Escape(OneUniChar))))))
end if
TempUniStr = Mid(TempUniStr,2)
loop
end Function
Function CvtUTF82Str(byval UTF8String)
'Can deal with mixed input as "%e6%af%8f-kfg%e6%97%a5" and "e6af8f-kfge6975".
dim i,TempUTF8Str,UTF8CharUnit,UTF8UnitLen,BinCode
CvtUTF82Str = ""
TempUTF8Str = Trim(UTF8String)
if Instr(TempUTF8Str,"%") > 0 then
do while Len(TempUTF8Str) > 0
if Left(TempUTF8Str,1) = "%" then
UTF8UnitLen = 3*SingleUTF8Len(Mid(TempUTF8Str,2,2))
if Len(TempUTF8Str) >= UTF8UnitLen then
UTF8CharUnit = Replace(Left(TempUTF8Str,UTF8UnitLen),"%","")
CvtUTF82Str = CvtUTF82Str & _
Unescape(FormatUni(Bin2Hex(UTF82Uni(Hex2Bin(JudgeUTF8(UTF8CharUnit))))))
TempUTF8Str = Right(TempUTF8Str,Len(TempUTF8Str)-UTF8UnitLen)
else
WScript.echo "Warning From CvtUTF82Str! Part of the input UTF8 Hex number """ & TempUTF8Str &_
""" is incomplete(the length is: " & Len(TempUTF8Str) & ",it shouldn't be less than " & UTF8UnitLen & ".)!"
CvtUTF82Str = CvtUTF82Str & TempUTF8Str
exit do
end if
else
CvtUTF82Str = CvtUTF82Str & Left(TempUTF8Str,1)
TempUTF8Str = Mid(TempUTF8Str,2)
end if
loop
else
do while Len(TempUTF8Str) > 0
UTF8UnitLen = 2*EnhSingleUTF8Len(Mid(TempUTF8Str,1,2))
if UTF8UnitLen < 0 then
WScript.echo "Warning From CvtUTF82Str! The input UTF8 Hex number """ & TempUTF8Str &_
""" is invalid!"
CvtUTF82Str = CvtUTF82Str & TempUTF8Str
exit Function
end if
if Len(TempUTF8Str) >= UTF8UnitLen then
UTF8CharUnit = Left(TempUTF8Str,UTF8UnitLen)
BinCode = EnhHex2Bin(JudgeUTF8(UTF8CharUnit))
if BinCode <> -1 then
CvtUTF82Str = CvtUTF82Str & _
Unescape(FormatUni(Bin2Hex(UTF82Uni(BinCode))))
TempUTF8Str = Right(TempUTF8Str,Len(TempUTF8Str)-UTF8UnitLen)
else
WScript.echo "Warning From CvtUTF82Str! The input UTF8 Hex number """ & TempUTF8Str &_
""" is invalid!"
CvtUTF82Str = CvtUTF82Str & TempUTF8Str
exit Function
end if
else
WScript.echo "Warning From CvtUTF82Str! Part of the input UTF8 Hex number """ & TempUTF8Str &_
""" is incomplete(the length is: " & Len(TempUTF8Str) & ",it shouldn't be less than " & UTF8UnitLen & ".)!"
CvtUTF82Str = CvtUTF82Str & TempUTF8Str
exit do
end if
loop
end if
end Function
Function SingleUTF8Len(byval FirstUTF8) 'FirstUTF8 = ##
dim i,LenSign,TempBinStr,overFlowFlag,ArrayIndex
TempBinStr = Hex2Bin(FirstUTF8)
LenSign = 1
overFlowFlag = true
do while Left(TempBinStr,1) = "1"
LenSign = LenSign + 1
TempBinStr = Mid(TempBinStr,2)
loop
for i = 0 to 5
if LenSign = UTF8HeaderNoBit(i) then
overFlowFlag = false
ArrayIndex = i
Exit for
end if
next
if overFlowFlag then
WScript.echo "Error From SingleUTF8Len! The binary header of input Hex number """&_
FirstUTF8 & """ don't accord with UTF8 format(the binary form is: """ & Hex2Bin(FirstUTF8) & """.)!"
WScript.Quit(1)
end if
SingleUTF8Len = ArrayIndex + 1
end Function
Function EnhSingleUTF8Len(byval FirstUTF8) 'FirstUTF8 = ##
dim i,LenSign,TempBinStr,overFlowFlag,ArrayIndex
TempBinStr = EnhHex2Bin(FirstUTF8)
if TempBinStr = -1 then
EnhSingleUTF8Len = -1
exit Function
end if
LenSign = 1
overFlowFlag = true
do while Left(TempBinStr,1) = "1"
LenSign = LenSign + 1
TempBinStr = Mid(TempBinStr,2)
loop
for i = 0 to 5
if LenSign = UTF8HeaderNoBit(i) then
overFlowFlag = false
ArrayIndex = i
Exit for
end if
next
if overFlowFlag then
WScript.echo "Error From EnhSingleUTF8Len! The binary header of input Hex number """&_
FirstUTF8 & """ don't accord with UTF8 format(the binary form is: """ & EnhHex2Bin(FirstUTF8) & """.)!"
WScript.Quit(1)
end if
EnhSingleUTF8Len = ArrayIndex + 1
end Function
Function JudgeUTF8(byval HexOfUTF8)
dim i,HexLen,TempStr,LastStr
JudgeUTF8 = ""
TempStr = ""
LastStr = ""
HexOfUTF8 = Trim(HexOfUTF8)
HexLen = Len(HexOfUTF8)
if InStr(HexOfUTF8,"%") <= 0 then
if HexLen > 0 And (HexLen Mod 2) = 0 then
if HexLen > 12 then
WScript.echo "Error From JudgeUTF8! The input UTF8 Hex number """ & HexOfUTF8 &_
""" leads to overflow(the length is: " & HexLen & ",greater than 12!"
WScript.Quit(1)
end if
JudgeUTF8 = HexOfUTF8
else
WScript.echo "Error From JudgeUTF8! The length of input UTF8 Hex number """ & HexOfUTF8 &_
""" is not qualified(the length is: " & HexLen & " (could be zero or odd number)!"
WScript.Quit(1)
end if
else
if (HexLen Mod 3) = 0 then
if HexLen > 18 then
WScript.echo "Error From JudgeUTF8! The input UTF8 Hex number """ & HexOfUTF8 &_
""" leads to overflow(the length is: " & HexLen & ",greater than 18.)!"
WScript.Quit(1)
end if
LastStr = HexOfUTF8
for i = 1 to HexLen/3
TempStr = Left(LastStr,3)
if Left(TempStr,1) = "%" then
JudgeUTF8 = JudgeUTF8 & Right(TempStr,2)
LastStr = Right(LastStr,Len(LastStr)-3)
else
WScript.echo "Error From JudgeUTF8! The format of input UTF8 Hex number """ &_
HexOfUTF8 & """ is invalid(the " & i & "th segment's """ & Left(TempStr,1) & """ should be ""%"".)!"
WScript.Quit(1)
end if
next
else
WScript.echo "Error From JudgeUTF8! The length of input UTF8 Hex number """ & HexOfUTF8 &_
""" is not qualified(the length is: " & HexLen & " (could be divided exactly by 3)!"
WScript.Quit(1)
end if
end if
JudgeUTF8 = Ucase(JudgeUTF8)
end Function
Function JudgeUnicode(byval HexOfUnicode)
dim i,HexLen,TempStr
JudgeUnicode = ""
TempStr = ""
HexOfUnicode = Trim(HexOfUnicode)
if Left(HexOfUnicode,1) = "%" then
if Left(HexOfUnicode,2) = "%u" then
JudgeUnicode = Right(HexOfUnicode,Len(HexOfUnicode)-2)
else
JudgeUnicode = Right(HexOfUnicode,Len(HexOfUnicode)-1)
if Len(JudgeUnicode) > 2 then
WScript.echo "Error From JudgeUnicode! The length of input Unicode Hex number """ & HexOfUnicode &_
""" shouldn't exceed 3(the length is: " & Len(HexOfUnicode) & ".)!"
WScript.Quit(1)
end if
end if
else
JudgeUnicode = HexOfUnicode
end if
HexLen = Len(JudgeUnicode)
if (HexLen Mod 2) <> 0 then
JudgeUnicode = "0" & JudgeUnicode
HexLen = HexLen + 1
end if
if HexLen > 8 then
WScript.echo "Error From JudgeUnicode! The input Unicode Hex number """ & JudgeUnicode &_
""" leads to overflow(the length is: " & HexLen & ",greater than 8.)!"
WScript.Quit(1)
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -