Delphi 간단 채팅 프로그램

이번주에 이직을 위한 온라인 과제 테스트가 있는데

이게 나올 거 같은 느낌이 들어서

대강 만들어 보았다.

 

- Server(indyTCPServer 사용)

 

unit fchattingServerMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, IdBaseComponent, IdComponent,
  IdCustomTCPServer, IdTCPServer, Vcl.StdCtrls, IdContext;

type
  TForm2 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    IdTCPServer1: TIdTCPServer;
    Memo1: TMemo;
    Label1: TLabel;
    Edit1: TEdit;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure IdTCPServer1Connect(AContext: TIdContext);
    procedure IdTCPServer1Disconnect(AContext: TIdContext);
    procedure IdTCPServer1Execute(AContext: TIdContext);
    procedure IdTCPServer1Status(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: string);
    procedure Button3Click(Sender: TObject);
  private
    m_nCount : Integer;
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

uses
  IdSocketHandle, IdThreadComponent;

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
begin
  m_nCount := 0;
  Memo1.Lines.Clear;
  IdTCPServer1.Bindings.Clear;
  IdTCPServer1.Bindings.Add.Port := 9999;
  IdTCPServer1.Active := True;
  Memo1.Lines.Add('Start Listening');
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
  IdTCPServer1.Active := False;
  Memo1.Lines.Add('End Listening');
end;

procedure TForm2.Button3Click(Sender: TObject);
var
  str : AnsiString;
  i : Integer;
  AContext: TIdContext;
  ContextList : TList;
begin
  str := Format('%s', [Edit1.Text]);
  ContextList := IdTCPServer1.Contexts.LockList;
  for i := 0 to ContextList.Count - 1 do
  begin
    AContext := ContextList.Items[i];
    AContext.Connection.IOHandler.WriteLn(str);
  end;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  IdTCPServer1.DefaultPort := 9999;
end;

procedure TForm2.IdTCPServer1Connect(AContext: TIdContext);
var
  str, str2 : AnsiString;
begin
  str := Format('IP : %s, Port : %d Accept!', [AContext.Binding.IP, AContext.Binding.Port]);
  Memo1.Lines.Add(str);
  Inc(m_nCount);
  Label1.Caption := 'User Count : ' + InttoStr(m_nCount);
  str2 := Format('Welcome %d', [m_nCount]);
  AContext.Connection.IOHandler.WriteLn(str2);
end;

procedure TForm2.IdTCPServer1Disconnect(AContext: TIdContext);
var
  str : AnsiString;
begin
  str := Format('IP : %s, Port : %d Leave!', [AContext.Binding.IP, AContext.Binding.Port]);
  Memo1.Lines.Add(str);
  Dec(m_nCount);
  Label1.Caption := 'User Count : ' + InttoStr(m_nCount);
end;

procedure TForm2.IdTCPServer1Execute(AContext: TIdContext);
var
  strMessage, strReceiveMsg : AnsiString;
begin
  if not AContext.Connection.Connected then
    exit;

  strMessage := AContext.Connection.IOHandler.ReadLn();
  if strMessage <> '' then
  begin
    TThread.Queue(nil,  procedure
                        begin
                          strReceiveMsg := Format('IP : %s, Port : %d, Message : %s', [AContext.Binding.IP, AContext.Binding.Port, strMessage]);
                          Memo1.Lines.Add(strReceiveMsg);
                        end);

  end;
end;

procedure TForm2.IdTCPServer1Status(ASender: TObject; const AStatus: TIdStatus;
  const AStatusText: string);
begin
//
end;

end.

 

- Client(IndyTCPClient 사용)

 

unit ChattingClientMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, IdBaseComponent,
  IdComponent, IdTCPConnection, IdTCPClient, IdThreadComponent;

type
  TForm2 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    Button2: TButton;
    Edit3: TEdit;
    Button3: TButton;
    IdTCPClient1: TIdTCPClient;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button2Click(Sender: TObject);
    procedure IdTCPClient1Connected(Sender: TObject);
    procedure IdTCPClient1Disconnected(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    m_idThreadComponent : TIdThreadComponent;
    procedure IdThreadComponentRun(Sender: TIdThreadComponent);
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
begin
  if IdTCPClient1.Connected then
    IdTCPClient1.Disconnect;

  IdTCPClient1.Host := Edit1.Text;
  IdTCPClient1.Port := StrToIntDef(Edit2.Text, 9999);
  try
    IdTCPClient1.Connect;
  except
    on E: Exception do
      Memo1.Lines.Add(Format('CONNECTION ERROR! %s', [E.Message]));
  end;
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
//  if IdTCPClient1.Connected then
//    IdTCPClient1.Disconnect;
end;

procedure TForm2.Button3Click(Sender: TObject);
begin
  IdTCPClient1.IOHandler.WriteLn(Edit3.Text);
end;

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if m_idThreadComponent.Active then
    m_idThreadComponent.Active := False;

  FreeAndNil(m_idThreadComponent);
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  m_idThreadComponent := TIdThreadComponent.Create();
  m_idThreadComponent.OnRun := IdThreadComponentRun;
end;

procedure TForm2.IdTCPClient1Connected(Sender: TObject);
begin
  Memo1.Lines.Add(Format('Connected!', []));
  m_IdThreadComponent.Active  := True;
end;

procedure TForm2.IdTCPClient1Disconnected(Sender: TObject);
begin
  Memo1.Lines.Add(Format('DisConnected!', []));
end;

procedure TForm2.IdThreadComponentRun(Sender: TIdThreadComponent);
var
  msgFromServer : String;
begin
  if not IdTCPClient1.Connected then
    exit;

  if IdTCPClient1.IOHandler.Connected then
  begin
    msgFromServer := IdTCPClient1.IOHandler.ReadLn();
    Memo1.Lines.Add(Format('%s', [msgFromServer]));
  end;
end;

end.

 

실행 결과는 대강 이렇다. 참고로 델파이 XE 이상부터 가능한 소스다.

Delphi7의 경우엔 콜백의 파라미터 값들이 다 다르다..