Synapse - Exemplo com sockets

Os componentes de socket mais famosos sem duvida são o IdTcpServer e IdTcpClient, da paleta Indy.
Eu não sei quanto aos outros desenvolvedores, mas acho o Indy muito complexo, pesado, e no caso do lazarus, com varios bugs, pelo menos até a versão 0.9.27 do lazarus, quando eu portei um projeto em delphi/kylix3 pro lazarus.
Resolvi estudar outros componentes de socket para portar o meu projeto pro lazarus.

Os componentes que eu analisei foram:

.Synapse (Ararat Synapse)
.LNet (Lightweight networking library)

Aqui nesse post vou apresentar um projeto de teste do synapse composto de 3 modulos:

.Modulo Cliente
.Modulo Servidor
.Modulo Configura/Dispara Clientes

Como funciona

Modulo Servidor

Primeiro, carregue o modulo servidor (server_synapse1.exe).
Antes de ativar, marque a opção "Em caso de erro parar comunicação"
Clique em Ativar Servidor
Pronto, o nosso servidor está no ativo, esperando conexões.

Tela do servidor

Modulo Cliente

Agora, vamos carregar o(s) modulo(s) clientes do nosso projeto.
Execute o clientesynapse1.exe
Veja a tela do nosso cliente abaixo:




Observe que temos algumas configurações disponiveis pro nosso cliente, pra possibilitar a nossa maratona de testes.

Estas opções são:

Numero de sends
Numero de vezes que o cliente repetira o teste escolhido

Disparo por arquivo externo
Informa ao cliente que deve procurar pelo arquivo "disparo.dat" pra iniciar o teste

Finaliza automatico
Informa ao cliente pra auto-finalizar assim que o teste for executado

Parar em caso de erro
Em caso de problemas, para e mostra a mensagem de erro



Modulo Cliente Control

Esse modulo permite configurar o comportamento dos modulos clientes que serão carregados.

Tela do modulo control




Do lado esquerdo temos as configurações que serão carregadas pelos clientes.
Marque as opções desejadas e clique em "Gerar cconfig"

Do lado esquerdo temos 4 botões:

Engatilhar
Apos o primeiro "disparo", clique nesse botao pra colocar o modulo cliente em estado de espera pelo "disparo"

Disparar clientes
Ao clicar nesse botão, sera gerado o arquivo "disparo.dat" que será lido pelos clientes, e apos se iniciará o processamento desejado

Fechar clientes
Clicando nesse botão, será gerado o arquivo "closecli.dat" que fará com que todos os modulos clientes fechem automaticamente.

Reset
Ao receber o click, apaga os arquivos de controle (dispara.dat,closecli.dat)


Outros comandos

dispara10 e dispara100

Comandos para carregar 10 ou 100 modulos clientes de uma vez. Eu carreguei 100 modulos de uma vez no meu archlinux e funcionou beleza.


Download dos fontes aqui.


Boa diversão :-)

Modulo Servidor

unit server_synapse1_unit1;

{$mode objfpc}{$H+}

interface

uses
   Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
   StdCtrls, blcksock, synsock;

type

   TTCPEchoDaemon = class(TThread)
   private
      Daemon_Memo1:TMemo;
      SSocket:TTCPBlockSocket;
   public
      Constructor Create (hMemo:TMemo);
      Destructor Destroy; override;
      procedure Execute; override;
   end;

   TTCPEchoThrd = class(TThread)
   private
      Sock:TTCPBlockSocket;
      loClientSock:TTCPBlockSocket;
      EchoMemo:TMemo;
      CSock: TSocket;
      Memo1Text:string;
      procedure UpdateMemo1;
   public
      Constructor Create (hsock:tSocket;hMemo:TMemo);
      procedure Execute; override;
   end;

   { TForm1 }

   TForm1 = class(TForm)
      servidor_modo_thread: TButton;
      cancela_button: TButton;
      box_error: TCheckBox;
      modo_verbose: TCheckBox;
      Memo1: TMemo;
      procedure cancela_buttonClick(Sender: TObject);
      procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
      procedure FormCreate(Sender: TObject);
      procedure servidor_modo_threadClick(Sender: TObject);
   private
      { private declarations }
   public
      { public declarations }
   end;

var
   Form1: TForm1;
   SSocket: TTCPBlockSocket;
   loClientSock: TTCPBlockSocket;
   cancelar:Boolean;

implementation

{$R *.lfm}

