【Delphi】socket 應用 - 聊天室

偶然看到資料來源連結的文章，好奇下，跟著實作了一遍，後來陸續爬文才發現本篇筆記適用於 Delphi 6(含) 之前的版本......


資料來源 -- http://docwiki.embarcadero.com/CodeExamples/XE4/en/Chat_Room_Socket_%28Delphi%29

安裝 socket 元件

Delphi 預設並未安裝 socket 元件於元件盤；
啟動 Delphi，點選功能表
→ Component
→ Install Packages...
→ 按 "Add" 鈕
→ 找到 Delphi 安裝路徑下的 bin 目錄
→ 找到 dclsockets[版本數字].bpl
→ socket 元件就會安裝在元件盤的 Internet 頁籤

撰寫 server 端程式

新建一個 VCL Application 專案，在 Form 上放置 2 個 TButton、1 個 TEdit、1 個 TMemo 和 1 個 TServerSocket；其中 1 個 Button 改名為 btnStartStop，另 1 個 Button 改名為 btnSend。

ServerSocket1 的 port 設為大於 1024 的數字，我設成 9000。

Form1 加入 1 個 private 字串變數 str。

 
type
TForm1 = class(TForm)
    ...
    ...
    private
        { Private declarations }
        str: string;
    public
        { Public declarations }
end;
 

在 btnStartStop 的 onClick 寫入下述程式：

 
procedure TForm1.btnStartStopClick(Sender: TObject);
begin
    if (ServerSocket1.Active=False) then
        // The button caption is ‘Start’
        begin
            ServerSocket1.Active := True;   // Activates the server socket
            Memo1.Text := Memo1.Text + 'Server Started' + #13#10;
            (Sender as TButton).Caption := 'Stop';  // Set the button caption
        end
    else
        // The button caption is ‘Stop’
        begin
            ServerSocket1.Active := False;  // Stops the server socket
            Memo1.Text := Memo1.Text + 'Server Stopped' + #13#10;
            (Sender as TButton).Caption := 'Start';
            // If the server is closed, then it cannot send any messages
            btnSend.Enabled := false;   // Disables the “Send” button
            Edit1.Enabled:=false;   // Disables the edit box
        end;
end;
 

在 btnSend 的 OnClick 寫入下述程式：

 
procedure TForm1.btnSendClick(Sender: TObject);
var
    i: integer;
begin
    Str := Edit1.Text;  // Take the string (message) sent by the server
    Memo1.Text := Memo1.Text + 'me: ' + 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
    begin
        ServerSocket1.Socket.Connections[i].SendText(str);    // Sent
    end;
end;
 

在 ServerSocket1 的 OnClientConnect 寫入下述程式：

 
procedure TForm1.ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
    Socket.SendText('Connected');   // 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
    btnSend.Enabled := true;
    Edit1.Enabled := true;
end;
 

在 ServerSocket1 的 OnClientDisconnect 寫入下述程式：

 
procedure TForm1.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
        btnSend.Enabled := false;
        Edit1.Enabled := false;
    end;
end;
 

在 ServerSocket1 的 OnClientRead 寫入下述程式：

 
procedure TForm1.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 + 'Client' + IntToStr(Socket.SocketHandle) + ' :' + Socket.ReceiveText + #13#10;
end;
 

存檔並編譯成可執行的 exe 檔。

撰寫 client 端程式

新建一個 VCL Application 專案，在 Form 上放置 2 個 TButton、1 個 TEdit、1 個 TMemo 和 1 個 TClientSocket；其中 1 個 Button 改名為 btnConnectDisconnect，另 1 個 Button 改名為 btnSend。

ClientSocket1 的 port 設為大於 1024 的數字，我設成 9000。

Form1 加入 1 個 private 字串變數 str。

 
type
  TForm1 = class(TForm)
  ...
  ...
  private
    { Private declarations }
    str: string;
  public
    { Public declarations }
  end;
 

在 btnConnectDisconnect 的 OnClick 寫入下述程式：

 
procedure TForm2.btnConnectDisconnectClick(Sender: TObject);
begin
    // 127.0.0.1 is the standard IP address to loop back to your own machine
    ClientSocket1.Address := '127.0.0.1';
    ClientSocket1.Active := True;   // Activates the client

    if(ClientSocket1.Socket.Connected=True) then
        begin
            str := 'Disconnected';
            ClientSocket1.Active := False;  // Disconnects the client
            edit1.Enabled := false;
            btnSend.Enabled := false;
            (Sender as TButton).Caption := 'Connect';
        end
    else
        begin
            str := 'Connected';
            ClientSocket1.Active := true;  // connects the client
            edit1.Enabled := true;
            btnSend.Enabled := true;
            (Sender as TButton).Caption := 'Disconnect';
        end;
end;
 

在 btnSend 的 OnClick 寫入下述程式：

 
procedure TForm2.btnSendClick(Sender: TObject);
begin
    Str := Edit1.Text;
    Memo1.Text := Memo1.Text+'me: ' + str + #13#10;
    Edit1.Text := '';   // Clears the edit box
    ClientSocket1.Socket.SendText(str); // Send the messages to the server
end;
 

在 ClientSocket1 的 OnDisconnect 寫入下述程式：

 
procedure TForm2.ClientSocket1Disconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
    Memo1.Text := Memo1.Text + 'Disconnect' + #13#10;
    Socket.SendText(str);   // Send the “Disconnected” message to the server
    // str is set to “Disconnected” when the Disconnect button is pressed
    // A client cannot send messages if it is not connected to a server
    btnSend.Enabled := False;
    Edit1.Enabled := False;
    btnConnectDisconnect.Caption := 'Connect';
end;
 

在 ClientSocket1 的 OnError 寫入下述程式：

 
procedure TForm2.ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
    ErrorCode := 0;
    ClientSocket1.Active := False;
    // This can happen when no active server is started
    Memo1.Text := Memo1.Text + 'No connection found' + #13#10;
end;
 

在 ClientSocket1 的 OnRead 寫入下述程式：

 
procedure TForm2.ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
begin
    // Reads and displays the message received from the server;
    Memo1.Text := Memo1.Text + 'Server: ' + Socket.ReceiveText + #13#10;
end;
 

存檔並編譯成可執行的 exe 檔。

先啟動 server 端程式，並按 start 鈕

再啟動 client 端程式，並按 connect 鈕

現在，client 端 和 server 端就可以開始對話了。

不過這樣的架構只能 1 台 server 與 1 台 client 對話，當 2 台以上的 client 連上 server 時，server 發出的訊息會 3 台 client 都收到。如果要能個別對話，可能要多執行緒吧...