Chat poste à poste et multipostes

Soyez le premier à donner votre avis sur cette source.

Vue 11 474 fois - Téléchargée 2 364 fois

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

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
13
Date d'inscription
mercredi 29 novembre 2006
Statut
Membre
Dernière intervention
14 mai 2009

Hmm un pti bug a la connexion/ deconnexion pui connexion du client, je cherche pour eviter se bug, si qqun a une idée dite le
Messages postés
14
Date d'inscription
samedi 14 octobre 2006
Statut
Membre
Dernière intervention
4 juin 2008

Bisoir,

C'est exactement ce que je chercher, mais ( parcequ'il ya un mais), je peux pas dutout le lire ce code. Avec quel logiciel tu la coder ?

Mon intention et de le porter sur une interface graphic gerer par C++Builder 6 auquel je me suis familiarisé. Je t'envéré le resultat si je peux toutes fois lire le code :)

! mouchi !
Messages postés
8
Date d'inscription
vendredi 14 juin 2002
Statut
Membre
Dernière intervention
10 août 2006

Bonjour.

Ce code est simple et facile à utiliser, il peut intégrer assès facilement une autre application : Super!

Pour l'instant je n'ai testé que le P2P, mais je compte bien tester le Client/Serveur. Si jamais je fais des modifications/améliorations, je transmets...

++
Messages postés
6
Date d'inscription
samedi 16 juillet 2005
Statut
Membre
Dernière intervention
14 février 2006

cooooooooooooool sa si q je cherche !!!!
tenks men.

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.