vbs-組合使用

'文件讀成16進制 
'FileName:需要轉變的文件
Function ReadBinary(FileName)
	Const adTypeBinary = 1
	Dim stream, xmldom, node
	Set xmldom = CreateObject("Microsoft.XMLDOM")
	Set node = xmldom.CreateElement("binary")
	node.DataType = "bin.hex"
	Set stream = CreateObject("ADODB.Stream")
	stream.Type = adTypeBinary
	stream.Open
	stream.LoadFromFile FileName
	node.NodeTypedValue = stream.Read
	stream.Close
	Set stream = Nothing
	ReadBinary = node.Text
	'MsgBox ReadBinary
	Set node = Nothing
	Set xmldom = Nothing
End Function

'16進制寫成文件 
'FileName:指定文件的位置,絕對路徑
'Buf 16進制字符
Function Write16ToFile(FileName,Buf)
	Const adTypeBinary = 1
	Const adSaveCreateOverWrite = 2
	Dim stream, xmldom, node
	Set xmldom = CreateObject("Microsoft.XMLDOM")
	Set node = xmldom.CreateElement("binary")
	node.DataType = "bin.hex"
	node.Text = Buf
	Set stream = CreateObject("ADODB.Stream")
	stream.Type = adTypeBinary
	stream.Open
	stream.write node.NodeTypedValue
	stream.saveToFile FileName, adSaveCreateOverWrite
	stream.Close
	Set stream = Nothing
	Set node = Nothing
	Set xmldom = Nothing
End Function

'16進制轉2進制
'Buf 16進制字符串
Function hexTOBinary(Buf)
	Buf_len = len(Buf)
	For i = 1 To Buf_len
		hex_str = mid(Buf,i,1)
		binary = ""
		If hex_str = "0" then binary = "0000"
		If hex_str = "1" then binary = "0001"
		If hex_str = "2" then binary = "0010"
		If hex_str = "3" then binary = "0011"
		If hex_str = "4" then binary = "0100"
		If hex_str = "5" then binary = "0101"
		If hex_str = "6" then binary = "0110"
		If hex_str = "7" then binary = "0111"
		If hex_str = "8" then binary = "1000"
		If hex_str = "9" then binary = "1001"
		If hex_str = "a" then binary = "1010"
		If hex_str = "b" then binary = "1011"
		If hex_str = "c" then binary = "1100"
		If hex_str = "d" then binary = "1101"
		If hex_str = "e" then binary = "1110"
		If hex_str = "f" then binary = "1111"
		hexTOBinary = hexTOBinary & binary
	Next                                
End Function

'二進制轉16進制
'binary二進制字符串
Function binaryToHex(binary)
	binary_len = len(binary)
	quyu = binary_len mod 4
	If quyu <> 0 then 
		ss = 5/0
	End If
	hex_len = binary_len/4
	For i = 1 To hex_len
		start_index = (i-1)*4+1
		binary_sub = mid(binary,start_index,4)
		hex_str = ""
		If binary_sub = "0000" then hex_str = "0"
		If binary_sub = "0001" then hex_str = "1"
		If binary_sub = "0010" then hex_str = "2"
		If binary_sub = "0011" then hex_str = "3"
		If binary_sub = "0100" then hex_str = "4"
		If binary_sub = "0101" then hex_str = "5"
		If binary_sub = "0110" then hex_str = "6"
		If binary_sub = "0111" then hex_str = "7"
		If binary_sub = "1000" then hex_str = "8"
		If binary_sub = "1001" then hex_str = "9"
		If binary_sub = "1010" then hex_str = "a"
		If binary_sub = "1011" then hex_str = "b"
		If binary_sub = "1100" then hex_str = "c"
		If binary_sub = "1101" then hex_str = "d"
		If binary_sub = "1110" then hex_str = "e"
		If binary_sub = "1111" then hex_str = "f"
		binaryToHex = binaryToHex & hex_str
	Next
End Function

'讀取文本文件的內容
'textPath 文本文件所在位置,絕對路徑
Function readText(textPath)
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set textFile = fso.OpenTextFile(textPath,1,false)
	readText = textFile.ReadAll
	textFile.close
End Function

'把文本內容寫入文件
'text 文本內容
'fileName 指定文件生成的位置,絕對路徑
Function writeText(text,fileName)
	Set fso = CreateObject("Scripting.FileSystemObject")
	If fso.fileExists(fileName) then  '如果文件存在,則刪除
		fso.DeleteFile(fileName)
	end If
	'創建文件
	Set textFile = fso.CreateTextFile(fileName, True)
	textFile.close
	Set textFile = fso.OpenTextFile(fileName,8,false)
	textFile.Write(text)
	textFile.close
End Function



'ss = ReadBinary("E:\ocr\vbs\001.zip")
'WriteBinary "E:\ocr\vbs\001_cope.zip",ss 
'MsgBox hexTOBinary("47bba67c19")
'MsgBox binaryToHex("0100011110111011101001100111110000011001")




'16進制文本生成原文件
'fromTextPath 16進制文本保存位置,絕對路徑
'toPath 目標文件生成位置
Function HexToFile(fromTextPath,toPath)
	hexText = readText(fromTextPath)
	Write16ToFile toPath,hexText
End Function

'2進制文件生成原文件
'fromTextPath 2進制文本保存位置,絕對路徑
'toPath 目標文件生成位置
Function binaryToFile(fromTextPath,toPath)
	binaryText = readText(fromTextPath) '
	hexText = binaryToHex(binaryText)
	Write16ToFile toPath,hexText
End Function

'把文件讀成16進制
'16進制轉二進制
'2進制寫到文件裏
'文件讀成16進制和2進制 測試
Function fileTo16And2()
	fileHex = ReadBinary("E:\ocr\vbs\test001.rar")
	writeText fileHex,"E:\ocr\vbs\target_16.txt"
	fileBinary = hexTOBinary(fileHex)
	writeText fileBinary,"E:\ocr\vbs\target_2.txt"
End Function

'HexToFile "E:\ocr\vbs\target_16.txt","test001_copy16.rar"
'binaryToFile "E:\ocr\vbs\target_2.txt","test001_copy2.rar"
'MsgBox "finish"
'fileTo16And2

 

發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章