CHAT POSTE À POSTE ET MULTIPOSTES

Chat Poste à Poste :

unit Chat;
interface
uses  Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,
      Dialogs,StdCtrls,IdTCPServer,IdBaseComponent,IdComponent,Types,
      IdTCPConnection,IdTCPClient,Buttons,ComCtrls,ImgList,ExtCtrls,RxRichEd;
type
  TFormChat = class(TForm)
    Label1:TLabel;Adresse:TEdit;Label2:TLabel;PortCible:TEdit;Label4:TLabel;
    Message:TEdit;TcpClient:TIdTCPClient;TCPServer:TIdTCPServer;
    Label3:TLabel;Pseudo:TEdit;Connecter:TBitBtn;Deconnecter:TBitBtn;
    Liste:TImageList;
    Efface:TBitBtn;Chat:TRxRichEdit;
    procedure ConnecterClick(Sender:TObject);
    procedure DeconnecterClick(Sender:TObject);
    procedure MessageKeyPress(Sender:TObject;var Key:Char);
    procedure TCPServerConnect(AThread:TIdPeerThread);
    procedure TCPServerExecute(AThread:TIdPeerThread);
    procedure FormShow(Sender:TObject);
    procedure AdresseKeyPress(Sender:TObject;var Key:Char);
    procedure EffaceClick(Sender:TObject);
  end;
  TReceptionThread = class(TThread)
  protected
    procedure Execute;override;
  end;
var FormChat:TFormChat;ReceptionThread:TReceptionThread;Image:TBitMap;Flag:Boolean;
implementation
{$R *.dfm}
procedure TFormChat.EffaceClick(Sender:TObject);
begin
  Chat.Clear;