Constructor TTCPEchoDaemon.Create(hMemo:TMemo);
begin
   inherited create(false);
   Daemon_Memo1:=hMemo;
   Ssocket:=TTCPBlockSocket.create;
   FreeOnTerminate:=true;
end;

Destructor TTCPEchoDaemon.Destroy;
begin
   SSocket.free;
end;

procedure TTCPEchoDaemon.Execute;
var
echo1:TTCPEchoThrd;
ClientSock:TSocket;
begin
   SSocket.CreateSocket;
   SSocket.Bind('127.0.0.1','7000');
   SSocket.Listen;
   cancelar:=False;
   if SSocket.LastError = 0 then
   begin
       while true do
       begin
            if terminated then break;
            Application.ProcessMessages;
            if SSocket.CanRead(10000)
            then begin
                ClientSock := SSocket.Accept;
                if SSocket.LastError = 0
                then begin
                     echo1:=TTCPEchoThrd.create(ClientSock,Daemon_memo1);
                     echo1.Resume;
                end ;
            end ;
       end ;
   end
   else
   begin
       Daemon_memo1.Lines.add('Erro '+inttostr(loClientSock.LastError)+' '+loClientSock.GetErrorDescEx);
   end;
   Daemon_memo1.Lines.Add('Finalizou');
   SSocket.CloseSocket;
   SSocket.Purge;
end;

Constructor TTCPEchoThrd.Create(Hsock:TSocket;hMemo:TMemo);
begin
   inherited create(true);
   Csock := Hsock;
   EchoMemo:=hMemo;
   FreeOnTerminate:=true;
end;
procedure TTCPEchoThrd.UpdateMemo1;
begin
   Form1.Memo1.Lines.Add(Memo1Text);
   Application.ProcessMessages;
end;

procedure TTCPEchoThrd.Execute;
var
clienteID,s1:string;
r,r1,r2,x,x1:integer;
begin
   loClientSock:=TTCPBlockSocket.create;
   try
      loClientSock.socket:=CSock;
      s1:=loClientSock.RecvString(10000);
      if s1='**teste1' then
      begin
          s1:=loClientSock.RecvString(10000);
          clienteID:=s1;
          loClientSock.SendString('** resp server '+clienteID+CRLF);
          if loClientSock.LastError>0 then
          begin
             Memo1Text:='ID '+clienteID+' SendString Erro '+inttostr(loClientSock.LastError)+' '+loClientSock.GetErrorDescEx;
             Synchronize(@UpdateMemo1);
          end;
      end;
      if s1='**teste2' then
      begin
         s1:=loClientSock.RecvString(10000);
         clienteID:=s1;
         s1:=loClientSock.RecvString(10000);
         x1:=strtoint(s1);
         for x:=1 to x1 do
         begin
            s1:=loClientSock.RecvString(10000);
            loClientSock.SendString('** resp server clienteID='+clienteID+CRLF);
            if loClientSock.LastError>0 then
            begin
               Memo1Text:='ID '+clienteID+' SendString Erro '+inttostr(loClientSock.LastError)+' '+loClientSock.GetErrorDescEx;
               Synchronize(@UpdateMemo1);
               break;
            end;
         end;
      end;
      if s1='**teste3' then
      begin
         s1:=loClientSock.RecvString(10000);
         clienteID:=s1;
         s1:=loClientSock.RecvString(10000);
         x1:=strtoint(s1);
         for x:=1 to x1 do
         begin
            s1:=loClientSock.RecvString(10000);
            if s1<>'**soma_inicio' then
            begin
               Memo1Text:='ID '+clienteID+' nao recebi **somainicio';
               Synchronize(@UpdateMemo1);
               if loClientSock.LastError>0 then
               begin
                  Memo1Text:='ID '+clienteID+' RecvString - Erro '+inttostr(loClientSock.LastError)+' '+loClientSock.GetErrorDescEx;
                  Synchronize(@UpdateMemo1);
               end;
               break;
            end;
            s1:=loClientSock.RecvString(10000);
            r:=strtoint(s1);
            r2:=0;
            for r1:=1 to r do
            begin
               s1:=loClientSock.RecvString(10000);
               r2:=r2+strtoint(s1);
            end;
            loClientSock.SendString(inttostr(r2)+CRLF);
            if loClientSock.LastError>0 then
            begin
               Memo1Text:='ID '+clienteID+' SendString - Erro '+inttostr(loClientSock.LastError)+' '+loClientSock.GetErrorDescEx;
               Synchronize(@UpdateMemo1);
               break;
            end;
         end;
      end;
   finally
      loClientSock.CloseSocket ;
      loClientSock.Free;
   end;
