|
Trouver une ressource
Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !
CHAT POSTE À POSTE ET MULTIPOSTES
Information sur la source
Description
Chat par TCP : 1 - Chat Poste à Poste 2 - Chat MultiPostes par serveur dédié
Source
- 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.
-
-
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
Fichier Zip
Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !
Télécharger le zip
Sources du même auteur
Sources de la même categorie
Sources en rapport avec celle ci
Commentaires et avis
Discussions en rapport avec ce code source dans le forum
petit Client pour chatter [ par skrypterz ]
Salut tous le monde et bonne année en passent,Je me fait un petit Client pour chatter tous en restant hors des fenetre Explorer:PJ'aimerais savoi
chat vocal avec delphi [ par laysamy ]
slt tt le monde, si qlq 1 sé comment réaliser une application de chat vocal avec delphi (s'il ya des composants spéciales par exemple)
jeu multijoueur [ par aureliensm ]
Bonjour a tous.J'ai grandement besoin de votre aide. Je suis en train de realiser un rpg en multijoueur. Pour mon jeu , j'ai deja realise un chat incl
impression quick report [ par hammid95 ]
j'a un problème d'impression avec quick report delphi 5 :l'impression fonctionne correctement sur mon poste de développement, tandisque ça ne fonction
Probleme CHAT [ICS-UDP] [ par fiascoco ]
Voila, alors j'ai un probleme avec mon chat :il est simple : je crée deux socket, - l'un pour l'envoie de données, (Envoyeur) (127.0.0.1 ; 42 ; UDP)-
Chat & protocole [ par bidulchouette ]
Bonjour, je travaille sur 2 appli pour faire un Chat (un client et un serveur). Pour l'instant tout marche pour le mieux mais le problème est que je n
mon application ne se lance pas sur un poste neutre [ par delphives ]
bonjour,alors voila mon soucis, j'ai créé une appli avec des composants standard de delphi excepté report builder et les composants jedi.lorsque je dé
Chat a distance [ par Hardouz ]
salut je vien de creé un mini CHAT local avec les composant SOCKETSERVER et SOCKETCLIENT et ca marche parfait ^_^ .maintenant j'ai penser a me develop
Chat Client Server [ par Hardouz ]
BonjourJ'ai realiser un chat avec les SocketServer et SocketClient et ça fonctionne parfait mais lorsque je demarre le Client sans que le serveur ca m
comment pourrai moi ajouter un fenetre de chat [ par jgalil ]
1:quelle sont les composants utilisés dans un logiciel simple pour la chat 2:j'ai developé un logiciel (jeu) comment pourrai moi ajouter un fenetre de
|
Téléchargements
Logiciels à télécharger sur le même thème :
Comparez les prix Nouvelle version
|