Une idée après une discussion avec Foreman, que je remercie.
Pour connecter 2 PC distants, on tombe presque toujours sur le problème des adresses IP. Il faut les rechercher et se les échanger par tout moyen adéquat. Cela nécessite donc la présence des 2 utilisateurs. Cette petite application fera cela automatiquement grace à des composants Indy standards.
Source / Exemple :
unit Unit1;
{IP-Exchanger par Caribensila}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdFTP, StdCtrls, IdAntiFreezeBase, IdAntiFreeze, OleCtrls, SHDocVw,
ExtCtrls, IdTCPServer;
type
TForm1 = class(TForm)
IdFTP1: TIdFTP;
IdAntiFreeze1: TIdAntiFreeze;
WebBrowser1: TWebBrowser;
RadioGroup1: TRadioGroup;
RadioButtonUtilisateurA: TRadioButton;
RadioButtonUtilisateurB: TRadioButton;
MemoConversation: TMemo;
IdTCPServer1: TIdTCPServer;
IdTCPClient1: TIdTCPClient;
MemoMessage: TMemo;
EditPseudo: TEdit;
EditPort: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
ButtonConnexion: TButton;
procedure ButtonConnexionClick(Sender: TObject);
procedure WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
procedure FormCreate(Sender: TObject);
procedure MemoMessageKeyPress(Sender: TObject; var Key: Char);
procedure IdTCPServer1Connect(AThread: TIdPeerThread);
procedure IdTCPServer1Execute(AThread: TIdPeerThread);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure EditPortChange(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
TReceptionThread = class(TThread)
protected
procedure Execute; override;
end;
var
Form1: TForm1;
ReceptionThread : TReceptionThread;
{********************************************}
{******** Vos constantes à définir.**********}
{******** Il s'agit des coordonnées**********}
{******** du serveur FTP de votre **********}
{******** propre page web **********}
{********************************************}
{*}Const {*}
{*} FTPHost : String = 'ftp.hebergeur.com';{*}
{*} FTPUsername : String = 'MonLog'; {*}
{*} FTPPassword : String = 'MonCode'; {*}
{********************************************}
implementation
{$R *.dfm}
var
HtmlList : TStrings;
IPsurFTP : Boolean;
procedure TForm1.FormCreate(Sender: TObject);
begin
HtmlList := TStringList.Create;
IPsurFTP := false;
MemoConversation.Clear ; MemoMessage.Clear;
EditPseudo.Clear ; EditPort.Text := '3030';
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
HtmlList.free;
end;
{********************************************}
{************ PARTIE CONNEXION **************}
{********************************************}
procedure TForm1.ButtonConnexionClick(Sender: TObject);
{Le WebBrowser se connecte à un site qui renvoie l'adresse IP Internet du PC}
begin
if (Form1.EditPseudo.Text = '')
then Showmessage('Tu dois entrer un pseudo!')
else begin
MemoConversation.Lines.Add('Recherche PC connecté. Patientez...');
ButtonConnexion.Enabled := false;
RadioButtonUtilisateurA.Enabled := false;
RadioButtonUtilisateurB.Enabled := false;
EditPort.ReadOnly := true;
Form1.WebBrowser1.Navigate('http://checkip.dyndns.org');
end;
end;
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
{Se produit quand le WebBrowser a chargé la page}
var
S, MonIP, SonIP : String;
i :Integer;
HtmlStream : TMemoryStream;
begin
Screen.Cursor := crHourGlass;
try
{***** On recherche l'IP Internet du PC local *****}
{***** dans la page *****}
S := WebBrowser1.OleObject.Document.Body.InnerHTML;
if (Pos('Current IP Address: ',S) <> 0) then begin
i := 21;
MonIP := '';
While (S[i] <> ' ') do begin
MonIP := MonIP + S[i] ; inc(i);
end; end
else begin
MemoConversation.Lines.Add('Processus stoppé car IP non trouvé.');
ButtonConnexion.Enabled := true;
exit;
end;
WebBrowser1.Stop; {On ferme le WebBrowser. C'est fini pour lui!}
{***** On se connecte au serveur FTP *****}
{***** du site qui héberge notre page web *****}
{***** pour uploader le code html *****}
{***** dans un TStringList. *****}
IdFTP1.Host := FTPHost;
IdFTP1.Username := FTPUsername;
IdFTP1.Password := FTPPassword;
HtmlStream := TMemoryStream.Create;
try
try
if (IdFTP1.Connected=false) then IdFTP1.Connect();
IdFTP1.Get('index.htm',HtmlStream,false);
HtmlStream.Position := 0;
HtmlList.LoadFromStream(HtmlStream);
except
MemoConversation.Lines.Add('Echec de la connexion. Processus stoppé.');
ButtonConnexion.Enabled := true;
exit;
end;
finally
HtmlStream.Free;
end;
{***** Dans cet exemple, les lignes réservées *****}
{***** aux IP de chaque PC sont les [8] et [9] *****}
if (RadioButtonUtilisateurA.Checked)
then S := HtmlList[9]
else S := HtmlList[8];
{***** 1er cas: Il y a l'IP du PC distant.*****}
{***** On récupère donc cet IP. *****}
if (S <> '<!-- |||| -->') then begin { => PC distant connecté }
i := Pos('||',S)+2;
SonIP := '';
While (S[i] <> '|') do begin
SonIP := SonIP + S[i] ; inc(i);
end;
{***** Le clientTCP local se connecte au serveur distant *****}
IdTCPClient1.Host := SonIP;//Si test sur 1PC, remplacer par '127.0.0.1'
IdTCPClient1.Port := StrToInt(EditPort.Text);
IdTCPClient1.Connect;
ReceptionThread := TreceptionThread.Create(false);
Screen.Cursor := crDefault;
{***** Et on efface l'adresse IP dans le serveur FTP *****}
HtmlStream := TMemoryStream.Create;
try
if (RadioButtonUtilisateurA.Checked)then begin
HtmlList.Insert(9,'<!-- |||| -->');
HtmlList.Delete(10); end
else begin
HtmlList.Insert(8,'<!-- |||| -->');
HtmlList.Delete(9);
end;
HtmlList.SaveToStream(HtmlStream);
HtmlStream.Position := 0;
Form1.IdFTP1.Put(HtmlStream,'index.htm',false);
Form1.ButtonConnexion.Enabled := true;
finally
HtmlStream.free;
end;
end;
{***** 2ème cas: Il n'y a pas l'IP du PC distant. *****}
{***** On met donc l'IP du PC local dans le code html *****}
if (S = '<!-- |||| -->') then begin { => PC distant non connecté }
MemoConversation.Lines.Add('Personne n''est en ligne');
HtmlStream := TMemoryStream.Create;
try
if (RadioButtonUtilisateurA.Checked = true)then begin
{Par sécurité, on pourrait d'abord coder ou crypter l'IP}
HtmlList.Insert(8,'<!-- ||'+MonIP+'|| -->');
HtmlList.Delete(9); end
else begin
HtmlList.Insert(9,'<!-- ||'+MonIP+'|| -->');
HtmlList.Delete(10);
end;
{***** Et on l'upload vers le serveur FTP *****}
HtmlList.SaveToStream(HtmlStream);
HtmlStream.Position := 0;
IdFTP1.Put(HtmlStream,'index.htm',false);
IPsurFTP := true; {L'IP est écrit sur le serveur FTP}
finally
HtmlStream.Free;
end;
end;
finally
IdFTP1.Quit; {C'est fini pour IdFTP !}
Screen.Cursor := crDefault;
ButtonConnexion.Enabled := true;
end;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
{***** Il s'agit d'effacer l'adresse IP du serveur FTP *****}
{***** du site qui héberge notre page web quand on *****}
{***** ferme l'application sans avoir eu de connexion *****}
var
HtmlStream : TMemoryStream;
begin
if (IPsurFTP) then begin
ButtonConnexion.Enabled := false;
MemoConversation.Lines.Add('Mise à jour du serveur FTP. Patientez...');
Screen.Cursor := crHourGlass;
HtmlStream := TMemoryStream.Create;
try
if (RadioButtonUtilisateurA.Checked)then begin
HtmlList.Insert(8,'<!-- |||| -->');
HtmlList.Delete(9); end
else begin
HtmlList.Insert(9,'<!-- |||| -->');
HtmlList.Delete(10);
end;
if (IdFTP1.Connected=false) then IdFTP1.Connect();
HtmlList.SaveToStream(HtmlStream);
HtmlStream.Position := 0;
Form1.IdFTP1.Put(HtmlStream,'index.htm',false);
finally
HtmlStream.free;
Screen.Cursor := crDefault;
IdFTP1.Quit;
end;
end;
end;
{********************************************}
{*************** PARTIE CHAT ****************}
{********************************************}
{***** Partie client *****}
procedure TreceptionThread.Execute;
{Le clientTCP local reçoit la confirmation de}
{ sa connexion au serveurTCP distant }
var
S : String;
begin
while not terminated do
begin
S:='';
try
S:=Form1.idTCPClient1.ReadLn;
except
Terminate;
end;
Form1.MemoConversation.Lines.Add(S);
end;
end;
procedure TForm1.MemoMessageKeyPress(Sender: TObject; var Key: Char);
{Le clientTCP local envoie des données au serveurTCP distant}
begin
if (key = #13) then begin {Si touche Enter...}
idTCPClient1.WriteLn(EditPseudo.Text + '> ' + MemoMessage.Text);
MemoConversation.Lines.Add(EditPseudo.Text + '> ' + MemoMessage.Text);
MemoMessage.Clear;
Keybd_event(VK_Back,0,0,0); {Simule appuis sur touche retour pour}
{replacer le curseur à la 1ère ligne de Memo2}
end;
end;
{***** Partie serveur *****}
procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
{Le serveurTCP local détecte la connexion d'un clientTCP distant}
begin
{Le serveurTCP local confirme la connexion au clientTCP distant}
AThread.Connection.Writeln('Connexion établie');
{Et, par sécurité, le serveur n'acceptera que l'IP de ce client}
IdTCPServer1.Bindings.Clear; {Ci-dessous, il chope l'IP de l'autre PC}
IdTCPServer1.Bindings.Add.IP := AThread.Connection.Socket.Binding.PeerIP;
{Puis le clientTCP local se connecte sur le serveurTCP distant}
{ dans le cas où il était le 1er on-line }
If (IPsurFTP) then begin
IdTCPClient1.Host := AThread.Connection.Socket.Binding.PeerIP;
IdTCPClient1.Port := StrToInt(EditPort.Text);
IdTCPClient1.Connect;
ReceptionThread := TreceptionThread.Create(false);
IPsurFTP := false; {en effet, son IP a été effacé par l'autre PC}
end;
end;
procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
{Le serveurTCP local reçoit des données du clientTCP distant}
var
S : String;
begin
While AThread.Connection.Connected do begin
S := AThread.Connection.Readln;
Form1.MemoConversation.Lines.Add(S);
end;
end;
procedure TForm1.EditPortChange(Sender: TObject);
{Le serveurTCP doit utiliser le même port que le clientTCP}
begin
IdTCPServer1.DefaultPort := StrToInt(EditPort.Text);
end;
end.
Conclusion :
Voici le principe de cette application. Dès que l'application est lancée, elle recherche l'adresse IP Internet du PC (avec le WebBrowser1). Puis (avec le IdFTP1) elle se connecte sur le serveur FTP d'une de vos page web (qui a une adresse IP fixe). L'application downloade alors le code html et y ajoute l'adresse IP du PC local dans un "comment" du code html. Puis elle uploade ce code vers le serveur FTP de l'hébergeur... Quand le 2ème PC se connecte, il fait la même chose mais trouve alors l'adresse IP du 1er PC dans le code html. Il efface ce "comment" et peut alors se connecter au premier PC et lui communiquer sa propre IP (avec le IdTCPClient1 et le IdTCPServer1 ). La connexion entre le deux PC est établie.
La condition requise est donc d'avoir sa page web. On peut utiliser une page existante, mais il est préférable d'en créer une qui ne servira qu'à ça chez un hébergeur gratuit, par exemple. Cela évitera de s'encombrer avec des km de code html...
Dans cet exemple, la connexion des 2 PC sert à un "chat". Ce "chat" est basique, mais ce n'est pas le propos ici.
J'ai aussi voulu illustrer l'utilisation d'un compo IdAntiFreeze qui évite l'utilisation de threads.
Voici le code html de la page web de cet exemple:
<html>
<head>
<title>Ma page</title>
</head>
<body>
<H1 align=center>Site en travaux</H1>
<!-- les 2 lignes suivantes, 8 et 9 -->
<!--recevront les adresses Ip des 2 PC-->
<!-- |||| -->
<!-- |||| -->
</body>
</html>
Cette application utilise les adresses IP Internet. Elle ne peut donc pas être testée sur 2 PC d'un même réseau.
Elle a été testée sur 2 PC distants derrière proxy avec ifrance comme hébergeur de la page web. Le temps de connexion est variable mais il est comparable à MSN Messenger, par exemple.
On pourrait aussi utiliser un timer qui vérifierait l'adresse IP du PC local à intervals réguliers pour le cas où on voudrait contacter son propre PC à distance.
Merci de me les signaler les maladresses...
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.