2013-07-21

【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

  1.  
  2. type
  3. TForm1 = class(TForm)
  4. ...
  5. ...
  6. private
  7. { Private declarations }
  8. str: string;
  9. public
  10. { Public declarations }
  11. end;
  12.  



btnStartStoponClick 寫入下述程式:
  1.  
  2. procedure TForm1.btnStartStopClick(Sender: TObject);
  3. begin
  4.     if (ServerSocket1.Active=False) then
  5.         // The button caption is ‘Start’
  6.         begin
  7.             ServerSocket1.Active := True; // Activates the server socket
  8.             Memo1.Text := Memo1.Text + 'Server Started' + #13#10;
  9.             (Sender as TButton).Caption := 'Stop'; // Set the button caption
  10.         end
  11.     else
  12.         // The button caption is ‘Stop’
  13.         begin
  14.             ServerSocket1.Active := False; // Stops the server socket
  15.             Memo1.Text := Memo1.Text + 'Server Stopped' + #13#10;
  16.             (Sender as TButton).Caption := 'Start';
  17.             // If the server is closed, then it cannot send any messages
  18.             btnSend.Enabled := false; // Disables the “Send” button
  19.             Edit1.Enabled:=false; // Disables the edit box
  20.         end;
  21. end;
  22.  


btnSendOnClick 寫入下述程式:
  1.  
  2. procedure TForm1.btnSendClick(Sender: TObject);
  3. var
  4.     i: integer;
  5. begin
  6.     Str := Edit1.Text;  // Take the string (message) sent by the server
  7.     Memo1.Text := Memo1.Text + 'me: ' + Str + #13#10;   // Adds the message to the memo box
  8.     Edit1.Text := '';   // Clears the edit box
  9.     // Sends the messages to all clients connected to the server
  10.     for i:=0 to ServerSocket1.Socket.ActiveConnections-1 do
  11.     begin
  12.         ServerSocket1.Socket.Connections[i].SendText(str);    // Sent
  13.     end;
  14. end;
  15.  



ServerSocket1OnClientConnect 寫入下述程式:
  1.  
  2. procedure TForm1.ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
  3. begin
  4.     Socket.SendText('Connected');   // Sends a message to the client
  5.     // If at least a client is connected to the server, then the server can communicate
  6.     // Enables the Send button and the edit box
  7.     btnSend.Enabled := true;
  8.     Edit1.Enabled := true;
  9. end;
  10.  



ServerSocket1OnClientDisconnect 寫入下述程式:
  1.  
  2. procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
  3. begin
  4.     // The server cannot send messages if there is no client connected to it
  5.     if (ServerSocket1.Socket.ActiveConnections-1=0) then
  6.     begin
  7.         btnSend.Enabled := false;
  8.         Edit1.Enabled := false;
  9.     end;
  10. end;
  11.  



ServerSocket1OnClientRead 寫入下述程式:
  1.  
  2. procedure TForm1.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
  3. begin
  4.     // Read the message received from the client and add it to the memo text
  5.     // The client identifier appears in front of the message
  6.     Memo1.Text := Memo1.Text + 'Client' + IntToStr(Socket.SocketHandle) + ' :' + Socket.ReceiveText + #13#10;
  7. end;
  8.  



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


撰寫 client 端程式


新建一個 VCL Application 專案,在 Form 上放置 2 個 TButton1 個 TEdit1 個 TMemo1 個 TClientSocket;其中 1 個 Button 改名為 btnConnectDisconnect,另 1 個 Button 改名為 btnSend

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

Form1 加入 1 個 private 字串變數 str

  1.  
  2. type
  3.   TForm1 = class(TForm)
  4.   ...
  5.   ...
  6.   private
  7.     { Private declarations }
  8.     str: string;
  9.   public
  10.     { Public declarations }
  11.   end;
  12.  



btnConnectDisconnectOnClick 寫入下述程式:
  1.  
  2. procedure TForm2.btnConnectDisconnectClick(Sender: TObject);
  3. begin
  4.     // 127.0.0.1 is the standard IP address to loop back to your own machine
  5.     ClientSocket1.Address := '127.0.0.1';
  6.     ClientSocket1.Active := True; // Activates the client
  7.  
  8.     if(ClientSocket1.Socket.Connected=True) then
  9.         begin
  10.             str := 'Disconnected';
  11.             ClientSocket1.Active := False; // Disconnects the client
  12.             edit1.Enabled := false;
  13.             btnSend.Enabled := false;
  14.             (Sender as TButton).Caption := 'Connect';
  15.         end
  16.     else
  17.         begin
  18.             str := 'Connected';
  19.             ClientSocket1.Active := true; // connects the client
  20.             edit1.Enabled := true;
  21.             btnSend.Enabled := true;
  22.             (Sender as TButton).Caption := 'Disconnect';
  23.         end;
  24. end;
  25.  



btnSendOnClick 寫入下述程式:
  1.  
  2. procedure TForm2.btnSendClick(Sender: TObject);
  3. begin
  4. Str := Edit1.Text;
  5. Memo1.Text := Memo1.Text+'me: ' + str + #13#10;
  6. Edit1.Text := ''; // Clears the edit box
  7. ClientSocket1.Socket.SendText(str); // Send the messages to the server
  8. end;
  9.  



ClientSocket1OnDisconnect 寫入下述程式:
  1.  
  2. procedure TForm2.ClientSocket1Disconnect(Sender: TObject; Socket: TCustomWinSocket);
  3. begin
  4. Memo1.Text := Memo1.Text + 'Disconnect' + #13#10;
  5. Socket.SendText(str); // Send the “Disconnected” message to the server
  6. // str is set to “Disconnected” when the Disconnect button is pressed
  7. // A client cannot send messages if it is not connected to a server
  8. btnSend.Enabled := False;
  9. Edit1.Enabled := False;
  10. btnConnectDisconnect.Caption := 'Connect';
  11. end;
  12.  



ClientSocket1OnError 寫入下述程式:
  1.  
  2. procedure TForm2.ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  3. begin
  4.     ErrorCode := 0;
  5.     ClientSocket1.Active := False;
  6.     // This can happen when no active server is started
  7.     Memo1.Text := Memo1.Text + 'No connection found' + #13#10;
  8. end;
  9.  



ClientSocket1OnRead 寫入下述程式:
  1.  
  2. procedure TForm2.ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
  3. begin
  4. // Reads and displays the message received from the server;
  5. Memo1.Text := Memo1.Text + 'Server: ' + Socket.ReceiveText + #13#10;
  6. end;
  7.  



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

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


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


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


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

沒有留言:

張貼留言