0

私は Delphi languaje の新人であり、Rad Studio を使用して、単一のプログラミングですべてのデバイスでアプリが動作するようにしています。現在、ソケットを使用してチャットを行うことになっています。次のコードを使用して tclientsocket と tserversocket のみを使用して Windows 用のチャットを作成しました。

サーバ：

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.

クライアントに関しては、クライアント コードは表示されませんでしたが (サーバー コードは 2 回表示されました)、クライアントの実装は次のようになります (非請求サーバー メッセージを受信できるクライアントを実装する最良の方法ではないことに注意してください)。 、 けれど）：

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 に答える