Delphi – Indy idTCPServer 和 idTCPClient

这是Delphi中的Nevrona Indy组件使用TCP / IP协议创建小型服务器应用程序的一个简单示例。为了简化，我们可以构建一个示例，其中有一个服务器应用程序从客户端应用程序接收字符串，然后将该字符串返回给客户端，但是我们使用流来执行此操作，因为可以重用该示例来通过流进行其他操作。

在此示例中，我们使用 TStringStream 类，该类将 TStream 作为祖先，并且非常容易与字符串一起使用。

从Delphi开始并创建一个简单的表单应用程序，现在我们将TidTCPServer组件拖到主表单上，现在我们需要确定此服务的免费TCP端口，在此应用程序中我们使用9099端口。，这里是服务器应用程序的简单来源：

Delphi/Pascal

unit Main_Unit_Server;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, IdBaseComponent, IdComponent, IdTCPServer, StdCtrls, Buttons, IdSocketHandle,

  IdServerIOHandler, IdServerIOHandlerSocket, IdUDPBase, IdUDPServer,

  IdAntiFreezeBase, IdAntiFreeze, IdMappedPortTCP, IdThreadMgr,

  IdThreadMgrDefault;

type

  TServer_Form = class(TForm)

    TCP_Server: TIdTCPServer;

    ListBox1: TListBox;

    Start_Server_Button: TSpeedButton;

    Stop_Server_Button: TSpeedButton;

    Label1: TLabel;

    Bind_IP: TEdit;

    Bind_Port: TEdit;

    ListBox2: TListBox;

    IdAntiFreeze1: TIdAntiFreeze;

    SpeedButton1: TSpeedButton;

    IdThreadMgrDefault1: TIdThreadMgrDefault;

    ckAutoReply: TCheckBox;

    ckVideoResult: TCheckBox;

    procedure FormCreate(Sender: TObject);

    procedure Start_Server_ButtonClick(Sender: TObject);

    procedure Stop_Server_ButtonClick(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure TCP_Server__Connect(AThread: TIdPeerThread);

    procedure TCP_ServerExecute(AThread: TIdPeerThread);

    procedure TCP_ServerNoCommandHandler(ASender: TIdTCPServer;

      const AData: String; AThread: TIdPeerThread);

    procedure TCP_ServerConnect(AThread: TIdMappedPortThread);

    procedure SpeedButton1Click(Sender: TObject);

    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

    procedure TCP_ServerDisconnect(AThread: TIdPeerThread);

  private

    procedure ShowClientsConnected;

    function StopTheServer: Boolean;

    { Private declarations }

  public

    { Public declarations }

    ListaClient : TList;

  end;

var

  Server_Form: TServer_Form;

implementation

uses IdTCPConnection;

{$R *.dfm}

procedure TServer_Form.FormCreate(Sender: TObject);

begin

     Top:=0;

     Left:=0;

     Start_Server_ButtonClick(Nil);

     ListaClient := TList.Create;

end;

procedure TServer_Form.Start_Server_ButtonClick(Sender: TObject);

var Loc_Binding : TIdSocketHandle;

begin

     if TCP_Server.Active then begin

      Exit;

     end;

     try

       TCP_Server.DefaultPort := 9099;

       TCP_Server.Active:=True; 

       if ListBox1.Items.Count>10

        then ListBox1.Items.Delete(0);

       if TCP_Server.Active then 

        begin

         ListBox1.Items.Add('Server started .... '+TCP_Server.Bindings.Items[0].IP+':'+IntToStr(TCP_Server.Bindings.Items[0].Port));

        end 

       else

       begin

         ListBox1.Items.Add('ERROR. Cannot start server .... ');

         Exit;

       end;

      except

       ListBox1.Items.Add('ERROR. Setting-up server .... ');

       Exit;

     end;

end;

procedure TServer_Form.Stop_Server_ButtonClick(Sender: TObject);

begin

     if not TCP_Server.Active then Exit;

     try

        TCP_Server.Active := False; 

     except 

     end;

end;

procedure TServer_Form.FormClose(Sender: TObject;

  var Action: TCloseAction);

begin

     if Action=caFree then begin

      if TCP_Server.Active then begin

       Stop_Server_ButtonClick(Nil);

      end;

     end;

end;

procedure TServer_Form.TCP_Server__Connect(AThread: TIdPeerThread);

Var s : String;

begin

     ShowClientsConnected;

     if ListBox2.Items.Count>10 

       then ListBox2.Items.Delete(0);

     ListBox2.Items.Add( 'Client is connected from '+

                         AThread.Connection.Socket.Binding.IP+':'+

                         IntToStr(AThread.Connection.Socket.Binding.Port) );

     // imposto un buffer piccolo

     AThread.Connection.RecvBufferSize := 65536 div 4;

     AThread.Connection.SendBufferSize := 65536 div 4;

     ListaClient.Add(AThread);

end;

// Execute è il metodo principe , che intercetta le chiamate dei Client

procedure TServer_Form.TCP_ServerExecute(AThread: TIdPeerThread);

Var

 S,Resp : String;

 Data : String;

 I      : Integer;

 Ms     : TStringStream;

Begin

 Try

  Try

   Data := '';

   Ms := nil;

   Try

     Ms     := TStringStream.Create('');

     Ms.Position := 0;

     AThread.Connection.ReadStream(Ms);

     Ms.Position := 0;

     Data := Ms.DataString;

     if ckVideoResult.Checked then

        ListBox2.Items.Add(AThread.Connection.Socket.Binding.IP+' --> '+Data);

   Except

     On E:Exception do

      Begin

       ListBox2.Items.Add('Errore [1]: ' +  E.Message);

      End;

   End;

   If ckAutoReply.Checked then

    Begin

        MS := TStringStream.Create('Giovanni dice : ' + Data);

        Ms.Position := 0;

        AThread.Connection.WriteStream(MS,True,True);

        Try Ms.Free; Except End;

    End;

        //Resp := TClientManager(AThread.Data).CommandParser(Data,True);

  Except

   On E:Exception do

     ListBox2.Items.Add('Errore [2]: ' +  E.Message);

  End;

 Finally

  If ms <> nil then

    Try Ms.Free; Except End;

 End;

end;

// Sending a string to all connected clients

procedure TServer_Form.SpeedButton1Click(Sender: TObject);

Var

  i:Integer;

  ms : TStringStream;

begin

     try

       TCP_Server.Threads.LockList;

       for i:=0 to  ListaClient.Count-1 do

        Begin

         MS := TStringStream.Create('Invio massivo dati');

         Ms.Position := 0;

         TIdPeerThread(ListaClient[i]).Connection.WriteStream(MS,True,True);

         Try Ms.Free; Except End;

        End;

      finally

       TCP_Server.Threads.UnlockList;

     end;

end;

procedure TServer_Form.FormCloseQuery(Sender: TObject;

  var CanClose: Boolean);

begin

 Try TCP_Server.Active := False; Except End;

 CanClose := True;

end;

procedure TServer_Form.TCP_ServerDisconnect(AThread: TIdPeerThread);

begin

 ListaClient.Remove(AThread);

end;

end.

客户端应用程序也很简单，我们使用delphi创建另一个应用程序，并拖动TidTCPClient指定服务器的相同TCP端口和服务器的addrres：

unit Main_Unit_Client;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,

  StdCtrls, IdUDPBase, IdUDPClient, ExtCtrls, IdIntercept, IdSocks,

  IdIOHandlerSocket, IdIOHandler, IdIOHandlerStream;

type

  TForm1 = class(TForm)

    TCP_Client: TIdTCPClient;

    Label2: TLabel;

    Label3: TLabel;

    Host_Address: TEdit;

    Host_Port: TEdit;

    Connect_Button: TButton;

    btnDisconnect: TButton;

    ListBox1: TListBox;

    Edit1: TEdit;

    Button1: TButton;

    ListBox2: TListBox;

    pnlSemaforo: TPanel;

    btnMultiSend: TButton;

    ckVideoResult: TCheckBox;

    Timer1: TTimer;

    btn_startTimer: TButton;

    procedure Connect_ButtonClick(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure btnDisconnectClick(Sender: TObject);

    procedure Button1Click(Sender: TObject);

    procedure TCP_ClientConnected(Sender: TObject);

    procedure TCP_ClientDisconnected(Sender: TObject);

    procedure btnMultiSendClick(Sender: TObject);

    procedure Timer1Timer(Sender: TObject);

    procedure btn_startTimerClick(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

var

  Form1: TForm1;

implementation

{$R *.dfm}

uses DateUtils;

procedure TForm1.Connect_ButtonClick(Sender: TObject);

begin

     if TCP_Client.Connected then begin

      TCP_Client.Disconnect;

      Exit;

     end;

     ListBox1.Clear;

     ListBox2.Clear;

     try

        TCP_Client.Host :=Host_Address.Text;

        TCP_Client.Port :=StrToInt(Host_Port.Text);

        TCP_Client.Connect(1000);

        ListBox1.Clear;

      except

        ListBox1.Items.Add('ERROR trapped while trying to connect'); 

     end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

     Top:=0;

     Left:=Screen.Width-Width-30;

     Hide;

     //FormStyle:=fsStayOnTop;

     Show;

end;

procedure TForm1.btnDisconnectClick(Sender: TObject);

begin

     if TCP_Client.Connected then begin

      TCP_Client.Disconnect;

     end;

end;

procedure TForm1.Button1Click(Sender: TObject);

Var

  s:String;

  MS : TStringStream;

begin

 if TCP_Client.Connected then begin

    MS := TStringStream.Create(Edit1.Text);

    MS.Position := 0;

    TCP_Client.WriteStream(MS,true,true);

    MS.Position := 0;

    if ckVideoResult.Checked then

       ListBox1.Items.Add('Sent ....: ' + MS.DataString);

    Try MS.Free; Except End;

    MS := TStringStream.Create('');

    MS.Position := 0;

    TCP_Client.ReadStream(MS);

    MS.Position := 0;

    if ckVideoResult.Checked then

      ListBox1.Items.Add('Recived ....: ' + MS.DataString);

    Try MS.Free; Except End;

 end;

end;

procedure TForm1.TCP_ClientConnected(Sender: TObject);

begin

     ListBox2.Items.Add('On Conneted');

     pnlSemaforo.Color := clLime;

end;

procedure TForm1.TCP_ClientDisconnected(Sender: TObject);

begin

     pnlSemaforo.Color := clRed;

end;

procedure TForm1.btnMultiSendClick(Sender: TObject);

Var

 I,J : Integer;

 N1,N2 : TDateTime;

begin

 Try

   I := StrToInt(InputBox('Nr. di comunicazioni : ', 'Nr. di comunicazioni : ', '100'));

 Except

   I := 10;

 End;

 N1 := now;

 For J:=0 to I do

  Button1Click(nil);

 N2 := now;

 ShowMessage('Millisecondi totali: ' + IntToStr(DateUtils.MilliSecondsBetween(n1,n2)) + ' millisecondi per operazione:' + IntToStr(DateUtils.MilliSecondsBetween(n1,n2) div I));

end;

procedure TForm1.Timer1Timer(Sender: TObject);

Var

  s:String;

  MS : TStringStream;

begin

 if TCP_Client.Connected then

  begin

   Try

    MS := TStringStream.Create('');

    MS.Position := 0;

    TCP_Client.ReadStream(MS);

    MS.Position := 0;

    if ckVideoResult.Checked then

      ListBox1.Items.Add('Recived ....: ' + MS.DataString);

    Try MS.Free; Except End;

   Except

   End;

 end;

end;

procedure TForm1.btn_startTimerClick(Sender: TObject);

begin

 Timer1.Enabled := True;

end;

end.