Mega Code Archive
Irc server programı
<![CDATA[
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPServer, IdIrcServer;
type
TForm1 = class(TForm)
IdIRCServer1: TIdIRCServer;
Memo1: TMemo;
ListBox1: TListBox;
ListBox2: TListBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure IdIRCServer1Connect(AThread: TIdPeerThread);
procedure IdIRCServer1CommandUser(Thread: TIdPeerThread; UserName,
HostName, ServerName, RealName: String);
procedure IdIRCServer1CommandNick(Thread: TIdPeerThread; Parm1,
Parm2: String);
procedure IdIRCServer1CommandJoin(Thread: TIdPeerThread; Parm1,
Parm2: String);
procedure IdIRCServer1CommandPart(Thread: TIdPeerThread; Parm: String);
procedure IdIRCServer1CommandQuit(Thread: TIdPeerThread; Parm: String);
procedure IdIRCServer1CommandPrivMsg(Thread: TIdPeerThread; Parm1,
Parm2: String);
procedure IdIRCServer1CommandList(Thread: TIdPeerThread; Parm1,
Parm2: String);
procedure IdIRCServer1CommandWhoIs(Thread: TIdPeerThread; Parm1,
Parm2: String);
procedure IdIRCServer1CommandTime(Thread: TIdPeerThread; Parm: String);
procedure IdIRCServer1CommandUserHost(Thread: TIdPeerThread;
Parm: String);
procedure IdIRCServer1CommandVersion(Thread: TIdPeerThread;
Parm: String);
private
{ Private declarations }
public
{ Public declarations }
end;
type
BaglantiBilgisi =class(TObject)
DNS,UserName,Nick,ServerName,RealName :String;
BaglantiNo :Integer;
Thread :Pointer;
end;
type
Odalar =record
OdaAdi :String;
KullaniciSayisi:Integer;
Nickler :TList;
end;
var
Form1 :TForm1;
Baglantilar :TList;
Oda :Array[1..10] of Odalar;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var i:Integer;
begin
IdIRCServer1.DefaultPort:=6667;
IdIRCServer1.Active :=True;
for i:=1 to 10 do
begin
oda[i].OdaAdi:='-1';
oda[i].Nickler:=TList.Create;
end;
Baglantilar:=TList.Create;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var i:Integer;
begin
for i:=1 to 10 do
oda[i].Nickler.Free;
Baglantilar.Free;
end;
procedure TForm1.IdIRCServer1Connect(AThread: TIdPeerThread);
var Baglanti:BaglantiBilgisi;
begin
Memo1.Lines.Add('Connect ');
Baglanti :=BaglantiBilgisi.Create;
Baglanti.DNS :=AThread.Connection.Binding.PeerIP;
Baglanti.UserName :='-';
Baglanti.BaglantiNo:=ListBox1.Items.Count;
Baglanti.Thread :=AThread;
AThread.Data :=Baglanti;
Baglantilar.Add(Baglanti);
AThread.Connection.WriteLn('IRC Servera Hoş Geldiniz!');
end;
procedure TForm1.IdIRCServer1CommandUser(Thread: TIdPeerThread; UserName,
HostName, ServerName, RealName: String);
var baglanti:BaglantiBilgisi;
begin
Baglanti:=Pointer(Thread.Data);
Memo1.Lines.Add('user '+UserName+';'+HostName+';'+ServerName+';'+RealName);
Thread.Connection.WriteLn('Kullanıcı Adınız :'+UserName);
Thread.Connection.WriteLn('Host Adresiniz :'+HostName);
Thread.Connection.WriteLn('Server Adresiniz :'+ServerName);
Thread.Connection.WriteLn('Gerçek Adınız :'+RealName);
Baglanti.UserName :=UserName;
Baglanti.ServerName:=ServerName;
Baglanti.RealName :=RealName;
end;
procedure TForm1.IdIRCServer1CommandNick(Thread: TIdPeerThread; Parm1,
Parm2: String);
var baglanti,baglanti2 :BaglantiBilgisi;
nick :String;
begin
baglanti:=Pointer(Thread.Data);
nick :=Parm1;
Memo1.Lines.Add('CommandNick '+parm1+', '+parm2);
if copy(nick,1,1)=':' then //nick değişme işlemiyse
nick:=copy(parm1,2,100); //nickin 2.harfinden sonrasını al
if ListBox1.Items.IndexOf(nick)>=0 then //nick kullanımdaysa
Thread.Connection.WriteLn(':'+Baglanti.ServerName+' 433 '+Baglanti.Nick+' '+nick+' kullanımda. Başka bir nick seçin')
else
begin
if copy(parm1,1,1)=':' then //nick değiştirme işlemiyse
begin
ListBox1.Items[ListBox1.Items.IndexOf(Baglanti.Nick)]:=nick;
Thread.Connection.WriteLn(':'+Baglanti.Nick+'!'+Baglanti.UserName+'@'+Baglanti.DNS+' NICK :'+nick);
baglanti2 :=Pointer(baglantilar[baglanti.BaglantiNo]);
baglanti2.Nick:=nick;
end
else
begin
ListBox1.Items.Add(nick);
Thread.Connection.WriteLn(':'+Baglanti.Nick+'!'+Baglanti.UserName+'@'+Baglanti.DNS+' NICK :'+nick);
baglanti2 :=Pointer(baglantilar[baglanti.BaglantiNo]);
baglanti2.Nick:=nick;
end;
end;
end;
procedure TForm1.IdIRCServer1CommandJoin(Thread: TIdPeerThread; Parm1,
Parm2: String);
var i,j :Integer;
baglanti,baglanti2:BaglantiBilgisi;
nicks :String;
odavar,odaacildi :Boolean;
// list :TList;
begin
Baglanti:=Pointer(Thread.Data);
Memo1.Lines.Add('commandjoin '+parm1+','+parm2);
odavar:=false;
for i:=1 to 10 do
begin
if oda[i].OdaAdi=parm1 then
begin
odavar:=true;
oda[i].KullaniciSayisi:=oda[i].KullaniciSayisi+1;
oda[i].Nickler.Add(baglanti);
Thread.Connection.WriteLn(':'+Baglanti.Nick+'!'+Baglanti.UserName+'@'+Baglanti.DNS+' JOIN :'+parm1);
nicks:='';
//odadaki nickleri bul
for j:=0 to oda[i].Nickler.Count-1 do
begin
baglanti2:=Pointer(oda[i].Nickler.Items[j]);
nicks :=nicks+' '+baglanti2.nick;
end;
//odadaki nickleri gönder
Thread.Connection.WriteLn(':'+Baglanti.ServerName+' 353 '+Baglanti.Nick+' = '+parm1+' :'+nicks);
Thread.Connection.WriteLn(':'+Baglanti.ServerName+' 366 '+Baglanti.Nick+' '+parm1+' :End of /NAMES list.');
//odadaki diğer kullanıcılara bu girişi haber ver
for j:=0 to oda[i].Nickler.Count-1 do
begin
baglanti2:=Pointer(oda[i].Nickler.Items[j]);
TIdPeerThread(Baglanti2.Thread).Connection.WriteLn(':'+Baglanti.Nick+'!'+Baglanti.UserName+'@'+Baglanti.DNS+' JOIN :'+parm1);
end;
break;
end;
end;
odaacildi:=false;
if not odavar then
begin
for i:=1 to 10 do
begin
if oda[i].OdaAdi='-1' then //yeni oda
begin
oda[i].OdaAdi:=parm1;
odaacildi:=true;
oda[i].KullaniciSayisi:=1;
oda[i].Nickler.Add(baglanti);
Thread.Connection.WriteLn(':'+baglanti.Nick+'!'+baglanti.UserName+'@'+baglanti.DNS+' JOIN :'+parm1);
Thread.Connection.WriteLn(':'+baglanti.ServerName+' 353 '+baglanti.Nick+' = '+parm1+' :@'+baglanti.Nick);
Thread.Connection.WriteLn(':'+Baglanti.ServerName+' 366 '+baglanti.Nick+' '+parm1+' :End of NAMES list.');
ListBox2.Items.Add(parm1);
break;
end;
end;
end;
if not odaacildi then
Thread.Connection.WriteLn('En fazla 10 oda açılabilir.');
end;
procedure TForm1.IdIRCServer1CommandPart(Thread: TIdPeerThread;
Parm: String);
var
i,j :Integer;
baglanti,baglanti2 :BaglantiBilgisi;
begin
Memo1.Lines.Add('part '+parm);
Baglanti :=Pointer(Thread.Data);
for i:=1 to 10 do
begin
if oda[i].OdaAdi = parm then
begin
oda[i].KullaniciSayisi:=oda[i].KullaniciSayisi-1;
if oda[i].KullaniciSayisi=0 then //kimse kalmadıysa
begin
ListBox2.Items.Delete(ListBox2.Items.IndexOf(parm));
oda[i].OdaAdi:='-1';
end;
//odadaki diğer kullanıcılara bu çıkışı haber ver
for j:=0 to oda[i].Nickler.Count-1 do
begin
baglanti2:=Pointer(oda[i].Nickler.Items[j]);
TIdPeerThread(Baglanti2.Thread).Connection.WriteLn(':'+Baglanti.Nick+'!'+baglanti.UserName+'@'+baglanti.DNS+' PART :'+parm);
end;
oda[i].Nickler.Remove(baglanti);
end;
end;
end;
procedure TForm1.IdIRCServer1CommandQuit(Thread: TIdPeerThread;
Parm: String);
var
i,j,k :Integer;
Baglanti,Baglanti2 :BaglantiBilgisi;
begin
Memo1.Lines.Add('quit '+parm);
baglanti :=Pointer(Thread.Data);
Baglantilar.Remove(Baglanti);
Thread.Connection.Disconnect;
//bağlı olduğu odalara çıkışını bildir.
for i:=1 to 10 do
begin
if oda[i].OdaAdi<>'-1' then
begin
for k:=0 to oda[i].Nickler.Count-1 do
begin
if k=oda[i].Nickler.Count then break;
baglanti2:=Pointer(oda[i].Nickler.Items[k]);
if baglanti2.Nick=baglanti.Nick then //bu odada varsa
begin
oda[i].KullaniciSayisi:=oda[i].KullaniciSayisi-1;
oda[i].Nickler.Remove(Baglanti);
if oda[i].KullaniciSayisi=0 then //kimse kalmadıysa
begin
ListBox2.Items.Delete(ListBox2.Items.IndexOf(oda[i].OdaAdi));
oda[i].OdaAdi:='-1';
end;
//odadaki diğer kullanıcılara çıkışı haber ver
if oda[i].KullaniciSayisi>0 then
for j:=0 to oda[i].Nickler.Count-1 do
begin
baglanti2:=Pointer(oda[i].Nickler.Items[j]);
TIdPeerThread(Baglanti2.Thread).Connection.WriteLn(':'+Baglanti.Nick+'!'+Baglanti.UserName+'@'+Baglanti.DNS+' QUIT :'+parm);
end;
end;
end;
end;
end;
ListBox1.Items.Delete(ListBox1.Items.IndexOf(Baglanti.Nick));
Baglanti.Free;
Thread.Data:=nil;
end;
procedure TForm1.IdIRCServer1CommandPrivMsg(Thread: TIdPeerThread; Parm1,
Parm2: String);
var
i,j :Integer;
baglanti,baglanti2 :BaglantiBilgisi;
begin
Memo1.Lines.Add('privmsg '+parm1+';'+parm2);
baglanti:=Pointer(Thread.Data);
if copy(parm1,1,1)='#' then //mesaj odayaysa
begin
for i:=1 to 10 do
begin
if oda[i].OdaAdi=parm1 then
begin
//odadaki diğer kullanıcılara mesaj gönder
for j:=0 to oda[i].Nickler.Count-1 do
begin
baglanti2:=Pointer(oda[i].Nickler.Items[j]);
if baglanti2.Nick<>Baglanti.Nick then //kendisine gönderme
TIdPeerThread(Baglanti2.Thread).Connection.WriteLn(':'+Baglanti.Nick+'!'+Baglanti.UserName+'@'+Baglanti.DNS+' PROVMSG '+parm1+' '+parm2);
end;
end;
end;
end
else //mesaj nickeyse
begin
for i:=0 to baglantilar.Count-1 do
begin
baglanti2 :=Pointer(Baglantilar[i]);
if baglanti2.Nick=parm1 then
TIdPeerThread(Baglanti2.Thread).Connection.WriteLn(':'+Baglanti.Nick+'!'+Baglanti.UserName+'@'+Baglanti.DNS+' PRIVMSG '+parm1+' '+parm2);
end;
end;
end;
procedure TForm1.IdIRCServer1CommandList(Thread: TIdPeerThread; Parm1,
Parm2: String);
var
i :Integer;
Baglanti :BaglantiBilgisi;
begin
baglanti:=Pointer(Thread.Data);
Thread.Connection.WriteLn(':'+Baglanti.ServerName+' 331 '+Baglanti.Nick+' Channel :User Name');
for i:=1 to 10 do
if oda[i].OdaAdi<>'-1' then
Thread.Connection.WriteLn(':'+Baglanti.ServerName+' 322 '+baglanti.Nick+' '+oda[i].OdaAdi+' '+IntToStr(oda[i].KullaniciSayisi));
Thread.Connection.WriteLn(':'+Baglanti.ServerName+' 323 '+baglanti.Nick+' :End of /LIST');
Memo1.Lines.Add('list '+parm1+';'+parm2);
end;
procedure TForm1.IdIRCServer1CommandWhoIs(Thread: TIdPeerThread; Parm1,
Parm2: String);
var
i,j,k :Integer;
baglanti,baglanti2,baglanti3 :BaglantiBilgisi;
odalar :String;
begin
Memo1.Lines.Add('whois '+parm1+';'+parm2);
baglanti3:=Pointer(Thread.Data);
odalar:='';
for k:=0 to baglantilar.Count-1 do
begin
baglanti :=Pointer(Baglantilar[k]);
if baglanti.Nick=parm1 then //whois istenen nick buysa
begin
//hangi odalarda olduğunu bul
for i:=1 to 10 do
begin
if oda[i].OdaAdi<>'-1' then //bu oda açıksa
begin
for j:=0 to oda[i].Nickler.Count-1 do
begin
baglanti2:=Pointer(oda[i].Nickler.Items[j]);
if baglanti2.Nick=baglanti.Nick then //bu odada varsa
odalar:=odalar+' '+oda[i].OdaAdi;
end;
end;
end;
TIdPeerThread(baglanti3.Thread).Connection.WriteLn(':'+Baglanti.ServerName+' 311 '+Baglanti.UserName+' '+Baglanti.Nick+' '+Baglanti.UserName+'@'+Baglanti.DNS);
TIdPeerThread(baglanti3.Thread).Connection.WriteLn(':'+Baglanti.ServerName+' 319 '+Baglanti.UserName+' '+Baglanti.Nick+':'+odalar);
TIdPeerThread(baglanti3.Thread).Connection.WriteLn(':'+Baglanti.ServerName+' 312 '+Baglanti.UserName+' '+Baglanti.Nick+' '+Baglanti.ServerName);
TIdPeerThread(baglanti3.Thread).Connection.WriteLn(':'+Baglanti.ServerName+' 318 '+Baglanti.UserName+' '+Baglanti.Nick+' :End of WHOIS list.');
break;
end;
end;
end;
procedure TForm1.IdIRCServer1CommandTime(Thread: TIdPeerThread;
Parm: String);
var baglanti:BaglantiBilgisi;
begin
Memo1.Lines.Add('time '+parm);
Baglanti:=Pointer(Thread.Data);
TIdPeerThread(Baglanti.Thread).Connection.WriteLn(':'+Baglanti.ServerName+' 391 '+Baglanti.Nick+' '+Baglanti.ServerName+' :'+DateTimeToStr(Now()));
end;
procedure TForm1.IdIRCServer1CommandUserHost(Thread: TIdPeerThread;
Parm: String);
var
baglanti,baglanti2 :BaglantiBilgisi;
k :Integer;
begin
Memo1.Lines.Add('userhost '+parm);
Baglanti:=Pointer(Thread.Data);
for k:=0 to Baglantilar.Count-1 do
begin
baglanti2:=Pointer(Baglantilar[k]);
if baglanti2.Nick=parm then //hostu istenen nick buysa
begin
TIdPeerThread(Baglanti.Thread).Connection.WriteLn(':'+Baglanti2.Nick+'=+'+Baglanti2.DNS);
break;
end;
end;
end;
procedure TForm1.IdIRCServer1CommandVersion(Thread: TIdPeerThread;
Parm: String);
var baglanti :BaglantiBilgisi;
begin
Memo1.Lines.Add('version '+parm);
Baglanti:=Pointer(Thread.Data);
TIdPeerThread(Baglanti.Thread).Connection.WriteLn(':'+Baglanti.ServerName+' 351 '+Baglanti.Nick+' Heavy IRC Server 1.0');
end;
end.
]]>