Creare un server multithread

Con questo articolo vedremo come realizzare un semplice socket server, utilizzando le librerie synapse.
Diamo per scontato che abbiamo installato e configurato tali librerie.
Apriamo Lazarus e creiamo una nuova applicazione console che salveremo con il nome "serverSock" e andiamo a sostituire le unit presenti con le seguenti

Codice: [Seleziona]

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, SysUtils, CustApp, echo, Unit_Operazioni
  { you can add units after this };


poi successivamente cerchiamo il pezzo di codice
Codice: [Seleziona]

  { add your program here }


e sotto aggiungiamo
Codice: [Seleziona]

  app:=TTCPEchoDaemon.create;
  app.Execute;
  // stop program loop
  Terminate;


Quindi la nostra applicazione risulterÓ la seguente

Codice: [Seleziona]

program serverSock;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, SysUtils, CustApp, echo, Unit_Operazioni
  { you can add units after this };

type

  { TMyServer }

  TMyServer = class(TCustomApplication)
  protected
    procedure DoRun; override;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure WriteHelp; virtual;
  end;

{ TMyServer }

procedure TMyServer.DoRun;
var
  ErrorMsg: String;
  app: TTCPEchoDaemon;
begin
  // quick check parameters
  ErrorMsg:=CheckOptions('h','help');
  if ErrorMsg'' then begin
    ShowException(Exception.Create(ErrorMsg));
    Terminate;
    Exit;
  end;

  // parse parameters
  if HasOption('h','help') then begin
    WriteHelp;
    Terminate;
    Exit;
  end;

  { add your program here }
  app:=TTCPEchoDaemon.create;
  app.Execute;
  // stop program loop
  Terminate;
end;

constructor TMyServer.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  StopOnException:=True;
end;

destructor TMyServer.Destroy;
begin
  inherited Destroy;
end;

procedure TMyServer.WriteHelp;
begin
  { add your help code here }
  writeln('Usage: ',ExeName,' -h');
end;

var
  Application: TMyServer;
begin
  Application:=TMyServer.Create(nil);
  Application.Title:='My Server Test';
  Application.Run;
  Application.Free;
end.


Successivamente andiamo a creare le seguenti unit

Codice: [Seleziona]

unit echo;

interface

uses
  Classes, blcksock, synsock, sysutils, users,  baseunix, Unit_Operazioni;

type
  TTCPEchoDaemon = class(TThread)
  private
    Sock:TTCPBlockSocket;
  public
    Constructor Create;
    Destructor Destroy; override;
    procedure Execute; override;
  end;

  TTCPEchoThrd = class(TThread)
  private
    Sock:TTCPBlockSocket;
    CSock: TSocket;
  public
    Constructor Create (hsock:tSocket);
    procedure Execute; override;
  end;

implementation

{ TEchoDaemon }

Constructor TTCPEchoDaemon.Create;
begin
  inherited create(false);
  sock:=TTCPBlockSocket.create;
  FreeOnTerminate:=true;
end;

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

procedure TTCPEchoDaemon.Execute;
var
  ClientSock:TSocket;
  Porta: string;
  Host: string;
begin
  Porta:='2408';
  Host:='0.0.0.0';
  with sock do
    begin
      CreateSocket;
      setLinger(true,10000);
      bind(Host,Porta);
      listen;
      repeat
        if terminated then break;
        if canread(1000) then
          begin
            ClientSock:=accept;
            if lastError=0 then TTCPEchoThrd.create(ClientSock);
          end;
      until false;
    end;
end;

{ TEchoThrd }

Constructor TTCPEchoThrd.Create(Hsock:TSocket);
begin
  inherited create(false);
  Csock := Hsock;
  FreeOnTerminate:=true;
end;

procedure TTCPEchoThrd.Execute;
var
  s: string;
