加密.vbs

用vbs将文本文件的装换成UTF-8格式的文本文件

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)