Newsgroup: it.comp.lang.delphi
Titolo: Client Server TCPIP con Indy 10

Invio un esempio da me implementato di Client/Server costruito mediante i 
componenti TidTCPClient e Server di INDY 10.
Sia il Server che il Client lavorano sotto thread, il Client invia un 
comando mediante la variabile stringa "CmdChiesto" ed eventuali parametri 
usando la TStringList ParamChiesto.
In "EseguiComando" il Server invia i dati richiesti dal Client.
Ricevuti i dati dal Server questi vengono elaborati dal Client in 
"GestisciDatiRichiesti" con la dovuta sincronizzazione col thread 
principale.
Giorgio
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Winsock, Syncobjs,
  IdTCPServer, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdContext, IdStack, IdSocketHandle, IdIOHandler, IdCmdTCPServer, 
IdStreamVCL;
const CM_TEXT = WM_USER+100;
type
  PDatiClient   = ^TDatiClient;
  TDatiClient   = record
    PeerIP      : string[15];            { Cleint IP address }
    HostName    : String[40];            { Hostname }
    TakeShot    : boolean;
    Connected,                           { Time of connect }
    LastAction  : TDateTime;             { Time of last transaction }
    Thread      : Pointer;               { Pointer to thread }
    end;
  TClientTh = Class(TThread)
    private
      Client: TidTCPClient;
      Comando: String;
      Parametri: TStringList;
      BuffCli: TMemorystream;
      WrappStreamCli: TIdStreamVCL;
      function InviaComando: Boolean;
      procedure GestisciDatiRichiesti;
    protected
      procedure TerminaTh(Sender: TObject);
      procedure Execute; override;
    public
      Punta: PInteger;
      constructor Create(ClientSocket: TidTCPClient);
    end;
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    ListBox1: TListBox;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Client1: TIdTCPClient;
    Server1: TIdTCPServer;
    procedure Button6Click(Sender: TObject);
    procedure Client1Status(ASender: TObject; const AStatus: TIdStatus;
              const AStatusText: string);
    procedure Client1Connected(Sender: TObject);
    procedure Server1Disconnect(AContext: TIdContext);
    procedure Server1Execute(AContext: TIdContext);
    procedure Server1Connect(AContext: TIdContext);
    procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  protected
    procedure CMText(var Msg: TMessage); Message CM_TEXT;
  private
    { Private declarations }
    AvvisoServer: String;
    Clients: TThreadList;
    CritSect: TCriticalSection;
    CritSectServer: TCriticalSection;
    ClientTh: TClientTh;
    procedure Lock;
    procedure UnLock;
    procedure AddAvviso(st: String);
    procedure Sconnetti;
  public
    { Public declarations }
    CodaCmd: TStringList;
  end;
var
  Form1: TForm1;
  Path, CmdChiesto : String; ParamChiesto: TStringList;
implementation
{$R *.dfm}
Uses Unit2;
procedure TForm1.FormCreate(Sender: TObject);
begin
Path:=ExtractFileDir(Application.ExeName);
Clients:=TThreadList.Create;
Clients.Duplicates:=dupAccept;
CritSect:=TCriticalSection.Create;
CritSectServer:=TCriticalSection.Create;
ParamChiesto:=TStringList.Create;
Server1.Active:=True;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// Invia il cmd di disconnetti e chiude il ClientTh
Sconnetti;
Server1.Active:=False;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
CodaCmd.Free;
Clients.Free;
CritSect.Free;
CritSectServer.Free;
ParamChiesto.Free;
end;
//******************************* Lato Client 
**********************************
//******************************************************************************
procedure TForm1.Lock;
begin
CritSect.Enter;
end;
procedure TForm1.UnLock;
begin
CritSect.Leave;
end;
// Il Client chiede la Connessione
procedure TForm1.Button1Click(Sender: TObject);
begin
if Client1.Connected then exit;
Label1.Caption:='';
Label2.Caption:='';
if Not Client1.Connected then
  Client1.Connect;
end;
procedure TForm1.Sconnetti;
begin
if ClientTh<>Nil then
  // Invia il cmd di disconnetti al Server
  ClientTh.Terminate;
if Client1.Connected then
  Client1.Disconnect;