end;
procedure TFormChat.AdresseKeyPress(Sender:TObject;var Key:Char);
begin
  If (Key=#13) And (PortCible.Text<>'') And (Pseudo.Text<>'') Then
    ConnecterClick(Sender);
end;
procedure TFormChat.FormShow(Sender:TObject);
begin
  Pseudo.Text:=TcpClient.LocalName;
end;
procedure TReceptionThread.Execute;
var s:String;
begin
  while not Terminated do begin s:='';try s:=FormChat.TCPClient.ReadLn;
    except Terminate;end;FormChat.Chat.Lines.Add(S);end;
end;
procedure TFormChat.ConnecterClick(Sender:TObject);
begin
  if (FormChat.pseudo.Text='')                                                     
  then ShowMessage('Vous devez entrer un pseudo...')
  else with TCPClient do
    begin Host:=Adresse.Text;Port:=StrToInt(PortCible.Text);
      Connect;Connecter.Enabled:=False;
      ReceptionThread:=TReceptionThread.Create(False);Message.SetFocus;
    end;
end;
procedure TFormChat.DeconnecterClick(Sender:TObject);
begin
  TCPClient.Disconnect;Connecter.Enabled:=True;
end;
procedure TFormChat.MessageKeyPress(Sender:TObject;var Key:Char);
begin
  if (key=#13) then
  begin
    Chat.Lines.Add(Pseudo.Text +'> '+Message.Text);
    TCPClient.WriteLn(Pseudo.Text +'> '+ Message.Text);
    Message.Clear;
  end;
end;
procedure TFormChat.TCPServerConnect(AThread:TIdPeerThread);
begin
  with AThread.Connection do Writeln('Connexion établie ......');
end;
procedure TFormChat.TCPServerExecute(AThread:TIdPeerThread);
var s:String;
begin
 While Athread.Connection.Connected do
  begin s:=AThread.Connection.Readln;Chat.Lines.Add(S);End;
end;
End.


Chat Multi Postes - Serveur Dédié

Coté Serveur -
unit ServChat;
interface
uses
  Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,
  Dialogs,IdBaseComponent,IdComponent,IdTCPServer,ShellAPI,ExtCtrls,GIFImage;
type
  st200 = String[200];
  TFormChat = class(TForm)
    TcpServer:TIdTCPServer;Image:TImage;
    procedure TcpServerConnect(AThread:TIdPeerThread);
    procedure TcpServerExecute(AThread:TIdPeerThread);
    procedure FormActivate(Sender:TObject);
    procedure FormShow(Sender:TObject);
    procedure ImageClick(Sender:TObject);
  end;
var FormChat:TFormChat;repWin :String;
  Th:array[1..100] of TIdPeerThread;Pseudo:array[1..100] of String;
  NbThread:Integer;
implementation
{$R *.dfm}
{$R MyResource.res}
procedure TFormChat.TcpServerConnect(AThread:TIdPeerThread);
begin
  NbThread:=NbThread+1;
  Th[NbThread]:=AThread; { Mémorisation du Thread }
  AThread.Connection.Writeln('Connexion avec le serveur chat établie...');
end;
procedure TFormChat.TcpServerExecute(AThread:TIdPeerThread);
var s: String;
    i,j: Integer;
begin
  While Athread.Connection.Connected do
  begin
    s:=AThread.Connection.Readln;
    if s[1]='#' then
    begin
      Pseudo[NbThread]:=s;
      for i:=1 to NbThread do
      begin
        { Avertissement d'émission des pseudo }
        Th[i].Connection.Writeln('#');
        { Emission des pseudo }
        for j:=1 to NbThread do
          Th[i].Connection.WriteLn(Pseudo[j]);
      end
    end
    else for i:=1 to NbThread do
          Th[i].Connection.WriteLn(s);
  end;
end;
procedure TFormChat.FormActivate(Sender:TObject);
begin
  NbThread:=0; { Aucun Thread pour l'instant }
end;
procedure TFormChat.FormShow(Sender:TObject);
var GIF:TGIFImage;Res:TResourceStream;
begin
    include(GIFImageDefaultDrawOptions,goDirectDraw);
    Res:=TResourceStream.Create(hinstance,'Serveur','GIF');
    GIF:=TGIFImage.Create;GIF.LoadFromStream(Res);
    Image.Picture.Assign(GIF);GIF.Free;Res.Free;
  End;
procedure TFormChat.ImageClick(Sender:TObject);
begin
  Image.Picture.Graphic:=nil;Application.Terminate;
end;
end.


Coté Client -
unit CChat;
interface
uses
  Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,Dialogs,
  IdBaseComponent,IdComponent,IdTCPConnection,IdTCPClient,StdCtrls,ExtCtrls,Buttons,
  IdIPWatch;
type
  TFormChat = class(TForm)
    Hote:TEdit;PortCom:TEdit;Label1:TLabel;Label2:TLabel;
    Message:TEdit;Label3:TLabel;MessagesRecus:TMemo;TcpClient:TIdTCPClient;
    NomConnectes:TListBox;Label4:TLabel;Label5:TLabel;Pseudo:TEdit;Connexion:TBitBtn;
    Deconnexion:TBitBtn;IpW:TIdIPWatch;
    procedure ConnexionClick(Sender:TObject);
    procedure DeconnexionClick(Sender:TObject);
    procedure MessageKeyPress(Sender:TObject; var Key: Char);
    procedure SortieClick(Sender:TObject);
    procedure FormCreate(Sender:TObject);
    procedure HoteClick(Sender:TObject);
  end;
  TReceptionThread = class(TThread)
  private
  protected
    procedure Execute;override;
  end;
var FormChat:TFormChat;ReceptionThread :TReceptionThread;
implementation
{$R *.dfm}
procedure TFormChat.FormCreate(Sender:TObject);
begin
  Pseudo.Text:=TcpClient.LocalName;Text:=IpW.CurrentIP;
end;
procedure TReceptionThread.Execute;
var s:String;
begin
  while not Terminated do
  begin
    s:='';try s:=FormChat.TcpClient.ReadLn;except Terminate;end;
    if (s='#') then FormChat.NomConnectes.Clear
    else if (s[1]='#') and (length(s)>1) then FormChat.NomConnectes.Items.Add(s)
    else FormChat.MessagesRecus.Lines.Add(S);
  end;
end;
procedure TFormChat.ConnexionClick(Sender:TObject);
begin
  If (Pseudo.Text='') then ShowMessage('Entrez votre pseudo ...')
  else with TcpClient do
       begin IpW.Free;
         Host:=Hote.Text;Port:=StrToInt(PortCom.Text);Connect;
         Connexion.Enabled:=False;ReceptionThread:=TReceptionThread.Create(False);
         TcpClient.WriteLn('#'+Pseudo.Text); { Communication du pseudo }
       end;
end;
procedure TFormChat.DeconnexionClick(Sender:TObject);
begin
  TcpClient.Disconnect;Hote.Clear;Pseudo.Clear;Message.Clear;
  NomConnectes.Clear;MessagesRecus.Clear;Connexion.Enabled:=True;
end;
procedure TFormChat.MessageKeyPress(Sender:TObject;var Key:Char);
begin
  if (key=#13) then
  begin  TcpClient.WriteLn(Pseudo.Text + ' > ' + Message.Text);Message.Text:='';end;
end;
procedure TFormChat.SortieClick(Sender:TObject);
begin
	TcpClient.Disconnect;Application.Terminate;
end;
procedure TFormChat.HoteClick(Sender:TObject);
begin
  With Hote Do If Text='127.0.0.1' Then Text:=IpW.CurrentIP Else Text:='127.0.0.1';
end;
end.

Télécharger le zip