¿我如何从tidtcpclient和tidtcpserver发送和接收字符串并创建聊天？

Question

im new at delphi languaje and im using Rad Studio to make apps work on every device with oune single programming. Right now Im supposed to make a chat using sockets, I made a chat for windows only using tclientsocket and tserversocket using the next code, what Im trying to do is make the exact thing but using tidtcpclient and tidtcpserver instead of tclientsocket and tserversocket

Server:

unit Server;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, System.Win.ScktComp, Vcl.StdCtrls;

type
  TServidor = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    ServerSocket1: TServerSocket;
    Memo1: TMemo;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ServerSocket1ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Servidor: TServidor;
  Str: String;

implementation

{$R *.dfm}

procedure TServidor.Button1Click(Sender: TObject);
var
  i: integer;
begin
     Str:=Edit1.Text;//Take the string (message) sent by the server
     Memo1.Text:=Memo1.Text+'yo: '+Str+#13#10;//Adds the message to the memo box
     Edit1.Text:='';//Clears the edit box
//Sends the messages to all clients connected to the server
     for i:=0 to ServerSocket1.Socket.ActiveConnections-1 do
      ServerSocket1.Socket.Connections[i].SendText(str);//Sent
end;

procedure TServidor.Button2Click(Sender: TObject);
begin
   if(ServerSocket1.Active = False)//The button caption is ‘Start’
   then
   begin
      ServerSocket1.Active := True;//Activates the server socket
      Memo1.Text:=Memo1.Text+'Servidor en linea'+#13#10;
      Button2.Caption:='Apagar';//Set the button caption
   end
   else//The button caption is ‘Stop’
   begin
      ServerSocket1.Active := False;//Stops the server socket
      Memo1.Text:=Memo1.Text+'Servidor fuera de linea'+#13#10;
      Button2.Caption:='Encender';
     //If the server is closed, then it cannot send any messages
      Button1.Enabled:=false;//Disables the “Send” button
      Edit1.Enabled:=false;//Disables the edit box
   end;
end;

procedure TServidor.ServerSocket1ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Socket.SendText('Conectado');//Sends a message to the client
//If at least a client is connected to the server, then the server can communicate
//Enables the Send button and the edit box
  Button1.Enabled:=true;
  Edit1.Enabled:=true;
end;

procedure TServidor.ServerSocket1ClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
Begin
//The server cannot send messages if there is no client connected to it
  if ServerSocket1.Socket.ActiveConnections-1=0 then
  begin
    Button1.Enabled:=false;
    Edit1.Enabled:=false;
  end;
end;

procedure TServidor.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
Begin
//Read the message received from the client and add it to the memo text
// The client identifier appears in front of the message
  Memo1.Text:=Memo1.Text+'Cliente'+IntToStr(Socket.SocketHandle)+' :'+Socket.ReceiveText+#13#10;
end;

end.

Client

unit Server;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, System.Win.ScktComp, Vcl.StdCtrls;

type
  TServidor = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    ServerSocket1: TServerSocket;
    Memo1: TMemo;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ServerSocket1ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Servidor: TServidor;
  Str: String;

implementation

{$R *.dfm}

procedure TServidor.Button1Click(Sender: TObject);
var
  i: integer;
begin
     Str:=Edit1.Text;//Take the string (message) sent by the server
     Memo1.Text:=Memo1.Text+'yo: '+Str+#13#10;//Adds the message to the memo box
     Edit1.Text:='';//Clears the edit box
//Sends the messages to all clients connected to the server
     for i:=0 to ServerSocket1.Socket.ActiveConnections-1 do
      ServerSocket1.Socket.Connections[i].SendText(str);//Sent
end;

procedure TServidor.Button2Click(Sender: TObject);
begin
   if(ServerSocket1.Active = False)//The button caption is ‘Start’
   then
   begin
      ServerSocket1.Active := True;//Activates the server socket
      Memo1.Text:=Memo1.Text+'Servidor en linea'+#13#10;
      Button2.Caption:='Apagar';//Set the button caption
   end
   else//The button caption is ‘Stop’
   begin
      ServerSocket1.Active := False;//Stops the server socket
      Memo1.Text:=Memo1.Text+'Servidor fuera de linea'+#13#10;
      Button2.Caption:='Encender';
     //If the server is closed, then it cannot send any messages
      Button1.Enabled:=false;//Disables the “Send” button
      Edit1.Enabled:=false;//Disables the edit box
   end;