end;

{ TForm1 }

procedure TForm1.cancela_buttonClick(Sender: TObject);
begin
cancelar:=True;
end;

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
SSocket.CloseSocket;
SSocket.Destroy;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
SSocket := TTCPBlockSocket.Create;
end;

procedure TForm1.servidor_modo_threadClick(Sender: TObject);
var
loSock : TSocket;
clienteID,s1:string;
r,r1,r2,x,x1:integer;
Daemon1:TTCPEchoDaemon;
begin
Memo1.Lines.Add('Modo Thread Ativado');
Application.ProcessMessages;
cancelar:=False;
Daemon1:=TTCPEchoDaemon.Create(memo1);
Daemon1.Resume;
end;

end.

Modulo Cliente

   
unit clientesynapse1_unit1;

{$mode objfpc}{$H+}

interface

uses
   Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
   StdCtrls, ExtCtrls, blcksock, DateUtils;

type

   { TForm1 }

   TForm1 = class(TForm)
      box_error: TCheckBox;
      envia3: TButton;
      finalizaauto: TCheckBox;
      disparo1: TCheckBox;
      Edit2: TEdit;
      envia2: TButton;
      envia: TButton;
      Edit1: TEdit;
      Label1: TLabel;
      Label2: TLabel;
      Memo1: TMemo;
      Timer1: TTimer;
      Timer2: TTimer;
      procedure envia3Click(Sender: TObject);
      procedure enviamodo1;
      procedure enviamodo2;
      procedure enviamodo3;
      procedure envia2Click(Sender: TObject);
      procedure enviaClick(Sender: TObject);
      procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
      procedure FormCreate(Sender: TObject);
      procedure FormShow(Sender: TObject);
      procedure Timer1Timer(Sender: TObject);
      procedure Timer2Timer(Sender: TObject);

   private
      { private declarations }
   public
      { public declarations }
   end;

var
   Form1: TForm1;
   SClient: TTCPBlockSocket;
   formID:string;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.enviamodo1;
var
S1:string;
x,x1:integer;
begin
timer2.Enabled:=False;
while true do
begin
   if not disparo1.Checked then break;
   if SysUtils.FileExists('disparo.dat') then break;
   Application.ProcessMessages;
   sleep(500);
end;

while true do
begin
   x:=DateUtils.SecondOfTheMinute(Time());
   if x in [1,16,31,46] then break;
end;
memo1.Lines.Clear;
Application.ProcessMessages;
x1:=strtoint(edit2.Text);
for x:=1 to x1 do
begin
   SClient.Connect('127.0.0.1','7000');
   if SClient.LastError<>0 then
   begin
   memo1.Lines.Add('Conexao de teste '+inttostr(x));
   memo1.Lines.add('Connect falhou - Erro '+inttostr(SClient.LastError)+' '+SClient.GetErrorDescEx);
   showmessage('Ocorreu um problema');
   timer2.Enabled:=True;
   exit;
   end;

   if SClient.CanWrite(100) then
   begin
      SClient.SendString('**teste1'+CRLF);
      SClient.SendString(FormID+CRLF);
      SClient.SendString(Edit1.Text+' '+inttostr(x)+CRLF);
      S1:=SClient.RecvString(10000);
      memo1.Lines.Add(S1);
   end;
   SClient.CloseSocket;
end;
memo1.Lines.add('**teste1 finalizado');
if finalizaauto.Checked then close;
timer2.Enabled:=True;
end;

procedure TForm1.envia3Click(Sender: TObject);
begin
enviamodo3;
end;

procedure TForm1.enviamodo2;
var
S1:string;
x,x1:integer;
begin
timer2.Enabled:=False;
while true do
begin
   if not disparo1.Checked then break;
   if SysUtils.FileExists('disparo.dat') then break;
   Application.ProcessMessages;
   sleep(500);
end;

while true do
begin
   x:=DateUtils.SecondOfTheMinute(Time());
   if x in [1,16,31,46] then break;
end;
memo1.Lines.Clear;
Application.ProcessMessages;
SClient.Connect('127.0.0.1','7000');
if SClient.LastError<>0 then
begin
   memo1.Lines.add('Connect falhou - Erro '+inttostr(SClient.LastError)+' '+SClient.GetErrorDescEx);
   showmessage('Ocorreu um problema');
   timer2.Enabled:=True;
   exit;
