¿Как я могу отправлять и получать строки из tidtcpclient и tidtcpserver и создавать чат?

Question

im new at delphi languaje и im, используя Rad Studio, чтобы приложения работали на каждом устройстве с однопользовательским программированием. Прямо сейчас я должен сделать чат с помощью сокетов, я сделал чат для окон, используя tclientsocket и tserversocket, используя следующий код, что я пытаюсь сделать, это сделать точную вещь, но использовать tidtcpclient и tidtcpserver вместо tclientsocket и tserversocket

Сервер:

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

прямой перевод серверного кода будет выглядеть следующим образом:

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. 

Это не самый безопасный способ реализации сервера. В частности, передача сообщений клиенту в процедуре Button1Click(). Более безопасный подход будет выглядеть следующим образом, вместо:

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. 

Что касается клиента, то не показывал свой код клиента (вы показали свой код сервера дважды), но вот то, что реализация клиента может выглядеть следующим образом (примечание что это не лучший способ реализовать клиента, который может получать незатребованные сообщения сервера, хотя):

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.