Baktım Indy ile ornek forumda çok az. Güzel bir şey ekliyeyim dedim.
Saygılar
************************************************
Aşağıdaki dosyayı "MicroCHAT.dpr" olarak kaydedin
Kod: Tümünü seç
program MicroCHAT;
//Coder: Ahmet CEYLAN (MicroChip)
uses
Forms,
form01 in 'form01.pas' {Form1};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Aşağıdaki dosyayı "form01.dfm" olarak kaydedin
Kod: Tümünü seç
object Form1: TForm1
Left = 222
Top = 108
BorderStyle = bsSingle
Caption = 'MicroCHAT v.1.0'
ClientHeight = 323
ClientWidth = 465
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 136
Top = 8
Width = 60
Height = 13
Caption = 'Kullanıcı Adı:'
end
object Label2: TLabel
Left = 256
Top = 8
Width = 66
Height = 13
Caption = 'Server Adresi:'
end
object Label3: TLabel
Left = 400
Top = 7
Width = 39
Height = 13
Caption = 'Port No:'
end
object Label4: TLabel
Left = 136
Top = 69
Width = 42
Height = 13
Caption = 'Mesajlar:'
end
object Label5: TLabel
Left = 136
Top = 260
Width = 39
Height = 13
Caption = 'Mesajın:'
end
object labeldns: TLabel
Left = 512
Top = 336
Width = 39
Height = 13
Caption = 'labeldns'
end
object labelsocketver: TLabel
Left = 512
Top = 360
Width = 69
Height = 13
Caption = 'labelsocketver'
end
object Edit2: TEdit
Left = 256
Top = 21
Width = 137
Height = 21
TabOrder = 0
Text = 'localhost'
end
object Edit3: TEdit
Left = 400
Top = 21
Width = 57
Height = 21
TabOrder = 1
Text = '23'
end
object listclients: TListBox
Left = 8
Top = 8
Width = 121
Height = 287
ItemHeight = 13
PopupMenu = PopupMenu1
TabOrder = 2
end
object Memo1: TMemo
Left = 136
Top = 83
Width = 321
Height = 174
ScrollBars = ssVertical
TabOrder = 3
end
object Edit4: TEdit
Left = 136
Top = 274
Width = 321
Height = 21
TabOrder = 4
OnKeyPress = Edit4KeyPress
end
object butonbaglan: TBitBtn
Left = 400
Top = 48
Width = 57
Height = 21
Caption = 'Bağlan'
TabOrder = 5
OnClick = butonbaglanClick
end
object Memo2: TMemo
Left = 504
Top = 240
Width = 185
Height = 89
Lines.Strings = (
'/help=Here are the EMotes: /grin, '
'/lol, /kiss, /rose'
'/grin=%s grins.'
'/lol=%s Laughs out loud.'
'/kiss=%s blows everyone a big kiss.'
'/rose=A @--'#39'--- for you from %s.')
TabOrder = 6
end
object durum: TfcStatusBar
Left = 0
Top = 303
Width = 465
Height = 20
Panels = <
item
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Name = 'Panel0'
Tag = 0
TextOptions.Alignment = taLeftJustify
TextOptions.VAlignment = vaVCenter
Width = '270'
end
item
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Name = 'Panel1'
Tag = 0
TextOptions.Alignment = taCenter
TextOptions.VAlignment = vaVCenter
Width = '100'
end
item
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Name = 'Panel2'
Style = psDateTime
Tag = 0
Text = '05.05.2005 03:02'
TextOptions.Alignment = taCenter
TextOptions.VAlignment = vaVCenter
Width = '50'
end>
SimplePanel = False
SizeGrip = False
StatusBarText.CapsLock = 'Caps'
StatusBarText.Overwrite = 'Overwrite'
StatusBarText.NumLock = 'Num'
StatusBarText.ScrollLock = 'Scroll'
end
object Memo3: TMemo
Left = 504
Top = 40
Width = 185
Height = 193
Lines.Strings = (
'Memo3')
TabOrder = 8
end
object Edit1: TEdit
Left = 135
Top = 21
Width = 114
Height = 21
MaxLength = 15
TabOrder = 9
end
object rad01: TRadioButton
Left = 259
Top = 50
Width = 65
Height = 17
Caption = 'Sunucu'
TabOrder = 10
end
object rad02: TRadioButton
Left = 328
Top = 50
Width = 65
Height = 17
Caption = 'İstemci'
Checked = True
TabOrder = 11
TabStop = True
end
object client: TIdTCPClient
MaxLineAction = maException
RecvBufferSize = 8192
OnConnected = clientConnected
Port = 0
Left = 40
Top = 160
end
object server: TIdTCPServer
Bindings = <
item
Port = 23
end>
CommandHandlers = <>
DefaultPort = 0
Greeting.NumericCode = 0
MaxConnectionReply.NumericCode = 0
OnConnect = serverConnect
OnExecute = serverExecute
OnDisconnect = serverDisconnect
ReplyExceptionCode = 0
ReplyTexts = <>
ReplyUnknownCommand.NumericCode = 0
ThreadMgr = IdThreadMgrDefault1
Left = 40
Top = 128
end
object IdThreadMgrDefault1: TIdThreadMgrDefault
Left = 72
Top = 128
end
object Timer1: TTimer
Interval = 500
OnTimer = Timer1Timer
Left = 72
Top = 160
end
object MainMenu1: TMainMenu
Left = 40
Top = 88
object Men1: TMenuItem
Caption = 'Menü'
object ProgramHakknda1: TMenuItem
Caption = 'Program Hakkında'
end
object k1: TMenuItem
Caption = 'Çıkış'
end
end
end
object PopupMenu1: TPopupMenu
Left = 72
Top = 88
object Yenile1: TMenuItem
Caption = 'Listeyi Yenile'
OnClick = Yenile1Click
end
object ChattenDarAt1: TMenuItem
Caption = 'Chat'#39'ten Dışarı At'
Visible = False
OnClick = ChattenDarAt1Click
end
end
end
Aşağıdaki dosyayı "form01.pas" olarak kaydedin
Kod: Tümünü seç
unit form01;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdTCPServer, IdThreadMgr, IdThreadMgrDefault, ExtCtrls, Buttons,
fcStatusBar, ComCtrls, ToolWin, ImgList, Menus, WinSkinData;
type
TSimpleClient = class(TObject)
DNS,
Name : String;
ListLink : Integer;
Thread : Pointer;
end;
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Edit2: TEdit;
Label3: TLabel;
Edit3: TEdit;
listclients: TListBox;
Memo1: TMemo;
Edit4: TEdit;
Label4: TLabel;
Label5: TLabel;
client: TIdTCPClient;
server: TIdTCPServer;
IdThreadMgrDefault1: TIdThreadMgrDefault;
Timer1: TTimer;
butonbaglan: TBitBtn;
Memo2: TMemo;
labeldns: TLabel;
labelsocketver: TLabel;
durum: TfcStatusBar;
Memo3: TMemo;
MainMenu1: TMainMenu;
Men1: TMenuItem;
Edit1: TEdit;
rad01: TRadioButton;
rad02: TRadioButton;
k1: TMenuItem;
PopupMenu1: TPopupMenu;
Yenile1: TMenuItem;
ChattenDarAt1: TMenuItem;
ProgramHakknda1: TMenuItem;
procedure Edit4KeyPress(Sender: TObject; var Key: Char);
procedure Timer1Timer(Sender: TObject);
procedure clientConnected(Sender: TObject);
procedure butonbaglanClick(Sender: TObject);
procedure serverConnect(AThread: TIdPeerThread);
procedure serverDisconnect(AThread: TIdPeerThread);
procedure serverExecute(AThread: TIdPeerThread);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure Yenile1Click(Sender: TObject);
procedure ChattenDarAt1Click(Sender: TObject);
private
{ Private declarations }
public
Clients : TList;
procedure BroadcastMessage( WhoFrom, TheMessage : String );
procedure UpdateClientList;
procedure UpdateBindings;
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses IdSocketHandle;
{$R *.DFM}
procedure TForm1.UpdateBindings;
var
Binding : TIdSocketHandle;
begin
Server.DefaultPort := strtoint(edit3.text);
Server.Bindings.Clear;
Binding := Server.Bindings.Add;
Binding.Port := strtoint(edit3.text);
end;
procedure TForm1.Edit4KeyPress(Sender: TObject; var Key: Char);
begin
if key = #13 then
begin
client.WriteLn(edit4.Text);
edit4.Text := '';
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
Com,
Msg : String;
begin
if not client.Connected then exit;
labelDNS.Caption := Server.LocalName;
Msg := client.ReadLn('', 5);
if UpperCase(Trim(Copy(Msg, Pos(':', Msg) +1, Length(Msg)))) = 'DEGIS' then
begin
Yenile1.Click;
Msg := client.ReadLn('', 5);
end;
if Msg <> '' then
if (Msg[1] <> '@') then
begin
{ Not a system command }
memo1.Lines.Add(Msg);
end
else
begin
{ System command }
Com := UpperCase(Trim(Copy(Msg, 2, Pos(':', Msg) -2)));
Msg := UpperCase(Trim(Copy(Msg, Pos(':', Msg) +1, Length(Msg))));
if (Com = 'CLIENTS') then
begin
listClients.Items.CommaText := Msg;
durum.Panels[0].text:='Yönetici: '+listclients.Items.Strings[0];
end;
end;
end;
procedure TForm1.clientConnected(Sender: TObject);
begin
Client.WriteLn(edit1.text);
Client.WriteLn('DEGIS');
//Yenile1.Click;
end;
procedure TForm1.butonbaglanClick(Sender: TObject);
begin
if trim(edit1.text)='' then
begin
showmessage('Kullanıcı adını yazmamışsınız...');
exit;
end;
client.Host := edit2.text;
client.Port := strtoint(edit3.text);
if rad02.Checked then
begin
try
client.Connect;
except
showmessage('Bağlanmak istediğiniz sunucu bulunamadı...');
exit;
end;
end;
if rad01.checked then
begin
server.active:=true;
client.connect;
ChattenDarAt1.visible:=true;
end;
end;
procedure TForm1.serverConnect(AThread: TIdPeerThread);
var
Clientalt : TSimpleClient;
begin
AThread.Connection.WriteLn('MicroCHAT''e bağlanıyorsunuz...');
AThread.Connection.WriteLn('Lütfen bekleyiniz...');
//AThread.Connection.WriteLn('İsminiz:');
Clientalt := TSimpleClient.Create;
Clientalt.DNS := AThread.Connection.LocalName;
Clientalt.Name := 'Logging In';
Clientalt.ListLink := listClients.Items.Count;
Clientalt.Thread := AThread;
listClients.Items.Add(Clientalt.Name);
AThread.Data := Clientalt;
Clients.Add(Clientalt);
end;
procedure TForm1.serverDisconnect(AThread: TIdPeerThread);
var
Clientalt : TSimpleClient;
begin
Clientalt := Pointer(AThread.Data);
Clients.Delete(Clientalt.ListLink);
listClients.Items.Delete(listClients.Items.IndexOf(Clientalt.Name));
BroadcastMessage('System', Clientalt.Name + ' sohbetten ayrıldı.');
Clientalt.Free;
AThread.Data := nil;
Client.WriteLn('DEGIS');
end;
procedure TForm1.BroadcastMessage( WhoFrom, TheMessage : String );
var
Count: Integer;
List : TList;
EMote,
Msg : String;
begin
Msg := Trim(TheMessage);
EMote := Trim(memo2.Lines.Values[Msg]);
if WhoFrom <> 'System' then
Msg := WhoFrom + ': ' + Msg;
if EMote <> '' then
Msg := Format(Trim(EMote), [WhoFrom]);
List := Server.Threads.LockList;
try
for Count := 0 to List.Count -1 do
try
TIdPeerThread(List.Items[Count]).Connection.WriteLn(Msg);
except
TIdPeerThread(List.Items[Count]).Stop;
end;
finally
Server.Threads.UnlockList;
end;
end;
procedure TForm1.UpdateClientList;
var
Count : Integer;
begin
for Count := 0 to listClients.Items.Count -1 do
if Count < Clients.Count then
listClients.Items.Strings[Count] := TSimpleClient(Clients.Items[Count]).Name;
end;
procedure TForm1.serverExecute(AThread: TIdPeerThread);
var
Client : TSimpleClient;
Com, // System command
Msg : String;
begin
Msg := AThread.Connection.ReadLn; //showmessage(msg);
Client := Pointer(AThread.Data);
if Client.Name = 'Logging In' then
begin
Client.Name := Msg;
UpdateClientList;
BroadcastMessage('System', Msg + ' şu an sohbette.');
//AThread.Connection.WriteLn(memo1.Lines.Text); //server sürümünde olacak sadece
end
else
if Msg[1] <> '@' then
begin
BroadcastMessage(Client.Name, Msg);
end
else
begin
{ System command }
Com := UpperCase(Trim(Copy(Msg, 2, Pos(':', Msg) -2)));
Msg := UpperCase(Trim(Copy(Msg, Pos(':', Msg) +1, Length(Msg))));
if Com = 'CLIENTS' then
AThread.Connection.WriteLn( '@' + 'clients:' +
listClients.Items.CommaText);
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if (Clients.Count > 1) and (Server.Active) then
begin
Action := caNone;
ShowMessage('Server''a bağlı kişiler olduğu sürece MicroCHAT''i kapatamazsınız...');
end
else
Clients.Free;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Clients := TList.Create;
UpdateBindings;
labelDNS.Caption := Server.LocalName;
labelSocketVer.Caption := Server.Version;
end;
procedure TForm1.Yenile1Click(Sender: TObject);
begin
Client.WriteLn('@' + 'CLIENTS:REQUEST');
end;
procedure TForm1.ChattenDarAt1Click(Sender: TObject);
var
Msg : String;
Client : TSimpleClient;
begin
Msg := InputBox('Dışarı Atma Mesajınız', 'Kullanıcıyı attığınız zaman göreceği mesajınız:', '');
Msg := Trim(Msg);
Msg := edit1.text + '> ' + Msg;
if (Msg <> '') and
(listclients.ItemIndex <> -1) then
begin
Client := Clients.Items[listClients.ItemIndex];
TIdPeerThread(Client.Thread).Connection.WriteLn(Msg);
TIdPeerThread(Client.Thread).Connection.Disconnect;
Clients.Delete(listClients.ItemIndex);
listClients.Items.Delete(listClients.ItemIndex);
end;
end;
end.