Demon's Blog » 程序设计 » 用VBS处理二进制文件的实例

用VBS处理二进制文件的实例

标题: 用VBS处理二进制文件的实例
作者: Demon
链接: https://demon.tw/programming/vbs-binary-file-example.html
版权: 本博客的所有文章，都遵守“署名-非商业性使用-相同方式共享 2.5 中国大陆”协议条款。

之前陆续写过一些VBS和二进制文件有关的文章，包括但不限于：

但是里面的例子都是为了举例而写的，没有什么实际用途。这次就以昨天《“画蛇添足”的Python》里加密文件的解密为例写个稍微有点实际意义的程序吧。

被加密的文件我就不贴出来了，昨天的文章里面有下载地址。首先看看昨天写的没有经过任何优化的洗完澡回来还没有运行完的VBS：

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
    Set node = Nothing
    Set xmldom = Nothing
End Function

Sub WriteBinary(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 Sub

'Author: Demon
'Website: https://demon.tw
'Date: 2011/4/19

str = ReadBinary("A768.neu")
length = Len(str)
out = ""
For i = 1 To length
    c = Mid(str, i, 1)
    Select Case c
        Case "1"    out = out & "C"
        Case "2"    out = out & "F"
        Case "3"    out = out & "E"
        Case "4"    out = out & "9"
        Case "5"    out = out & "8"
        Case "6"    out = out & "B"
        Case "7"    out = out & "A"
        Case "8"    out = out & "5"
        Case "9"    out = out & "4"
        Case "0"    out = out & "D"
        Case "A"    out = out & "7"
        Case "B"    out = out & "6"
        Case "C"    out = out & "1"
        Case "D"    out = out & "0"
        Case "E"    out = out & "3"
        Case "F"    out = out & "2"
    End Select
Next

WriteBinary "slow.bin", out

这段VBS是根据那个人给我的Python改写的，以Python的运行效率，这样写当然没有问题，但是如果VBS也这么写，会慢得让人无法忍受。

我之前多次强调过，像这样直接用字符串函数处理一个很长的字符串，效率是非常非常低的，应该改用数组来实现。而select case部分的条件语句也是完全没有必要的，用一个数组构造一个映射表即可，这在C语言中是很常见的。

'Author: Demon
'Website: https://demon.tw
'Email: 380401911@qq.com
Dim table
table = Array("D", "C", "F", "E", "9", "8", "B", "A", "5", "4", "7", "6", "1", "0", "3", "2")
Dim ado
Set ado = CreateObject("ADODB.Stream")
ado.Type = 1 : ado.Open
ado.LoadFromFile "A768.neu"
length = ado.Size * 2 - 1
Dim arr() : ReDim arr(length)
For i = 0 To length Step 2
    c = CByte(AscB(ado.Read(1)))
    l = c And &H0F
    h = (c And &HF0) \ (2 ^ 4)
    arr(i) = table(h)
    arr(i+1) = table(l)
Next
ado.Close

str = Join(arr, "")
WriteBinary "vbs.bin", str

Sub WriteBinary(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 Sub

这是我知道的效率最高的写法，如果你有更好的代码，请不吝赐教。

赞赏

微信赞赏支付宝赞赏

随机文章:

这篇文章发布于 2011年04月18日，星期一，22:02，归类于程序设计。您可以跟踪这篇文章的评论通过 RSS 2.0 feed。您可以留下评论，或者从您的站点trackback。

用VBS处理二进制文件的实例

留下回复