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

标签: , , ,

之前陆续写过一些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: http://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: http://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

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

随机文章:

  1. 隐藏系统托盘图标的小程序TrayHider
  2. 用VBS创建环境变量
  3. 配置OpenWrt防止3DS自动升级
  4. 用C语言实现PHP的urlencode函数
  5. 用LinuxLive USB Creator创建Linux启动盘

留下回复