'文件读成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