end;

procedure TServidor.ServerSocket1ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Socket.SendText('Conectado');//Sends a message to the client
//If at least a client is connected to the server, then the server can communicate
//Enables the Send button and the edit box
  Button1.Enabled:=true;
  Edit1.Enabled:=true;
end;

procedure TServidor.ServerSocket1ClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
Begin
//The server cannot send messages if there is no client connected to it
  if ServerSocket1.Socket.ActiveConnections-1=0 then
  begin
    Button1.Enabled:=false;
    Edit1.Enabled:=false;
  end;
end;

procedure TServidor.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
Begin
//Read the message received from the client and add it to the memo text
// The client identifier appears in front of the message
  Memo1.Text:=Memo1.Text+'Cliente'+IntToStr(Socket.SocketHandle)+' :'+Socket.ReceiveText+#13#10;
end;

end.

Answer 1

A straight translation of the server code would look like this:

unit Server;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, IdTCPServer, IdContext;

type
  TServidor = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    IdTCPServer1: TIdTCPServer;
    Memo1: TMemo;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure IdTCPServer1Connect(AContext: TIdContext);
    procedure IdTCPServer1Disconnect(AContext: TIdContext);
    procedure IdTCPServer1Execute(AContext: TIdContext);
  private
    { Private declarations }
    procedure UpdateButtons;
  public
    { Public declarations }
  end;

var
  Servidor: TServidor;

implementation

{$R *.dfm}

procedure TServidor.Button1Click(Sender: TObject);
var
  i: integer;
  list: TIdContextList;
  Str: String;
begin
  Str := Edit1.Text;//Take the string (message) sent by the server
  Memo1.Lines.Add('yo: ' + Str); //Adds the message to the memo box
  Edit1.Text := '';//Clears the edit box
  //Sends the messages to all clients connected to the server
  list := IdTCPServer1.Contexts.LockList;
  try
    for i := 0 to list.Count-1 do
    begin
      try
        TIdContext(list[i]).Connection.IOHandler.WriteLn(str);//Sent
      except 
      end;
    end;
  finally
    IdTCPServer1.Contexts.UnlockList;
  end;
end;

procedure TServidor.Button2Click(Sender: TObject);
begin
  if not IdTCPServer1.Active //The button caption is ‘Start’
  then
  begin
    IdTCPServer1.Active := True;//Activates the server socket
    Memo1.Lines.Add('Servidor en linea');
    Button2.Caption := 'Apagar';//Set the button caption
  end
  else//The button caption is ‘Stop’
  begin
    IdTCPServer1.Active := False;//Stops the server socket
    Memo1.Lines.Add('Servidor fuera de linea');
    Button2.Caption := 'Encender';
    //If the server is closed, then it cannot send any messages
    Button1.Enabled := false;//Disables the “Send” button
    Edit1.Enabled := false;//Disables the edit box
  end;
end;

procedure TServidor.UpdateButtons;
var
  list: TIdContextList;
begin
  list := IdTCPServer1.Contexts.LockList;
  try
    Button1.Enabled := list.Count > 0;
    Edit1.Enabled := Button1.Enabled;
  finally
    IdTCPServer1.Contexts.UnlockList;
  end;
end;

procedure TServidor.IdTCPServer1Connect(AContext: TIdContext);
begin
  AContext.Connection.IOHandler.WriteLn('Conectado');//Sends a message to the client
  //If at least a client is connected to the server, then the server can communicate
  //Enables the Send button and the edit box
  TThread.Queue(nil, UpdateButtons);
end;

procedure TServidor.IdTCPServer1Disconnect(AContext: TIdContext);
begin
  //The server cannot send messages if there is no client connected to it
  TThread.Queue(nil, UpdateButtons);
end;

procedure TServidor.IdTCPServer1Execute(AContext: TIdContext);
var
  Str: String;