end;
// Disconnetti
procedure TForm1.Button2Click(Sender: TObject);
begin
Sconnetti;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
if Not Client1.Connected then exit;
Lock;
CmdChiesto:='NIL';
ParamChiesto.Clear;
UnLock;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
if Not Client1.Connected then exit;
Lock;
CmdChiesto:='GETSTRINGA';
ParamChiesto.Clear;
UnLock;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
if Not Client1.Connected then exit;
Lock;
CmdChiesto:='GETIMMAGINE';
ParamChiesto.Clear;
ParamChiesto.Add('Image.bmp');
Unlock;
end;
// Disconnetti dal Server
procedure TForm1.Button6Click(Sender: TObject);
begin
Lock;
CmdChiesto:='QUIT';
ParamChiesto.Clear;
UnLock;
end;
procedure TForm1.Client1Connected(Sender: TObject);
begin
Label1.Caption:='Client Connesso';
CmdChiesto:='';
// Crea e avvia il Client Thread
if ClientTh=Nil then
  begin
  ClientTh:=TClientTh.Create(Client1);
  ClientTh.Punta:=@ClientTh;
  end;
end;
procedure TForm1.Client1Status(ASender: TObject; const AStatus: TIdStatus;
          const AStatusText: string);
begin
if AStatus=hsDisconnected then
  begin
  Label1.Caption:='';
  Label2.Caption:='Client Sconnesso!!!';
  end;
end;
constructor TClientTh.Create(ClientSocket: TidTCPClient);
begin
Client:=ClientSocket;
OnTerminate:=TerminaTh;
FreeOnTerminate:=True;
// Attiva subito il Thread
inherited Create(False);
end;
procedure TClientTh.TerminaTh(Sender: TObject);
begin
Punta^:=Integer(Nil);
end;
function TClientTh.InviaComando: Boolean;
begin
Result:=False;
BuffCli:=TMemoryStream.Create;
WrappStreamCli:=TIdStreamVCL.Create(BuffCli, True);
Try
  Parametri.SaveToStream(WrappStreamCli.VCLStream);
  // Invia il Comando e i Parametri (TStringList)
  With Client.IOHandler do
    begin
    Writeln(Comando);
    Write(WrappStreamCli.Size);
    WriteBufferOpen;
    Write(WrappStreamCli);
    WriteBufferClose;
    end;
  Result:=True;
finally
  FreeAndNil(WrappStreamCli);
  end;
end;
procedure TClientTh.GestisciDatiRichiesti;
var Dim: Integer;
begin
With Client.IOHandler do
  if AnsiSameText(Comando,'GETIMMAGINE') then
    begin
    BuffCli:=TMemoryStream.Create;
    WrappStreamCli:=TIdStreamVCL.Create(BuffCli, True);
    Try
      Dim:=ReadInteger(True);
      ReadStream(WrappStreamCli,Dim,False);
      WrappStreamCli.Position:=0;
      Form2.Image1.Picture.Bitmap.LoadFromStream(BuffCli);
      Form2.Show;
    Finally
      //FreeAndNil(BuffCli);
      FreeAndNil(WrappStreamCli);
      end;
    end
  else
  if AnsiSameText(Comando,'GETSTRINGA') then
    Form1.Label2.Caption:=ReadLn;
end;
procedure TClientTh.Execute;
begin
Parametri:=TStringList.Create;
Try
  // Loop
  While Not Terminated And Client.Connected do
    begin
    // Leggo un Comando
    Form1.Lock;
    Comando:=Trim(CmdChiesto);
    CmdChiesto:='';
    Parametri.AddStrings(ParamChiesto); //Or AnsiSameText(Comando,'NIL')
    Form1.UnLock;
    if Comando='' then
      begin // Se nessun Cmd presente Itera
      Sleep(20);
      Continue;
      end;
    // Invio il Comando con i Parametri
    if Not InviaComando then
      exit;
    // Gestione Dati richiesti
    GestisciDatiRichiesti;
    end;
    // Fine Loop
finally
  FreeAndNil(Parametri);
  Terminate;
  end;
end;
//****************************** Lato Server 
***********************************
//******************************************************************************
procedure TForm1.Server1Connect(AContext: TIdContext);
var
  NewClientData: PDatiClient;
begin
  GetMem(NewClientData, SizeOf(TDatiClient));
  NewClientData.PeerIP      := AContext.Connection.Socket.Binding.PeerIP;
  NewClientData.HostName    := GStack.HostByAddress(NewClientData.PeerIP);
  NewClientData.Connected   := Now;
  NewClientData.LastAction  := NewClientData.Connected;
  NewClientData.Thread      := AContext;
  AContext.Data := TObject(NewClientData);
  AddAvviso('Connessione Client: '+ NewClientData.PeerIP+' accettata');
  try
    Clients.LockList.Add(NewClientData);
  finally
    Clients.UnlockList;
  end;
