Odpisuję dopiero teraz, bo miałem dziś długi dzień. Zanim jednak napiszę, to muszę wspomnieć, że nie wiem jak to jest z tym PLUSem. Widocznie musi to być jakiś zewnętrzny IP. Routera w domu nie mam. Odnośnie tego komunikatora opartego na TCP/IP przy użyciu komponentów Indy, działa on jak chat na zasadzie klient<->serwer<->klient. A oto kody, o których wspominał Shalom:
Kod komunikatora opartego na Socketach (Klient->Serwer). Oto kod klienta:
try //KOD DLA PRZYCISKU 'POLACZ':
Klient.Host := AdresIP.Text;
Klient.Active := true;
except Application.MessageBox
('Nie można połączyć się z serverem. Prawdopodobnie wpisano zly adres IP lub firewall Servera Cie blokuje.',
'Blad polaczenia', MB_OK+MB_IconExclamation);
end;
procedure TGlowna.KlientRead(Sender: TObject; Socket: TCustomWinSocket);
begin //Dodajemy do pola Memo to, co wysyla server. Klient to TClientSocket
MainLog.Lines.Add(Socket.ReceiveText);
end;
procedure TGlowna.EditWyslijKeyPress(Sender: TObject; var Key: Char);
var
wiadomosc : string;
begin
try
begin
Klient.Host := AdresIP.text;
Klient.Active := True;
Klient.Socket.SendText(wiadomosc);
except Application.MessageBox('Wystapil blad w polaczeniu z serverem', 'Blad', MB_OK+MB_IconExclamation);
end;
end;
Tutaj kod serwera:
procedure TSerwer.FormCreate(Sender: TObject);
begin
ServerSocket.Active := true; //wlaczenie czujnosci servera
end;
procedure TSerwer.ServerSocketClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
if ServerSocket.Active then
ServerSocket.Socket.Connections[0].
Sendtext('> Serwer zglasza sie z adresu: ' + IP + '. Nazwa Usera: ' + user);
end;
procedure TSerwer.ServerSocketClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
ServerSocket.Socket.Connections[0].
Sendtext('> Serwer zakonczyl polaczenie. Adres IP servera: ' + IP + ' a nazwa usera: ' + user);
end;
A tutaj kod tego komunikatora z artykułu KS-Eksperta:
Serwer:
unit komunikator_serwer;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdThreadMgr, IdThreadMgrDefault, IdBaseComponent, IdComponent,
IdTCPServer, StdCtrls;
type
WConnection = ^TConnection;
TConnection = record
Host : String[20];
Thread : Pointer;
end;
TPackage = record
UserNick,
Txt : string[255];
end;
TForm1 = class(TForm)
polacz: TButton;
IdTCPServer1: TIdTCPServer;
IdThreadMgrDefault1: TIdThreadMgrDefault;
akcje: TMemo;
procedure polaczClick(Sender: TObject);
procedure IdTCPServer1Connect(AThread: TIdPeerThread);
procedure IdTCPServer1Execute(AThread: TIdPeerThread);
procedure IdTCPServer1Disconnect(AThread: TIdPeerThread);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
ConnectionLst: TThreadList;
implementation
{$R *.dfm}
procedure TForm1.polaczClick(Sender: TObject);
begin
IdTCPServer1.DefaultPort := 2880;
IdTCPServer1.Active := True;
end;
procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
var
NewConnection: WConnection;
begin
GetMem(NewConnection, SizeOf(TConnection));
NewConnection.Host :=AThread.Connection.LocalName;
NewConnection.Thread :=AThread;
AThread.Data:=TObject(NewConnection);
try
ConnectionLst.LockList.Add(NewConnection);
finally
ConnectionLst.UnlockList;
end;
akcje.Lines.Add('polaczenie: '+NewConnection.Host+ '"' +TimeToStr(Time));
end;
procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
DestThread: TIdPeerThread;
i: Integer;
DestConnection: WConnection;
Package, NewPackage: TPackage;
begin
begin
AThread.Connection.ReadBuffer (Package, SizeOf (Package));
akcje.Lines.Add (TimeToStr(Time)+ ' - ' + Package.UserNick+ ' : '+Package.Txt);
NewPackage := Package;
with ConnectionLst.LockList do
try
for i := 0 to Count-1 do
begin
DestConnection := Items[i];
DestThread := DestConnection.Thread;
DestThread.Connection.WriteBuffer(NewPackage, SizeOf(NewPackage), True);
end;
finally
ConnectionLst.UnlockList;
end;
end;
end;
procedure TForm1.IdTCPServer1Disconnect(AThread: TIdPeerThread);
var
ActiveConnection: WConnection;
begin
ActiveConnection := WConnection(AThread.Data);
try
ConnectionLst.LockList.Remove(ActiveConnection);
finally
ConnectionLst.UnlockList;
end;
FreeMem(ActiveConnection);
AThread.Data := nil;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ConnectionLst := TThreadList.Create;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
IdTCPServer1.Active := False;
ConnectionLst.Free;
end;
end.
Klient:
unit komunikator_klient;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
StdCtrls;
type
TForm1 = class(TForm)
wiadomosci: TMemo;
dowyslania: TEdit;
adresip: TEdit;
nick: TEdit;
Label1: TLabel;
Label2: TLabel;
polacz: TButton;
wyslij: TButton;
IdTCPClient1: TIdTCPClient;
procedure polaczClick(Sender: TObject);
procedure wyslijClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TPackage = record
UserNick,
Txt : string[255];
end;
TClientOnReceive = class(TThread)
private
ActiveP: TPackage;
procedure Action;
protected
procedure Execute;
override;
end;
var
Form1: TForm1;
ClientRecive: TClientOnReceive;
implementation
{$R *.dfm}
procedure TClientOnReceive.Action;
begin
Form1.wiadomosci.Lines.Add (ActiveP.UserNick + ' pisze: ' + ActiveP.Txt);
end;
procedure TClientOnReceive.Execute;
begin
while not Terminated do
begin
if not Form1.IdTCPClient1.Connected then
Terminate
else
try
Form1.IdTCPClient1.ReadBuffer(ActiveP, SizeOf (ActiveP));
Synchronize(Action);
except
end;
end;
end;
procedure TForm1.polaczClick(Sender: TObject);
begin
try
IdTCPClient1.Host := adresip.Text;
IdTCPClient1.Port := 2880;
IdTCPClient1.Connect(10000);
ClientRecive := TClientOnReceive.Create(True);
ClientRecive.FreeOnTerminate:=True;
ClientRecive.Resume;
except
on E: Exception do MessageDlg ('polaczenie niemozliwe: '+#13+E.Message, mtError, [mbOk], 0);
end;
end;
procedure TForm1.wyslijClick(Sender: TObject);
var
SendPackage : TPackage;
begin
SendPackage.UserNick := nick.Text;
SendPackage.Txt := dowyslania.Text;
IdTCPClient1.WriteBuffer (SendPackage, SizeOf (SendPackage), true);
end;
end.