begin
  sock:=TTCPBlockSocket.create;
  try
    Sock.socket:=CSock;
    sock.GetSins;
    with sock do
      begin
        repeat
          if terminated then break;
          s := RecvPacket(60000);
          //devo eliminare i caratteri di andata a capo, altrimenti sono
          //nella stringa letta e non riesco a fare i controlli
          s:=stringReplace(s, #13 , '', [RfReplaceAll]);
          s:=stringReplace(s, #10 , '', [RfReplaceAll]);
          if lastError0 then break;

          if s='GETDATE' then
          begin
               GetDate(sock);
          end
          else if s='GETHOUR' then
          begin
               GetHour(sock);
          end
          else if s='GETMENU' then
          begin
               GetMenu(sock);
          end
          else
          begin
               SendString('Comando non valido: ' + s + System.LineEnding);
               SendString('Comandi validi: ' + System.LineEnding);
               SendString('GETDATE' + System.LineEnding);
               SendString('GETHOUR' + System.LineEnding);
               SendString('GETMENU' + System.LineEnding);
          end;
          writeln(Sock.GetRemoteSinIP + ': '+ IntToStr(Sock.GetRemoteSinPort) + ' (' + IntToStr(Self.ThreadID) + ')--> ' + s);

          if lastError0 then break;
        until false;
      end;
  finally
    Sock.Free;
  end;
end;

end.


Per prima cosa andiamo ad impostare i dati essenziali per la messa online del server e quindi cerchiamo le seguenti righe

  Porta:='2408';
  Host:='0.0.0.0';

e modifichiamole come pi¨ ci aggrada. In seconda battuta prendiamo atto che la procedura da personalizzare in funzione delle nostre esigenze ha il seguente nome:

procedure TTCPEchoThrd.Execute;

All'interno di tale procedura notiamo che la prima cosa che si fa Ŕ mettersi in ascolto in attesa di una stringa, alla quale andiamo ad eliminare i caratteri tipici del tasto "INVIO" o "ENTER"
Codice: [Seleziona]

          s := RecvPacket(60000);
          //devo eliminare i caratteri di andata a capo, altrimenti sono
          //nella stringa letta e non riesco a fare i controlli
          s:=stringReplace(s, #13 , '', [RfReplaceAll]);
          s:=stringReplace(s, #10 , '', [RfReplaceAll]);


Successivamente troviamo il seguente codice:

Codice: [Seleziona]

          if s='GETDATE' then
          begin
               GetDate(sock);
          end
          else if s='GETHOUR' then
          begin
               GetHour(sock);
          end
          else if s='GETMENU' then
          begin
               GetMenu(sock);
          end
          else
          begin
               SendString('Comando non valido: ' + s + System.LineEnding);
               SendString('Comandi validi: ' + System.LineEnding);
               SendString('GETDATE' + System.LineEnding);
               SendString('GETHOUR' + System.LineEnding);
               SendString('GETMENU' + System.LineEnding);
          end;


Che ha lo scopo di interpretare il comando ricevuto precedentemente, nel caso il comando coincida con GETDATE o con GETTIME o GETMENU allora il server effettua l'operazione corrispondente, diversamente il server ritorna al client (che pu˛ essere anche una sessione telnet) la lista dei comandi validi.
Poi troviamo la seguente riga

Codice: [Seleziona]

writeln(Sock.GetRemoteSinIP + ': '+ IntToStr(Sock.GetRemoteSinPort) + ' (' + IntToStr(Self.ThreadID) + ')--> ' + s);


che ha lo scopo di scrivere sullo standard output del server l'indirizzo ip del client seguito dal numero di porta, dall'identificativo del thread  che pu˛ essere usato come identificativo di sessione e poi il comando ricevuto dal client.

In ultima battuta creiamo la seguente unit

Codice: [Seleziona]
unit Unit_Operazioni;

{$mode objfpc}{$H+}

interface

uses
  Classes, blcksock, synsock, sysutils, users,  baseunix ;

  procedure GetDate(var sock: TTCPBlockSocket);
  procedure GetHour(var sock: TTCPBlockSocket);
  procedure GetMenu(var sock: TTCPBlockSocket);
implementation

procedure GetDate(var sock: TTCPBlockSocket);
begin
     with sock do
     begin
          SendString(DateToStr(Date) + System.LineEnding);
     end;
end;

procedure GetHour(var sock: TTCPBlockSocket);
begin
  with sock do
  begin
     SendString(TimeToStr(Time) + System.LineEnding);
  end;
end;

procedure GetMenu(var sock: TTCPBlockSocket);
begin
  with sock do
  begin
     SendString('-------------------------------------' + System.LineEnding);
     SendString('|    PROVA DI UN                           |' + System.LineEnding);
     SendString('|           SEMPLICE                         |' + System.LineEnding);
     SendString('|                   MENU                        |' + System.LineEnding);
     SendString('|                       !!!                         |' + System.LineEnding);
     SendString('-------------------------------------' + System.LineEnding);
  end;
end;

end.

Quest'ultima unit contiene il codice che risponde ai comandi validi del server, con GETDATE inviamo al client la data attuale sul server, con GETTIME inviamo l'ora e con GETMENU inviamo un simil men¨ con aspetto retr˛.

Per far funzionare il tutto dobbiamo

Progetto -> Opzioni progetto -> Varie

e in Opzioni Personalizzate inseriamo la seguente stringa: -dUseCThreads

Ora compiliamo, e avviamo l'eseguibile dal Terminale/Console/Prompt, poi avviamo un altro Terminale/Console/Prompt e digitiamo (nel caso Host e Porta non siamo cambiati) il comando: telnet localhost 2408
Ovviamente se cambiate il numero di porta agite di conseguenza nel parametrizzare la sessione telnet.


SMF 2.0.8 | SMF © 2011, Simple Machines
Privacy Policy
SMFAds for Free Forums
TinyPortal © 2005-2012

Go back to article