begin
  //Read the message received from the client and add it to the memo text
  // The client identifier appears in front of the message
  Str := 'Cliente '+ AContext.Binding.PeerIP + ' :' + AContext.Connection.IOHandler.ReadLn;
  TThread.Queue(nil,
    procedure
    begin
      Memo1.Lines.Add(Str);
    end
  );
end;

end.

This is not the safest way to implement a server, though. In particular, broadcasting messages to client in the Button1Click() procedure. A safer approach would look more like this instead:

unit Server;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, IdTCPServer, IdContext;

type
  TServidor = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    IdTCPServer1: TIdTCPServer;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure IdTCPServer1Connect(AContext: TIdContext);
    procedure IdTCPServer1Disconnect(AContext: TIdContext);
    procedure IdTCPServer1Execute(AContext: TIdContext);
  private
    { Private declarations }
    procedure UpdateButtons;
  public
    { Public declarations }
  end;

var
  Servidor: TServidor;

implementation

{$R *.dfm}

uses
  IdTCPConnection, IdYarn, IdThreadSafe;

type
  TMyContext = class(TIdServerContext)
  private
    Queue: TIdThreadSafeStringList;
    QueuePending: Boolean;
  public
    constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
    destructor Destroy; override;
    procedure AddToQueue(const s: string);
    procedure SendQueue;
  end;

constructor TMyContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
  inherited;
  Queue := TIdThreadSafeStringList.Create;
end;

destructor TMyContext.Destroy;
begin
  Queue.Free;
  inherited;
end;

procedure TMyContext.AddToQueue(const s: string);
var
  list: TStringList;
begin
  list := Queue.Lock;
  try
    list.Add(s);
    QueuePending := True;
  finally
    Queue.Unlock;
  end;
end;

procedure TMyContext.SendQueue;
var
  list: TStringList;
  tmpList: TStringList;
  i: Integer;
begin
  if not QueuePending then Exit;
  tmp := nil;
  try
    list := Queue.Lock;
    try
      if list.Count = 0 then
      begin
        QueuePending := False;
        Exit;
      end;
      tmpList := TStringList.Create;
      tmpList.Assign(list);
      list.Clear;
      QueuePending := False;
    finally
      Queue.Unlock;
    end;
    for i := 0 to tmpList.Count-1 do
      Connection.IOHandler.WriteLn(tmpList[i]);
  finally
    tmpList.Free;
  end;
end;

procedure TServidor.FormCreate(Sender: TObject);
begin
  IdTCPServer1.ContextClass := TMyContext;
end;

procedure TServidor.Button1Click(Sender: TObject);
var
  i: integer;
  list: TIdContextList;
  Str: String;
begin
  Str := Edit1.Text;//Take the string (message) sent by the server
  Memo1.Lines.Add('yo: ' + Str); //Adds the message to the memo box
  Edit1.Text := '';//Clears the edit box
  //Sends the messages to all clients connected to the server
  list := IdTCPServer1.Contexts.LockList;
  try
    for i := 0 to list.Count-1 do
      TMyContext(list[i]).AddToQueue(str);//Sent
  finally
    IdTCPServer1.Contexts.UnlockList;
  end;
end;

procedure TServidor.Button2Click(Sender: TObject);
begin
  if not IdTCPServer1.Active //The button caption is ‘Start’
  then
  begin
    IdTCPServer1.Active := True;//Activates the server socket
    Memo1.Lines.Add('Servidor en linea');
    Button2.Caption := 'Apagar';//Set the button caption
  end
  else//The button caption is ‘Stop’
  begin
    IdTCPServer1.Active := False;//Stops the server socket
    Memo1.Lines.Add('Servidor fuera de linea');
    Button2.Caption := 'Encender';
    //If the server is closed, then it cannot send any messages
    Button1.Enabled := false;//Disables the “Send” button
    Edit1.Enabled := false;//Disables the edit box
  end;
end;

procedure TServidor.UpdateButtons;
var
  list: TIdContextList;
begin
  list := IdTCPServer1.Contexts.LockList;
  try
    Button1.Enabled := list.Count > 0;
    Edit1.Enabled := Button1.Enabled;
  finally
    IdTCPServer1.Contexts.UnlockList;
  end;
