Создание чата

Delphi , Интернет и Сети , Сокеты

unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, StdCtrls, Buttons, ScktComp, ExtCtrls, ComCtrls;

type
  TChatForm = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    FileConnectItem: TMenuItem;
    FileListenItem: TMenuItem;
    StatusBar1: TStatusBar;
    Bevel1: TBevel;
    Panel1: TPanel;
    Memo1: TMemo;
    Memo2: TMemo;
    N1: TMenuItem;
    SpeedButton1: TSpeedButton;
    Disconnect1: TMenuItem;
    ServerSocket: TServerSocket;
    ClientSocket: TClientSocket;
    procedure FileListenItemClick(Sender: TObject);
    procedure FileConnectItemClick(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure Memo1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    procedure ServerSocketError(Sender: TObject; Number: Smallint;
      var Description: string; Scode: Integer; const Source,
      HelpFile: string; HelpContext: Integer; var CancelDisplay: Wordbool);
    procedure Disconnect1Click(Sender: TObject);
    procedure ClientSocketConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure ServerSocketClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketAccept(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocketDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocketError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ServerSocketClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
  protected
    IsServer: Boolean;
  end;

var
  ChatForm: TChatForm;
  Server: string;

implementation

{$R *.DFM}

procedure TChatForm.FileListenItemClick(Sender: TObject);
begin
  FileListenItem.Checked := not FileListenItem.Checked;
  if FileListenItem.Checked then
  begin
    ClientSocket.Active := False;
    ServerSocket.Active := True;
    Statusbar1.Panels[0].Text := 'Listening...';
  end
  else
  begin
    if ServerSocket.Active then
      ServerSocket.Active := False;
    Statusbar1.Panels[0].Text := '';
  end;
end;

procedure TChatForm.FileConnectItemClick(Sender: TObject);
begin
  if ClientSocket.Active then
    ClientSocket.Active := False;
  if InputQuery('Computer to connect to', 'Address Name:', Server) then
    if Length(Server) > 0 then
      with ClientSocket do
      begin
        Host := Server;
        Active := True;
        FileListenItem.Checked := False;
      end;
end;

procedure TChatForm.Exit1Click(Sender: TObject);
begin
  ServerSocket.Close;
  ClientSocket.Close;
  Close;
end;

procedure TChatForm.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_Return then
    if IsServer then
      ServerSocket.Socket.Connections[0].SendText(Memo1.Lines[Memo1.Lines.Count
        - 1])
    else
      ClientSocket.Socket.SendText(Memo1.Lines[Memo1.Lines.Count - 1]);
end;

procedure TChatForm.FormCreate(Sender: TObject);
begin
  FileListenItemClick(nil);
end;

procedure TChatForm.ServerSocketError(Sender: TObject; Number: Smallint;
  var Description: string; Scode: Integer; const Source, HelpFile: string;
  HelpContext: Integer; var CancelDisplay: Wordbool);
begin
  ShowMessage(Description);
end;

procedure TChatForm.Disconnect1Click(Sender: TObject);
begin
  ClientSocket.Active := False;
  ServerSocket.Active := True;
  Statusbar1.Panels[0].Text := 'Listening...';
end;

procedure TChatForm.ClientSocketConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Statusbar1.Panels[0].Text := 'Connected to: ' + Socket.RemoteHost;
end;

procedure TChatForm.ClientSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Memo2.Lines.Add(Socket.ReceiveText);
end;

procedure TChatForm.ServerSocketClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Memo2.Lines.Add(Socket.ReceiveText);
end;

procedure TChatForm.ServerSocketAccept(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  IsServer := True;
  Statusbar1.Panels[0].Text := 'Connected to: ' + Socket.RemoteAddress;
end;

procedure TChatForm.ServerSocketClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Memo2.Lines.Clear;
end;

procedure TChatForm.ClientSocketDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  FileListenItemClick(nil);
end;

procedure TChatForm.ClientSocketError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  Memo2.Lines.Add('Error connecting to : ' + Server);
  ErrorCode := 0;
end;

procedure TChatForm.ServerSocketClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Statusbar1.Panels[0].Text := 'Listening...';
end;

end.

Перевод текста на русский язык:

Приведенный код - это приложение для чата, написанное на Delphi, которое позволяет пользователям создавать сервер или подключаться к существующему. Приложение включает в себя функции, такие как отправка и получение сообщений, отключение от сервера и отображение ошибок.

Вот разбивка кода:

1. Основная форма (TChatForm) содержит несколько компонентов:

   • Главное меню с пунктами для подключения к серверу, прослушивания входящих соединений и выхода из приложения.
   • Два memo-полей (Memo1 и Memo2) для отправки и получения сообщений.
   • Кнопка для отключения от сервера.
   • Статусная строка для отображения информации о подключении.
   • Панель для содержания других компонентов.

2. Процедура FileListenItemClick включает или выключает пункт "Прослушивание" в главном меню, который контролирует, слушает ли приложение входящие соединения или нет.

3. Процедура FileConnectItemClick позволяет пользователям подключаться к серверу, вводя адрес и порт сервера.

4. Процедура Exit1Click закрывает все сокеты и выходит из приложения, когда пользователь кликает на пункт "Выход" в главном меню.

5. Процедура Memo1KeyDown отправляет текст из Memo1 на сервер или подключенный клиент, если пользователь нажимает Enter.

6. Процедура FormCreate инициализирует приложение, настраивая прослушивающий сокет.

7. Процедура ServerSocketError отображает ошибку, если возникнет проблема с прослушивающим сокетом.

8. Процедура Disconnect1Click отключается от сервера и начинает слушать входящие соединения снова.

9. Процедуры ClientSocketConnect, ClientSocketRead, ServerSocketAccept, ServerSocketClientRead, ServerSocketClientConnect, ClientSocketDisconnect, ClientSocketError, ServerSocketClientDisconnect обрабатывают различные события, связанные с подключением, чтением из и отключением от сокетов.

10. Переменная IsServer хранит информацию о том, является ли приложение сервером или клиентом.

Приведенный код кажется в основном корректным и должен работать как ожидается. Однако было бы полезно добавить некоторые обработчики ошибок для ситуаций, таких как неудачи в подключении к сети или недопустимый ввод пользователем. Кроме того, функциональность чата могла быть улучшена добавлением функций, таких как аутентификация пользователей и фильтрация сообщений.

Вот пример, как можно улучшить код:

• Добавьте блоки try-except вокруг операций с сокетами для ловли и обработки потенциальных исключений.
• Реализуйте более robust способ обрабатывания отключения от сервера или клиента, например, отправкой сообщения прощания перед закрытием соединения.
• Рассмотрите возможность использования отдельного потока для обработки входящих сообщений, чтобы избежать блокировки основного потока.

Вот пример использования блоков try-except:

procedure TChatForm.ClientSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  try
    Memo2.Lines.Add(Socket.ReceiveText);
  except
    on E: Exception do
      Memo2.Lines.Add('Ошибка чтения из сокета: ' + E.Message);
  end;
end;

Таким образом, если возникнет исключение при попытке чтения из сокета (например, из-за неудачи в подключении к сети), сообщение об ошибке будет отображаться в Memo2.

Создание чата в Delphi с использованием сервера и клиента.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Сокеты ::