end;
procedure TForm1.Server1Disconnect(AContext: TIdContext);
begin
Clients.Remove(AContext.Data);
FreeMem(PDatiClient(AContext.Data), SizeOf(TDatiClient));
AContext.Data:=Nil;
end;
procedure TForm1.CMText(var Msg: TMessage);
var n: Integer;
begin
CritSectServer.Enter;
  n:=ListBox1.Count;
  // Mantiene solo gli ultimi 15 Msg
  if n>=15 then
    ListBox1.Items.Delete(n-1);
  ListBox1.Items.Insert(0,AvvisoServer);
CritSectServer.Leave;
end;
procedure TForm1.AddAvviso(st: String);
begin
CritSectServer.Enter;
AvvisoServer:=st;
PostMessage(Handle,CM_TEXT,0,0);
CritSectServer.Leave;
end;
// Viene eseguita Iterativamente fino alla Disconnessione
procedure TForm1.Server1Execute(AContext: TIdContext);
var Comando: String; Parametri: TStringList; Dim: Integer;
    BuffWr: TMemoryStream; WrappStream: TIdStreamVCL; Bmp1: TBitmap;
  function EseguiComando: Boolean;
  var cmd, st: String;
    begin
    With AContext.Connection.IOHandler do
      begin
      Result:=True;
      cmd:=Trim(Comando);
      // Comando di chiusura
      if AnsiSameText(cmd,'QUIT') then
        begin
        AddAvviso('Il Client chiede di chiudere la connessione');
        AContext.Connection.Disconnect;
        Result:=False;
        end
      else
      // Comando nullo
      if AnsiSameText(cmd,'NIL') then
        exit
      else
      // Esegue il comando
      if AnsiSameText(cmd,'GETSTRINGA') then
        begin
        st:='Stringa dei dati richiesti';
        WriteLn(st);
        end
      else
      // Esegue il comando
      if AnsiSameText(cmd,'GETIMMAGINE') then
        begin
        // Legge l'immagine e la salva nello Stream
        Bmp1:=TBitmap.Create;
        st:=Path+'\'+Parametri[0];
        Bmp1.LoadFromFile(st);
        Bmp1.SaveToStream(WrappStream.VCLStream);
        Bmp1.Free;
        // Invia lo Stream
        Write(WrappStream.Size);
        WriteBufferOpen;
        Write(WrappStream);
        WriteBufferClose;
        end
      else
        // Comando Sconosciuto
        begin
        AddAvviso('Comando sconoscito!!!');
        end
      end;
    end;
// Eseguita di continuo dal Thread del Server
begin
if Not AContext.Connection.Connected then exit;
//
BuffWr:=TMemoryStream.Create;
WrappStream:=TIdStreamVCL.Create(BuffWr, True);
Parametri:=TStringList.Create;
Try
  // Legge il comando
  With AContext.Connection.IOHandler do
    begin
    // Attende il Comando e i Parametri
    Comando:=Readln;
    Dim:=ReadInteger(True);
    ReadStream(WrappStream,Dim,False);
    WrappStream.Position:=0;
    Parametri.LoadFromStream(BuffWr);
    BuffWr.Clear;
    //
    EseguiComando;
    end;
Finally
  FreeAndNil(WrappStream);
  FreeAndNil(Parametri);
  end;
end;
end. 

CritSectServer.Leave;
Idem, la Leave deve stare in un blocco finally.

 dell'errore.
Che fai il critico "Sgarbi" della News?
Un errore sostanziale c'e' nel codice postato dal momento che per errore ho 
inserito la versione vecchia dove era ancora
presente.
Giorgio 

 inserito la versione vecchia dove era ancora presente.
..eh?
-- 
questo articolo e` stato inviato via web dal servizio gratuito 
http://www.newsland.it/news
 segnala gli abusi ad 
ab...@newsland.it

 benissimo criticare il codice che posti.
Ma cosa vuoi criticare fammi un piacere... se l'unico errore che c'e' ti e' 
passato inosservato
Giorgio 

se l'unico errore che c'e' ti e' passato inosservato
Irrilevante: il tuo codice è pieno zeppo di errori, se lo vuoi sapere.
