unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, blcksock;
type
ConnectionType = record
Sock: TTCPBlockSocket;
ClientName: String;
end;
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Memo1: TMemo;
Timer1: TTimer;
Timer2: TTimer;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Edit3KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Connections: array of ConnectionType;
Form1: TForm1;
ListenerSocket: TTCPBlockSocket;
sock: TTCPBlockSocket;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
edit1.clear;
edit2.clear;
edit3.clear;
memo1.lines.Clear;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
date:integer;
begin
//time:=FormatDateTime('DDDD, dd MMMM YYYY HH:MM:SS', Now);
ListenerSocket := TTCPBlockSocket.Create;
ListenerSocket.CreateSocket;
ListenerSocket.setLinger(true,10);
ListenerSocket.bind(edit1.text ,edit2.text);
ListenerSocket.listen;
memo1.lines.add('waiting...');
repeat
Application.ProcessMessages;
if ListenerSocket.canread(100) then // <--- use 100 here instead of 1000
begin
edit3.enabled:=true;
button2.enabled:=true;
SetLength(Connections, Length(Connections) + 1);
Connections[high(Connections)].Sock := TTCPBlockSocket.Create;
Connections[high(Connections)].Sock.Socket := ListenerSocket.Accept;
Timer1.enabled:=true;
//memo1.lines.add('');
//memo1.lines.add('Incoming connection');
memo1.lines.add('Client '+inttostr(length(connections)) + ' is connected');
//if (Connections[high(connections)].sock.canread(100)) and (Connections[high(connections)].sock.lasterror = 0)then
Timer1.enabled:=true;
//memo1.lines.add('Client connected on local port: '+ ', '+inttostr(ConnectionSocket.LocalSin.sin_port)+ ', '+ inttostr(ConnectionSocket.RemoteSin.sin_port));
if length(connections) = 1 then
begin
memo1.lines.add( FormatDateTime('DDDD, dd MMMM YYYY HH:MM:SS', Now));
memo1.lines.add( '------------------------------------------------------------------------');
memo1.lines.add( 'Say Something');
end;
end;
until false;
//ListenerSocket.Free;
//memo1.lines.add('done');
end;
procedure TForm1.Button2Click(Sender: TObject);
var
buffer:string;
i: Integer;
begin
for i := 0 to high(connections) do
begin
buffer := edit3.text;//'hello, this is a client';
connections[i].sock.SendString(buffer + CRLF);
end;
memo1.lines.add('Me : '+buffer);
end;
procedure TForm1.Edit3KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
);
begin
if Key = 13 { or VK_RETURN and add lcltype in your uses } then
begin
button2.click;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
s:string;
i, j: Integer;
begin
I := 0;
while I <= High(connections) do
begin
if ConnectionS[i].sock.canread(100) then
begin
S := ConnectionS[i].sock.RecvString(120000);
memo1.lines.add('client '+inttostr(i+1)+ ' : ' +S);
for j:= 0 to high(connections) do
begin
if j <> i then
begin
connections[j].sock.SendString('client '+inttostr(i+1)+ ' : ' +s + crlf);
end;
end;
end;
if (connections[i].sock.lasterror <> 0) then
begin
ConnectionS[i].sock.CloseSocket;
ConnectionS[i].sock.Free;
for j:= i+1 to high(connections) do
begin
connections[j-1]:=connections[j]
end;
memo1.lines.add('*Clinet ' + inttostr(i+1) + ' disconnected');
setlength(connections, length(connections) -1);
continue;
end;
Inc(I);
end;
if length(connections) = 0 then
begin
edit3.clear;
edit3.enabled:=false;
button2.enabled:=false;
timer1.enabled:=false;
memo1.lines.add('Clinet ' + inttostr(i+1) + 'disconnected');
memo1.lines.add( '------------------------------------------------------------------------');
memo1.lines.add('Connection closed');
memo1.lines.add( FormatDateTime('DDDD, dd MMMM YYYY HH:MM:SS', Now));
memo1.lines.add('Waiting for new connection');
//exit; // <- we can exit because we closed the connection
end;
end;
Recent
