【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 個 TButton1 個 TEdit1 個 TMemo1 個 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;



btnStartStoponClick 寫入下述程式:
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;


btnSendOnClick 寫入下述程式:
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;



ServerSocket1OnClientConnect 寫入下述程式:
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;



ServerSocket1OnClientDisconnect 寫入下述程式:
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;



ServerSocket1OnClientRead 寫入下述程式:
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 個 TButton1 個 TEdit1 個 TMemo1 個 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;



btnConnectDisconnectOnClick 寫入下述程式:
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;



btnSendOnClick 寫入下述程式:
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;



ClientSocket1OnDisconnect 寫入下述程式:
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;



ClientSocket1OnError 寫入下述程式:
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;



ClientSocket1OnRead 寫入下述程式:
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 都收到。如果要能個別對話,可能要多執行緒吧...