end;

procedure TServidor.IdTCPServer1Connect(AContext: TIdContext);
begin
  AContext.Connection.IOHandler.WriteLn('Conectado');//Sends a message to the client
  //If at least a client is connected to the server, then the server can communicate
  //Enables the Send button and the edit box
  TThread.Queue(nil, UpdateButtons);
end;

procedure TServidor.IdTCPServer1Disconnect(AContext: TIdContext);
begin
  //The server cannot send messages if there is no client connected to it
  TThread.Queue(nil, UpdateButtons);
end;

procedure TServidor.IdTCPServer1Execute(AContext: TIdContext);
var
  LContext: TMyContext;
  Str: String;
begin
  LContext := TMyContext(AContext);

  //send pending messages from the server
  LContext.SendQueue;

  //check for a message received from the client
  if AContext.IOHandler.InputBufferIsEmpty then
  begin
    AContext.IOHandler.CheckForDataOnSource(100);
    AContext.IOHandler.CheckForDisconnect;
    if AContext.IOHandler.InputBufferIsEmpty then Exit;
  end;

  //read the message received from the client and add it to the memo text
  // The client identifier appears in front of the message
  Str := 'Cliente '+ AContext.Binding.PeerIP + ' :' + AContext.Connection.IOHandler.ReadLn;
  TThread.Queue(nil,
    procedure
    begin
      Memo1.Lines.Add(Str);
    end
  );
end;

end.

As for the client, you did not show your client code (you showed your server code twice), but here is what a client implementation could look like (note that this is not the best way to implement a client that can receive unsolicited server messages, though):

unit Client;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, IdTCPClient;

type
  TCliente = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    IdTCPClient1: TIdTCPClient;
    Memo1: TMemo;
    Timer1: TTimer;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    procedure CloseClient;
  public
    { Public declarations }
  end;

var
  Cliente: TCliente;

implementation

{$R *.dfm}

procedure TCliente.Button1Click(Sender: TObject);
var
  i: integer;
  Str: String;
begin
  Str := Edit1.Text;//Take the string (message) sent by the client
  Memo1.Lines.Add('yo: '+Str);//Adds the message to the memo box
  Edit1.Text := '';//Clears the edit box
  //Sends the message to the server
  try
    IdTCPClient1.IOHandler.WriteLn(str);//Sent
  except
    CloseClient;
  end;
end;

procedure TServidor.Button2Click(Sender: TObject);
begin
  if not IdTCPClient1.Connected //The button caption is ‘Start’
  then
  begin
    IdTCPClient1.Connect;//Activates the client socket
    Memo1.Lines.Add('Cliente en linea');
    Button2.Caption := 'Apagar';//Set the button caption
    //Enables the Send button and the edit box
    Button1.Enabled := true;
    Edit1.Enabled := true;
    Timer1.Enabled := True;
  end
  else//The button caption is ‘Stop’
  begin
    CloseClient;
  end;
end;

procedure TCliente.CloseClient;
begin
  IdTCPClient1.Disconnect;//Stops the client socket
  Memo1.Lines.Add('Cliente fuera de linea');
  Button2.Caption := 'Encender';
  //If the client is closed, then it cannot send any messages
  Button1.Enabled := false;//Disables the “Send” button
  Edit1.Enabled := false;//Disables the edit box
  Timer1.Enabled := false;
end;

procedure TCliente.Timer1Timer(Sender: TObject);
begin
  try
    //check for a message from the server
    if IdTCPClient1.IOHandler.InputBufferIsEmpty then
    begin
      IdTCPClient1.IOHandler.CheckForDataOnSource(10);
      IdTCPClient1.IOHandler.CheckForDisconnect;
      if IdTCPClient1.IOHandler.InputBufferIsEmpty then Exit;
    end;
    //Read the message received from the server and add it to the memo text
    // The client identifier appears in front of the message
    Memo1.Lines.Add('Servidor :' + IdTCPClient1.IOHandler.ReadLn);
  except
    CloseClient;
  end;
end;

end.