資料來源 -- 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 都收到。如果要能個別對話,可能要多執行緒吧...
沒有留言:
張貼留言