unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer, Buttons,
 idContext;

type
 TForm1 = class(TForm)
   Server: TIdTCPServer;
   procedure ServerConnect(AContext: TIdContext);
   procedure ServerExecute(AContext: TIdContext);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

 _Pack = Record
         Primary_handle : Cardinal;
         Secondary_handle : Cardinal;
         Primary_index : string[8];
         Secondary_index : string[8];
        End;

 {функция для того что бы составить пару из подключений}
 Function Connect_to_Clients( Handle : cardinal; index : string):boolean;
 {получение хэндла "соседа" пары, отправили свой handle, в ответе     получили его handle}
 Function GetHandleByHandle(Handle : cardinal):Cardinal;
 { "переброс" команд, отправляем свой handle, и что хотели отправить "соседу"}
 Procedure Transfer(handle : cardinal; str: string);

var
 Form1: TForm1;
 Pack : _Pack;
 Clients : Array of _Pack;
 Clients_count : integer;

implementation

{$R *.dfm}

procedure TForm1.ServerConnect(AContext: TIdContext);
var
str : string;
begin
AContext.Connection.Socket.WriteLn('Welcame'+#13+'Index[8]: ');
Str:=AContext.Connection.Socket.ReadLn();
if length(str)<>8 then
 begin
  AContext.Connection.Socket.WriteLn('Error length index');
  AContext.Connection.Disconnect;
 end
else
 begin
  if Connect_to_clients(Acontext.Connection.Socket.Binding.Handle,str) then
   begin
    Acontext.Connection.Socket.WriteLn('Start transfer');
   end
  else
   begin
    Acontext.Connection.Socket.WriteLn('Error registration');
    AContext.Connection.Disconnect;
   end;
 end;
end;

Function Connect_to_Clients( Handle : cardinal; index : string):boolean;
var
i : integer;
register_ : boolean;
begin
Result:=false;
for i:=0 to Clients_count-1 do
 begin
  if ((Clients[i].Primary_index=index)or(Clients[i].Secondary_index=index)) then
   begin
    if Clients[i].Primary_index=index then
     begin
      Clients[i].Secondary_handle:=Handle;
      Clients[i].Secondary_index:=index;
      result:=true;
      exit;
     end;
    if Clients[i].Secondary_index=index then
     begin
      Clients[i].Primary_handle:=Handle;
      Clients[i].Primary_index:=index;
      result:=True;
      exit;
     end;
   end;
 end;
inc(clients_count);
SetLEngth(Clients,Clients_count);
Clients[Clients_count-1].Primary_handle:=handle;
Clients[Clients_count-1].Primary_index:=Index;
Result:=True;
end;

procedure TForm1.ServerExecute(AContext: TIdContext);
var
msg : string;
i : integer;
begin
msg:=AContext.Connection.Socket.ReadLn();
if msg='\handle\' then
 begin
  AContext.Connection.Socket.WriteLn(IntTOStr(AContext.Connection.Socket.Binding.H andle));
  exit;
 end;
if msg='\clients\' then
 begin
  for i:=0 to CLients_count-1 do
   begin
    AContext.Connection.Socket.WriteLn(
    '-----------------'+#13+'Couple '+IntToStr(i+1)+#13+
    'PH: '+IntToStr(Clients[i].Primary_handle)+#13+
    'PI: '+Clients[i].Primary_index+#13+
    'SH: '+IntToStr(Clients[i].Secondary_handle)+#13+
    'SI: '+Clients[i].Secondary_index);
   end;
   AContext.Connection.Socket.WriteLn('Done. '+IntToStr(Clients_count)+' couples.');
  exit;
 end;
if msg='\couples\' then
 begin
  AContext.Connection.Socket.WriteLn(INtToStr(Clients_count)+' couples.');
  exit;
 end;
if msg='\GetHandleByHandle\' then
 begin
  AContext.Connection.Socket.WriteLn(IntToStr(GetHandleByHandle(AContext.Connectio n.Socket.Binding.Handle)));
 end;
Transfer(AContext.Connection.Socket.Binding.Handle,msg);
end;

Procedure Transfer(handle : cardinal; str: string);
var
_handle : cardinal;
begin
_handle:=GetHandleByHandle(handle);
{...по идее тут отправка str подключению с известным нам _handle,
 это и есть товарищ из пары, вот только как отправить таким спобом
 этого я не знаю..:( }
end;

Function GetHandleByHandle(Handle : cardinal):Cardinal;
var
i : integer;
begin
result:=0;
for i:=0 to Clients_count-1 do
 begin
  if Clients[i].Primary_handle=handle then
   begin
    result:=Clients[i].Secondary_handle;
    exit;
   end;
  if Clients[i].Secondary_handle=handle then
   begin
    Result:=Clients[i].Primary_handle;
    exit;
   end;
 end;
end;

end.

List := tcpServer.Threads.LockList;
 try
   for Count := 0 to List.Count -1 do
   try
     TIdPeerThread(List.Items[Count]).Connection.WriteLn(Msg);
   except
     TIdPeerThread(List.Items[Count]).Stop;
   end;
 finally
   tcpServer.Threads.UnlockList;
 end;

procedure TForm1.ServerExecute(AContext: TIdContext);
var
MSG : string;
I, J : integer;
List : Tlist;
_ip : string;
_port : word;
key : string;
begin
msg:=AContext.Connection.Socket.ReadLn();
{----------------------------------------}
for i := 0 to Clients.Count - 1 do
 begin
  if ((Clients.Clients[i].SIP=AContext.Connection.Socket.Binding.PeerIP)and(Clients.C lients[i].SPort=AContext.Connection.Socket.Binding.PeerPort))or
     ((Clients.Clients[i].PIP=Acontext.Connection.Socket.Binding.PeerIP)and(Clients.C lients[i].PPort=AContext.Connection.Socket.Binding.PeerPort)) then
   begin
    if (Clients.Clients[i].SIP=AContext.Connection.Socket.Binding.PeerIP)and
       (Clients.Clients[i].SPort=AContext.Connection.Socket.Binding.PeerPort) then
     begin
      _ip:=Clients.Clients[i].PIP;
      if _ip='' then
       begin
        AContext.Connection.Socket.WriteLn('No send.');
        exit;
       end;
      _port:=Clients.Clients[i].PPort;
      Send(_ip,_port,msg);
      exit;
     end
    else
     begin
      _ip:=Clients.Clients[i].SIP;
      if _ip='' then
       begin
        AContext.Connection.Socket.WriteLn('No send.');
        exit;
       end;
      _port:=Clients.Clients[i].SPort;
      Send(_ip,_port,msg);
      exit;
     end;
   end
  else
   begin
    {...}
   end;
 end;
end;

Procedure Send (ip:string;port:word;str:string);
var
i : integer;
List : Tlist;
begin
try
 LIst:=Form1.Server.Contexts.LockList;
 for I := 0 to List.Count - 1 do
  with TidContext(List[i]) do
   begin
    if (connection.Socket.Binding.PeerIP=ip)and(connection.Socket.Binding.PeerPort=port ) then
     begin
      TidCOntext(list[i]).Connection.Socket.WriteLn(str);
      exit;
     end;
   end;
finally
 Form1.Server.Contexts.UnlockList;
end;
end;

Type
  _Pack = record
         SIP : string[15];
         SPort : WORD;
         PIP : string[15];
         PPort : Word;
         Index : String[10];
        end;

_Clients = class
             pack : _pack;
             Clients : Array of _pack;
             Count : integer;
            end;

var
 Form1: TForm1;
 Clients : _Clients;

procedure TForm1.ServerConnect(AContext: TIdContext);
var
str, IP : string;
I : integer;
Port:Word;
KEY_CHECK : String;
begin
KEY_CHECK:=Acontext.Connection.Socket.Readln();
if edit1.Text<>KEY_CHECK then Acontext.Connection.Disconnect;
AContext.Connection.Socket.Writeln('Index[<=10]');
str:=Acontext.Connection.Socket.ReadLn();
if length(str)>10 then Acontext.Connection.Disconnect;
for I := 0 to Clients.Count - 1 do
 begin
  if Clients.Clients[i].Index=str then
   begin
    if Clients.Clients[i].SIP='' then
     begin
      Clients.Clients[i].SIP:=Acontext.Connection.Socket.Binding.PeerIP;
      Clients.Clients[i].SPort:=AContext.Connection.Socket.Binding.PeerPort;
      Acontext.Connection.Socket.WriteLn('srd');
      exit;
     end;
    if Clients.Clients[i].PIP='' then
     begin
      Clients.Clients[i].PIP:=Acontext.Connection.Socket.Binding.PeerIP;
      Clients.Clients[i].PPort:=AContext.Connection.Socket.Binding.PeerPort;
      Acontext.Connection.Socket.WriteLn('srd');
      exit;
     end;
    AContext.Connection.Disconnect;
    exit;
   end;
 end;
inc(Clients.Count);
SetLength(Clients.Clients,Clients.Count);
Clients.Clients[Clients.Count-1].SIP:=AContext.Connection.Socket.Binding.PeerIP;
Clients.Clients[Clients.Count-1].SPort:=AContext.Connection.Socket.Binding.PeerPort;
Clients.Clients[Clients.Count-1].Index:=str;
Acontext.Connection.Socket.WriteLn('srd');
end;

procedure TForm1.ServerDisconnect(AContext: TIdContext);
var
i, j : integer;
begin
for i := 0 to Clients.Count - 1 do
 begin
  if (Clients.Clients[i].SIP+':'+IntToStr(Clients.Clients[i].SPort)=AContext.Connection.Socket.Binding.PeerIP+':'+IntToStr(AContext.Connection.Socket.Binding.PeerPort)) then
   begin
    Clients.Clients[i].SIP:='';
    Clients.Clients[i].SPort:=0;
    break;
   end;
  if (Clients.Clients[i].PIP+':'+IntToStr(Clients.Clients[i].PPort)=AContext.Connection.Socket.Binding.PeerIP+':'+IntToStr(AContext.Connection.Socket.Binding.PeerPort)) then
   begin
    Clients.Clients[i].PIP:='';
    Clients.Clients[i].PPort:=0;
    break;
   end;
 end;
if (clients.Clients[i].SIP='')and(clients.Clients[i].PIP='') then
 begin
  for j := i to clients.Count - 1 do
   Clients.Clients[j]:=Clients.Clients[j+1];
  dec(clients.Count);
  SetLength(clients.Clients,Clients.Count);
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
_Start_time:=now;
CriticalSection:=TCriticalSection.Create;
CriticalSection.Enter;
Clients:=_Clients.Create;
CriticalSection.Leave;
Server.MaxConnections:=Limits.Value;
cl_limit.Caption:=IntTOstr(limits.Value);
end;

    _Pack = record
         SIP : string[15];
         SPort : WORD;
         PIP : string[15];
         PPort : Word;
         Index : String[10];
        end;

 _Clients = class
             pack : _pack;
             Clients : Array of _pack;
             Count : integer;
            end;

 Procedure Send (ip:string;port:word;str:string);
 Procedure Server_clear;

var

 Link_file : TEXTFILE;
 RAM_file : TEXTFILE;

 Form1: TForm1;
 Clients : _Clients;
 _null : _pack;
 CriticalSection : TCriticalSection;

 _Start_time : TDATETIME;

 Last_ram : real;

implementation

{$R *.dfm}

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Server.StopListening;
APPLICATION.Terminate;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
AssignFIle(Link_file,'link.sf');
AssignFIle(RAM_file,'ram.sf');
Rewrite(link_file);
Rewrite(ram_file);
CloseFile(link_file);
CloseFile(Ram_file);

_Start_time:=now;
CriticalSection:=TCriticalSection.Create;
CriticalSection.Enter;
Clients:=_Clients.Create;
CriticalSection.Leave;
Server.MaxConnections:=Limits.Value;
cl_limit.Caption:=IntTOstr(limits.Value);
end;

procedure TForm1.limitsClick(Sender: TObject);
begin
Server.MaxConnections:=Limits.Value;
cl_limit.Caption:=IntToStr(limits.Value);
end;

procedure TForm1.logTimer(Sender: TObject);
Var
pmc:PPROCESS_MEMORY_COUNTERS;
rm : real;
state : string;
begin
state:='';
Append(ram_file);
GetMem(pmc, SizeOf(_PROCESS_MEMORY_COUNTERS));
pmc.cb:=SizeOf(_PROCESS_MEMORY_COUNTERS);
If GetProcessMemoryInfo(GetCurrentProcess(), pmc, pmc.cb) then rm:=(pmc^.WorkingSetSize)/1024/1024;
if (rm>last_ram) then
 begin
  state:='+'+FloatToStrF(rm-Last_ram,ffFixed,15,3);
 end;
if (rm<last_ram) then
 begin
  state:='-'+FloatToStrF(last_ram-rm,ffFixed,15,3);
 end;
if rm=last_ram then State:='0';
Last_ram:=rm;
Writeln(ram_file,DateToStr(now)+' '+TimeToStr(now)+' \ RAM: '+FloatTOStrF(rm,ffFixed,15,3)+'\ '+state);
CloseFile(ram_file);
end;

procedure TForm1.displayClick(Sender: TObject);
var
str : string;
begin
RichEdit1.Clear;
if display.ItemIndex=0 then
 begin
   RichEdit1.Lines.Add('not supported');
 end;
if display.ItemIndex=1 then
 begin
  reset(ram_file);
  while not(eof(ram_file)) do
   begin
    readln(ram_file,str);
    RichEdit1.Lines.Add(str);
   end;
  RichEdit1.Lines.Add('---------------------'+#13+' END');
  closeFIle(ram_file);
 end;
end;

procedure TForm1.ServerConnect(AContext: TIdContext);
var
str, IP : string;
I : integer;
Port:Word;
KEY_CHECK : String;
begin
KEY_CHECK:=Acontext.Connection.Socket.Readln();
if edit1.Text<>KEY_CHECK then Acontext.Connection.Disconnect;
AContext.Connection.Socket.Writeln('Index[<=10]');
str:=Acontext.Connection.Socket.ReadLn();
if length(str)>10 then Acontext.Connection.Disconnect;
for I := 0 to Clients.Count - 1 do
 begin
  if Clients.Clients[i].Index=str then
   begin
    if Clients.Clients[i].SIP='' then
     begin
      Clients.Clients[i].SIP:=Acontext.Connection.Socket.Binding.PeerIP;
      Clients.Clients[i].SPort:=AContext.Connection.Socket.Binding.PeerPort;
      Acontext.Connection.Socket.WriteLn('srd');
      exit;
     end;
    if Clients.Clients[i].PIP='' then
     begin
      Clients.Clients[i].PIP:=Acontext.Connection.Socket.Binding.PeerIP;
      Clients.Clients[i].PPort:=AContext.Connection.Socket.Binding.PeerPort;
      Acontext.Connection.Socket.WriteLn('srd');
      exit;
     end;
    AContext.Connection.Disconnect;
    exit;
   end;
 end;
inc(Clients.Count);
SetLength(Clients.Clients,Clients.Count);
Clients.Clients[Clients.Count-1].SIP:=AContext.Connection.Socket.Binding.PeerIP;
Clients.Clients[Clients.Count-1].SPort:=AContext.Connection.Socket.Binding.PeerPort;
Clients.Clients[Clients.Count-1].Index:=str;
Acontext.Connection.Socket.WriteLn('srd');
end;

procedure TForm1.ServerDisconnect(AContext: TIdContext);
var
i, j : integer;
begin
for i := 0 to Clients.Count - 1 do
 begin
  if (Clients.Clients[i].SIP+':'+IntToStr(Clients.Clients[i].SPort)=AContext.Connection.Socket.Binding.PeerIP+':'+IntToStr(AContext.Connection.Socket.Binding.PeerPort)) then
   begin
    Clients.Clients[i].SIP:='';
    Clients.Clients[i].SPort:=0;
    break;
   end;
  if (Clients.Clients[i].PIP+':'+IntToStr(Clients.Clients[i].PPort)=AContext.Connection.Socket.Binding.PeerIP+':'+IntToStr(AContext.Connection.Socket.Binding.PeerPort)) then
   begin
    Clients.Clients[i].PIP:='';
    Clients.Clients[i].PPort:=0;
    break;
   end;
 end;
if (clients.Clients[i].SIP='')and(clients.Clients[i].PIP='') then
 begin
  for j := i to clients.Count - 1 do
   Clients.Clients[j]:=Clients.Clients[j+1];
  dec(clients.Count);
  SetLength(clients.Clients,Clients.Count);
 end;
end;

Procedure Server_clear;
var
list : TList;
i : integer;
begin
try
 LIst:=Form1.Server.Contexts.LockList;
 for I := 0 to List.Count - 1 do
  with TidContext(List[i]) do Connection.Disconnect;
finally
 Form1.Server.Contexts.UnlockList;
end;
Clients.Count:=0;
SetLength(Clients.Clients,0);
end;

procedure TForm1.ServerExecute(AContext: TIdContext);
var
MSG : string;
I, J : integer;
List : Tlist;
_ip : string;
_port : word;
key : string;
begin
msg:=AContext.Connection.Socket.ReadLn();
{----------------------------------------}
if msg='\reset\' then
 begin
  Server_clear;
 end;
if msg='\сhKOL\' then
 begin

 end;
if msg='\chKEY\' then
 begin
  AContext.Connection.Socket.Writeln('KEY');
  key:=AContext.Connection.Socket.Readln();
  if KEY<>Edit2.Text then
   begin
    AContext.Connection.Socket.WriteLn('ikr');   {invalid key read}
    Acontext.Connection.Disconnect;
    exit;
   end
  else
   begin
    AContext.Connection.Socket.WriteLn('NK');    {new key}
    KEY:=AContext.Connection.Socket.ReadLn();
    if Length(key)>10 then
     begin
      AContext.Connection.Socket.WriteLn('iks'); {invalid key set}
      AContext.Connection.Disconnect;
      exit;
     end
    else
     begin
      Acontext.Connection.Socket.Write('oks');    {ok key set}
      Edit1.Text:=key;
      exit;
     end;
   end;
 end;
if msg='\clients\' then
 begin
  Acontext.Connection.Socket.WriteLn(IntToStr(Clients.Count));
  exit;
 end;
if msg='\exit\' then
 begin
  AContext.Connection.Disconnect;
  exit;
 end;
if msg='\data\' then
 begin
  for i := 0 to Clients.Count - 1 do
   begin
    Acontext.Connection.Socket.WriteLn('SIP: '+Clients.Clients[i].SIP);
    AContext.Connection.Socket.WriteLn('SPort: '+IntToStr(Clients.Clients[i].SPort));
    AContext.Connection.Socket.WriteLn('PIP: '+Clients.Clients[i].PIP);
    AContext.Connection.Socket.WriteLn('PPort: '+IntToStr(Clients.Clients[i].PPort));
    AContext.Connection.Socket.WriteLn('Index: '+Clients.Clients[i].Index);
   end;
  exit;
 end;
if msg='\i\' then
 begin
  AContext.Connection.Socket.WriteLn(AContext.Connection.Socket.Binding.PeerIP+':'+IntToStr(AContext.Connection.Socket.Binding.PeerPort));
  exit;
 end;
{----------------------------------------}
for i := 0 to Clients.Count - 1 do
 begin
  if ((Clients.Clients[i].SIP=AContext.Connection.Socket.Binding.PeerIP)and(Clients.C lients[i].SPort=AContext.Connection.Socket.Binding.PeerPort))or
     ((Clients.Clients[i].PIP=Acontext.Connection.Socket.Binding.PeerIP)and(Clients.C lients[i].PPort=AContext.Connection.Socket.Binding.PeerPort)) then
   begin
    if (Clients.Clients[i].SIP=AContext.Connection.Socket.Binding.PeerIP)and
       (Clients.Clients[i].SPort=AContext.Connection.Socket.Binding.PeerPort) then
     begin
      _ip:=Clients.Clients[i].PIP;
      if _ip='' then
       begin
        AContext.Connection.Socket.WriteLn('No send.');
        exit;
       end;
      _port:=Clients.Clients[i].PPort;
      Send(_ip,_port,msg);
      exit;
     end
    else
     begin
      _ip:=Clients.Clients[i].SIP;
      if _ip='' then
       begin
        AContext.Connection.Socket.WriteLn('No send.');
        exit;
       end;
      _port:=Clients.Clients[i].SPort;
      Send(_ip,_port,msg);
      exit;
     end;
   end
  else
   begin

   end;
 end;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
form2.show;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
Application.Terminate;
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
Tray.Visible:=True;
Form1.Hide;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
day : integer;
pmc:PPROCESS_MEMORY_COUNTERS;
begin
cl.Caption:=IntToStr(Clients.Count*2);
Start_time.Caption:=TimeToStr(_Start_time);

if Abs(_Start_time-now)>1 then
  begin
   day:=Abs(Trunc(_Start_time-now));
   form1.work_time.Caption:=FloatToStr(day)+' д. '+TimeToStr(_Start_time-now);
  end
 else form1.work_time.Caption:=TimeToStr(now-_Start_time);

GetMem(pmc, SizeOf(_PROCESS_MEMORY_COUNTERS));
pmc.cb:=SizeOf(_PROCESS_MEMORY_COUNTERS);
If GetProcessMemoryInfo(GetCurrentProcess(), pmc, pmc.cb) then
 begin
  ram.Caption:=FloatToStrF((pmc^.WorkingSetSize)/1024/1024,ffFixed,15,3)+' Мб';
  FreeMem(pmc);
 end;
end;

procedure TForm1.TrayClick(Sender: TObject);
begin
Form1.Show;
Tray.Visible:=False;
end;

Procedure Send (ip:string;port:word;str:string);
var
i : integer;
List : Tlist;
begin
try
 LIst:=Form1.Server.Contexts.LockList;
 for I := 0 to List.Count - 1 do
  with TidContext(List[i]) do
   begin
    if (connection.Socket.Binding.PeerIP=ip)and(connection.Socket.Binding.PeerPort=port ) then
     begin
      TidCOntext(list[i]).Connection.Socket.WriteLn(str);
      break;
     end;
   end;
finally
 Form1.Server.Contexts.UnlockList;
end;
end;

procedure TForm1.ServerConnect(AContext: TIdContext);
var
str, IP : string;
I : integer;
Port:Word;
KEY_CHECK : String;
begin
KEY_CHECK:=Acontext.Connection.Socket.Readln();
if edit1.Text<>KEY_CHECK then Acontext.Connection.Disconnect;
AContext.Connection.Socket.Writeln('Index[<=10]');
str:=Acontext.Connection.Socket.ReadLn();
if length(str)>10 then Acontext.Connection.Disconnect;
CriticalSection.Enter;
for I := 0 to Clients.Count - 1 do
 begin
  if Clients.Clients[i].Index=str then
   begin
    if Clients.Clients[i].SIP='' then
     begin
      Clients.Clients[i].SIP:=Acontext.Connection.Socket.Binding.PeerIP;
      Clients.Clients[i].SPort:=AContext.Connection.Socket.Binding.PeerPort;
      Acontext.Connection.Socket.WriteLn('srd');
      CriticalSection.Leave;
      exit;
     end;
    if Clients.Clients[i].PIP='' then
     begin
      Clients.Clients[i].PIP:=Acontext.Connection.Socket.Binding.PeerIP;
      Clients.Clients[i].PPort:=AContext.Connection.Socket.Binding.PeerPort;
      Acontext.Connection.Socket.WriteLn('srd');
      CriticalSection.Leave;
      exit;
     end;
    AContext.Connection.Disconnect;
    CriticalSection.Leave;
    exit;
   end;
 end;
inc(Clients.Count);
SetLength(Clients.Clients,Clients.Count);
Clients.Clients[Clients.Count-1].SIP:=AContext.Connection.Socket.Binding.PeerIP;
Clients.Clients[Clients.Count-1].SPort:=AContext.Connection.Socket.Binding.PeerPort;
Clients.Clients[Clients.Count-1].Index:=str;
CriticalSection.Leave;
Acontext.Connection.Socket.WriteLn('srd');
end;

try..finally

Function Send(ip:string;port:word;str:string):boolean;
var
i : integer;
List : Tlist;
begin
try
 LIst:=Form1.Server.Contexts.LockList;
 for I := 0 to List.Count - 1 do
  with TidContext(List[i]) do
   begin
    if (connection.Socket.Binding.PeerIP=ip)and(connection.Socket.Binding.PeerPort=port ) then
     begin
      try
       TidContext(list[i]).Connection.Socket.WriteLn(str);
      except
       Result:=False;
      end;
      Result:=True;
      break;
     end;
   end;
finally
 Form1.Server.Contexts.UnlockList;
end;
end;