0

我是 delphi languaje 的新手，我正在使用 Rad Studio 让应用程序在每台设备上运行，只需一次编程。现在我应该使用套接字进行聊天，我只使用 tclientsocket 和 tserversocket 使用下一个代码为 Windows 进行了聊天，我想做的是做出确切的事情，但使用 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.

客户

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.
4

1 回答 1

3

服务器代码的直接翻译如下所示：

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.
于 2015-06-25T06:33:31.077 回答