end;

if SClient.CanWrite(1000) then
begin
   SClient.SendString('**teste2'+CRLF);
   SClient.SendString(FormID+CRLF);
   SClient.SendString(edit2.text+CRLF);
   x1:=strtoint(edit2.Text);
   if SClient.LastError<>0 then
   begin
      memo1.Lines.add('SendString 1 Error '+inttostr(SClient.LastError)+' '+SClient.GetErrorDescEx);
   end;

   for x:=1 to x1 do
   begin
         SClient.SendString(Edit1.Text+' '+inttostr(x)+CRLF);
         if SClient.LastError<>0 then
         begin
            memo1.Lines.add('SendString 2 Error '+inttostr(SClient.LastError)+' '+SClient.GetErrorDescEx);
            if box_error.Checked then break;
         end;
         S1:=SClient.RecvString(10000);
         if SClient.LastError<>0 then
         begin
            memo1.Lines.add('RecvString 1 Error '+inttostr(SClient.LastError)+' '+SClient.GetErrorDescEx);
            if box_error.Checked then break;
         end;
         memo1.Lines.Add(S1);
   end;
end;
memo1.Lines.add('**teste2 finalizado');
SClient.CloseSocket;
SClient.Purge;
if finalizaauto.Checked then close;
timer2.Enabled:=True;
end;

procedure TForm1.enviamodo3;
var
S1:string;
r,r1,r2,x,x1,x2:integer;
TS1:TStringlist;
begin
randomize;
TS1:=TStringlist.Create;
timer2.Enabled:=False;
while true do
begin
   if not disparo1.Checked then break;
   if SysUtils.FileExists('disparo.dat') then break;
   Application.ProcessMessages;
   sleep(500);
end;

while true do
begin
   x:=DateUtils.SecondOfTheMinute(Time());
   if x in [1,16,31,46] then break;
end;
memo1.Lines.Clear;
Application.ProcessMessages;
SClient.Connect('127.0.0.1','7000');
if SClient.LastError<>0 then
begin
   memo1.Lines.add('Connect falhou - Erro '+inttostr(SClient.LastError)+' '+SClient.GetErrorDescEx);
   showmessage('Ocorreu um problema');
   timer2.Enabled:=True;
   exit;
end;

if SClient.CanWrite(1000) then
begin
   SClient.SendString('**teste3'+CRLF);
   SClient.SendString(FormID+CRLF);
   SClient.SendString(edit2.text+CRLF);
   x1:=strtoint(edit2.Text);
   if SClient.LastError<>0 then
   begin
      memo1.Lines.add('SendString 1 Error '+inttostr(SClient.LastError)+' '+SClient.GetErrorDescEx);
   end;

   for x:=1 to x1 do
   begin
      r:=10+trunc(random()*50);
      TS1.Clear;
      r2:=0;
      for x2:=1 to r do
      begin
         r1:=trunc(random()*100);
         r2:=r2+r1;
         TS1.Add(inttostr(r1));
      end;
      SClient.SendString('**soma_inicio'+CRLF);
      SClient.SendString(inttostr(TS1.Count)+CRLF);
      for x2:=0 to TS1.Count-1 do
      begin
         SClient.SendString(TS1[x2]+CRLF);
      end;
      S1:=SClient.RecvString(10000);
      if strtoint(S1)<>r2 then memo1.Lines.add('Erro de soma');
   end;
   memo1.Lines.add('**teste3 finalizado');
end;
SClient.CloseSocket;
SClient.Purge;
if finalizaauto.Checked then close;
timer2.Enabled:=True;
end;

procedure TForm1.enviaClick(Sender: TObject);
begin
enviamodo1;
end;

procedure TForm1.envia2Click(Sender: TObject);
begin
enviamodo2;
end;


procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
SClient.Destroy;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
s1:string;
begin
if fileexists('disparo.dat') then DeleteFile('disparo.dat');
if fileexists('closecli.dat') then DeleteFile('closecli.dat');
if fileexists('redisparo.dat') then DeleteFile('redisparo.dat');
SClient := TTCPBlockSocket.Create;
s1:=inttostr(DateUtils.MilliSecondOfTheHour(Time()));
formID:=s1;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
label2.Caption:=formID;
timer1.Enabled:=True;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
ts1:TStringlist;
x:integer;
begin
timer1.Enabled:=False;
if fileexists('cconfig.dat') then
begin
   ts1:=TStringlist.Create;
   ts1.LoadFromFile('cconfig.dat');
   for x:=0 to ts1.Count-1 do
   begin
      if ts1[x]='disparo' then
      begin
         disparo1.Checked:=True;
         memo1.Lines.Clear;
         memo1.Lines.Add('Aguardando disparo');
      end;
      if ts1[x]='boxerro' then box_error.Checked:=True;
      if ts1[x]='finaliza' then finalizaauto.Checked:=True;
      if copy(ts1[x],1,1)='0' then edit2.Text:=ts1[x];
   end;
   Application.ProcessMessages;
   for x:=0 to ts1.Count-1 do
   begin
      if ts1[x]='envia1' then enviamodo1;
      if ts1[x]='envia2' then enviamodo2;
      if ts1[x]='envia3' then enviamodo3;
   end;
end;
Application.ProcessMessages;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
if fileexists('closecli.dat')   then close;
if fileexists('redisparo.dat') then
begin
   memo1.Lines.Clear;
   memo1.Lines.Add('Aguardando disparo');
   Application.ProcessMessages;
   timer1.Enabled:=True;
end;
end;

end.


Modulo Controle dos Clientes

   
unit clientesynapse_control1_unit1;

{$mode objfpc}{$H+}

interface

uses
   Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
   StdCtrls;

type

   { TForm1 }

   TForm1 = class(TForm)
      box_error: TCheckBox;
      Engatilhar: TButton;
      n_sends: TEdit;
      Label2: TLabel;
      nenhum_evento: TRadioButton;
      reset1: TButton;
      gravar: TButton;
      disparo1: TCheckBox;
      fechar_processos: TButton;
      disparo: TButton;
      finalizaauto: TCheckBox;
      GroupBox1: TGroupBox;
      Label1: TLabel;
      modo1: TRadioButton;
      modo2: TRadioButton;
      modo3: TRadioButton;
      procedure disparoClick(Sender: TObject);
      procedure EngatilharClick(Sender: TObject);
      procedure fechar_processosClick(Sender: TObject);
      procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
      procedure FormCreate(Sender: TObject);
      procedure gravarClick(Sender: TObject);
      procedure reset1Click(Sender: TObject);
   private
      { private declarations }
   public
      { public declarations }
   end;

var
   Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
if fileexists('disparo.dat') then DeleteFile('disparo.dat');
if fileexists('closecli.dat') then DeleteFile('closecli.dat');
if fileexists('redisparo.dat') then DeleteFile('redisparo.dat');
end;

procedure TForm1.disparoClick(Sender: TObject);
var
s1:TStringlist;
begin
s1:=TStringlist.Create;
s1.add('start');
s1.SaveToFile('disparo.dat');
end;

procedure TForm1.EngatilharClick(Sender: TObject);
var
s1:TStringlist;
begin
if fileexists('disparo.dat') then DeleteFile('disparo.dat');
if fileexists('closecli.dat') then DeleteFile('closecli.dat');

s1:=TStringlist.Create;
s1.add('start');
s1.SaveToFile('redisparo.dat');

end;

procedure TForm1.fechar_processosClick(Sender: TObject);
var
s1:TStringlist;
x:integer;
begin
if fileexists('disparo.dat') then DeleteFile('disparo.dat');
if fileexists('redisparo.dat') then DeleteFile('redisparo.dat');
s1:=TStringlist.Create;
s1.add('close');
s1.SaveToFile('closecli.dat');

end;

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
if fileexists('disparo.dat') then DeleteFile('disparo.dat');
if fileexists('closecli.dat') then DeleteFile('closecli.dat');
end;

procedure TForm1.gravarClick(Sender: TObject);
var
s1:TStringlist;
begin
s1:=TStringlist.Create;
if strtointdef(n_sends.Text,0)>0 then s1.Add('0'+n_sends.Text);
if disparo1.Checked then s1.Add('disparo');
if finalizaauto.Checked then s1.Add('finaliza');
if box_error.Checked then s1.Add('boxerro');

if modo1.Checked then s1.Add('envia1');
if modo2.Checked then s1.Add('envia2');
if modo3.Checked then s1.Add('envia3');

s1.SaveToFile('cconfig.dat');

end;

procedure TForm1.reset1Click(Sender: TObject);
begin
if fileexists('disparo.dat') then DeleteFile('disparo.dat');
if fileexists('redisparo.dat') then DeleteFile('redisparo.dat');
if fileexists('closecli.dat') then DeleteFile('closecli.dat');

end;

end.