Chat poste à poste et multipostes

Télécharger le projet
Commenter

Description

Chat par TCP :

1 - Chat Poste à Poste
2 - Chat MultiPostes par serveur dédié

Source / Exemple : 


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.

Conclusion :


Utilisation RxTRichEdit de Rx Library 2.75 pour les programmes
ainsi que de l'unité GIFIMAGE.PAS de Source.forge.net

Ces unités sont transférables depuis mon site Http://paounet.free.fr
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_Paounet)