此為轉貼資料 http://developer.ccidnet.com/pub/disp/Article?columnID=294&articleID=29603&pageNO=1 利用Delphi編寫Socket通信程式 作者：simitar 本文選自：賽迪網 筆者在工作中遇到對局域網中各工作站與伺服器之間進行Socket通信的問題。現在將本人總結出來的TServerSocket和TClientSocket兩個元件的基本用法寫出來，希望與您分享。 ClientSocket元件爲用戶端元件。它是通信的請求方，也就是說，它是主動地與伺服器端建立連接。 ServerSocket元件爲伺服器端元件。它是通信的回應方，也就是說，它的動作是監聽以及被動接受用戶端的連接請求，並對請求進行回復。 ServerSocket元件可以同時接受一個或多個ClientSocket元件的連接請求，並與每個ClientSocket元件建立單獨的連接，進行單獨的通信。因此，一個伺服器端可以爲多個用戶端服務。 設計思路 本例包括一個伺服器端程式和一個用戶端程式。用戶端程式可以放到多個電腦上運行，同時與伺服器端進行連接通信。 本例的重點，一是演示用戶端與伺服器端如何通信；二是當有多個用戶端同時連接到伺服器端時，伺服器端如何識別每個用戶端，並對請求給出相應的回復。爲了保證一個用戶端斷開連接時不影響其他用戶端與伺服器端的通信，同時保證伺服器端能夠正確回復用戶端的請求，在本例中聲明了一個記錄類型： type client_record=record CHandle: integer; //用戶端套接字控制碼 CSocket:TCustomWinSocket; //用戶端套接字 CName:string; //用戶端電腦名稱 CAddress:string; //用戶端電腦IP位址 CUsed: boolean; //用戶端聯機標誌 end; 利用這個記錄類型資料保存用戶端的資訊，同時保存當前用戶端的連接狀態。其中，CHandle保存用戶端套接字控制碼，以便準確定位每個與伺服器端保持連接的用戶端；Csocket保存用戶端套接字，通過它可以對用戶端進行回復。Cused記錄當前用戶端是否與伺服器端保持連接。 下面對元件ServerSocket和ClientSocket的屬性設置簡單說明。 ServerSocket的屬性： · Port，是通信的埠，必須設置。在本例中設置爲1025； · ServerTypt，伺服器端讀寫資訊類型，設置爲stNonBlocking表示非同步讀寫資訊，本例中採用這種方式。 · ThreadCacheSize，用戶端的最大連接數，就是伺服器端最多允許多少用戶端同時連接。本例採用預設值10。 其他屬性採用默認設置即可。 ClientSocket的屬性： · Port，是通信的埠，必須與伺服器端的設置相同。在本例中設置爲1025； · ClientType，用戶端讀寫資訊類型，應該與伺服器端的設置相同，爲stNonBlocking表示非同步讀寫資訊。 · Host，用戶端要連接的伺服器的IP位址。必須設置，當然也可以在代碼中動態設置。 其他屬性採用默認設置即可。 程式源代碼: · 伺服器端源碼（uServerMain.pas）： unit uServerMain; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ScktComp, ToolWin, ComCtrls, ExtCtrls, StdCtrls, Buttons; const CMax=10; //用戶端最大連接數 type client_record=record CHandle: integer; //用戶端套接字控制碼 CSocket:TCustomWinSocket; //用戶端套接字 CName:string; //用戶端電腦名稱 CAddress:string; //用戶端電腦IP位址 CUsed: boolean; //用戶端聯機標誌 end; type TfrmServerMain = class(TForm) ServerSocket: TServerSocket; ControlBar1: TControlBar; ToolBar1: TToolBar; tbConnect: TToolButton; tbClose: TToolButton; tbDisconnected: TToolButton; Edit1: TEdit; Memo1: TMemo; StatusBar: TStatusBar; procedure tbConnectClick(Sender: TObject); procedure tbDisconnectedClick(Sender: TObject); procedure ServerSocketClientRead(Sender: TObject; Socket: TCustomWinSocket); procedure ServerSocketListen(Sender: TObject; Socket: TCustomWinSocket); procedure ServerSocketClientConnect(Sender: TObject; Socket: TCustomWinSocket); procedure ServerSocketClientDisconnect(Sender: TObject; Socket: TCustomWinSocket); procedure tbCloseClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure ServerSocketGetSocket(Sender: TObject; Socket: Integer; var ClientSocket: TServerClientWinSocket); procedure ServerSocketClientError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); private { Private declarations } public { Public declarations } session: array[0..CMax] of client_record; //用戶端連接陣列 Sessions: integer; //用戶端連接數 end; var frmServerMain: TfrmServerMain; implementation {$R *.DFM} //打開套接字連接，並使套接字進入監聽狀態 procedure TfrmServerMain.tbConnectClick(Sender: TObject); begin ServerSocket.Open ; end; //關閉套接字連接，不再監聽用戶端的請求 procedure TfrmServerMain.tbDisconnectedClick(Sender: TObject); begin ServerSocket.Close; StatusBar.Panels[0].Text :='伺服器套接字連接已經關閉，無法接受用戶端的連接請求.'; end; //從用戶端讀取資訊 procedure TfrmServerMain.ServerSocketClientRead(Sender: TObject; Socket: TCustomWinSocket); var i:integer; begin //將從用戶端讀取的資訊添加到Memo1中 Memo1.Lines.Add(Socket.ReceiveText); for i:=0 to sessions do begin //取得匹配的用戶端 if session[i].CHandle = Socket.SocketHandle then begin session[i].CSocket.SendText('回復用戶端' session[i].CAddress ' ==> ' Edit1.Text); end; end; end; //伺服器端套接字進入監聽狀態，以便監聽用戶端的連接 procedure TfrmServerMain.ServerSocketListen(Sender: TObject; Socket: TCustomWinSocket); begin StatusBar.Panels[0].Text :='等待用戶端連接...'; end; //當用戶端連接到伺服器端以後 procedure TfrmServerMain.ServerSocketClientConnect(Sender: TObject; Socket: TCustomWinSocket); var i,j:integer; begin j:=-1; for i:=0 to sessions do begin //在原有的用戶端連接陣列中有中斷的用戶端連接 if not session[i].CUsed then begin session[i].CHandle := Socket.SocketHandle ;//用戶端套接字控制碼 session[i].CSocket := Socket; //用戶端套接字 session[i].CName := Socket.RemoteHost ; //用戶端電腦名稱 session[i].CAddress := Socket.RemoteAddress ;//用戶端電腦IP session[i].CUsed := True; //連接陣列當前位置已經佔用 Break; end; j:=i; end; if j=sessions then begin inc(sessions); session[j].CHandle := Socket.SocketHandle ; session[j].CSocket := Socket; session[j].CName := Socket.RemoteHost ; session[j].CAddress := Socket.RemoteAddress ; session[j].CUsed := True; end; StatusBar.Panels[0].Text := '用戶端 ' Socket.RemoteHost ' 已經連接'; end; //當用戶端斷開連接時 procedure TfrmServerMain.ServerSocketClientDisconnect(Sender: TObject; Socket: TCustomWinSocket); var i:integer; begin for i:=0 to sessions do begin if session[i].CHandle =Socket.SocketHandle then begin session[i].CHandle :=0; session[i].CUsed := False; Break; end; end; StatusBar.Panels[0].Text :='用戶端 ' Socket.RemoteHost ' 已經斷開'; end; //關閉窗口 procedure TfrmServerMain.tbCloseClick(Sender: TObject); begin Close; end; procedure TfrmServerMain.FormCreate(Sender: TObject); begin sessions := 0; end; procedure TfrmServerMain.FormClose(Sender: TObject; var Action: TCloseAction); begin ServerSocket.Close ; end; //當客戶端正在與伺服器端連接時 procedure TfrmServerMain.ServerSocketGetSocket(Sender: TObject; Socket: Integer; var ClientSocket: TServerClientWinSocket); begin StatusBar.Panels[0].Text :='客戶端正在連接...'; end; //用戶端發生錯誤 procedure TfrmServerMain.ServerSocketClientError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); begin StatusBar.Panels[0].Text :='用戶端' Socket.RemoteHost '發生錯誤！'; ErrorCode := 0; end; end. · 用戶端源碼(uClientMain.pas)： unit uClientMain; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ScktComp, ComCtrls, ToolWin, ExtCtrls, StdCtrls, Buttons; const SocketHost = '172.16.1.6'; //伺服器端位址 type TfrmClientMain = class(TForm) ControlBar1: TControlBar; ToolBar1: TToolBar; tbConnected: TToolButton; tbSend: TToolButton; tbClose: TToolButton; tbDisconnected: TToolButton; ClientSocket: TClientSocket; Edit1: TEdit; Memo1: TMemo; StatusBar: TStatusBar; btnSend: TBitBtn; procedure tbConnectedClick(Sender: TObject); procedure tbDisconnectedClick(Sender: TObject); procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket); procedure tbSendClick(Sender: TObject); procedure tbCloseClick(Sender: TObject); procedure FormShow(Sender: TObject); procedure ClientSocketConnect(Sender: TObject; Socket: TCustomWinSocket); procedure ClientSocketConnecting(Sender: TObject; Socket: TCustomWinSocket); procedure ClientSocketDisconnect(Sender: TObject; Socket: TCustomWinSocket); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure ClientSocketError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); private { Private declarations } public { Public declarations } end; var frmClientMain: TfrmClientMain; implementation {$R *.DFM} //打開套接字連接 procedure TfrmClientMain.tbConnectedClick(Sender: TObject); begin ClientSocket.Open ; end; //關閉套接字連接 procedure TfrmClientMain.tbDisconnectedClick(Sender: TObject); begin ClientSocket.Close; end; //接受伺服器端的回復 procedure TfrmClientMain.ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket); begin Memo1.Lines.Add(Socket.ReceiveText); end; //發送資訊到伺服器端 procedure TfrmClientMain.tbSendClick(Sender: TObject); begin ClientSocket.Socket.SendText(Edit1.Text); end; procedure TfrmClientMain.tbCloseClick(Sender: TObject); begin Close; end; //設置要連接的伺服器端位址 procedure TfrmClientMain.FormShow(Sender: TObject); begin ClientSocket.Host := SocketHost; end; //已經連接到伺服器端 procedure TfrmClientMain.ClientSocketConnect(Sender: TObject; Socket: TCustomWinSocket); begin tbSend.Enabled := True; tbDisconnected.Enabled :=True; btnSend.Enabled := True; StatusBar.Panels[0].Text := '已經連接到 ' Socket.RemoteHost ; end; //正在連接到伺服器端 procedure TfrmClientMain.ClientSocketConnecting(Sender: TObject; Socket: TCustomWinSocket); begin StatusBar.Panels[0].Text := '正在連接到伺服器... ' ; end; //當斷開與伺服器端的連接時發生 procedure TfrmClientMain.ClientSocketDisconnect(Sender: TObject; Socket: TCustomWinSocket); begin tbSend.Enabled := False; btnSend.Enabled := False; tbDisconnected.Enabled := False; StatusBar.Panels[0].Text := '已經斷開與 ' Socket.RemoteHost ' 的連接'; end; procedure TfrmClientMain.FormClose(Sender: TObject; var Action: TCloseAction); begin ClientSocket.Close ; end; //當與伺服器端的連接發生錯誤時 procedure TfrmClientMain.ClientSocketError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); begin StatusBar.Panels[0].Text := '與伺服器端的連接發生錯誤'; ErrorCode := 0; end; end. 小結 上述方法是比較簡單的實現方法，同時也是相對較容易理解的方法。通過這個方法，筆者成功實現了局域網內多個用戶端與伺服器端進行Socket通信的功能，同時可以保證一個用戶端的連接、通信或是斷開都不影響其他用戶端的正常通信。 附錄： 伺服器端表單和用戶端表單及元件的屬性設置參加相應的DFM文件。 uServerMain.pas對應的DFM文件(uServerMain.dfm) object frmServerMain: TfrmServerMain Left = 297 Top = 258 BorderIcons = [biSystemMenu, biMinimize] BorderStyle = bsSingle Caption = 'ServerSocket' ClientHeight = 279 ClientWidth = 476 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False OnClose = FormClose OnCreate = FormCreate PixelsPerInch = 96 TextHeight = 13 object ControlBar1: TControlBar Left = 0 Top = 0 Width = 476 Height = 30 Align = alTop AutoSize = True TabOrder = 0 object ToolBar1: TToolBar Left = 11 Top = 2 Width = 459 Height = 22 ButtonHeight = 21 ButtonWidth = 55 Caption = 'ToolBar1' EdgeInner = esNone EdgeOuter = esNone Flat = True ShowCaptions = True TabOrder = 0 object tbConnect: TToolButton Left = 0 Top = 0 Caption = ' 連接 ' ImageIndex = 0 OnClick = tbConnectClick end object tbDisconnected: TToolButton Left = 55 Top = 0 Caption = '斷開' ImageIndex = 4 OnClick = tbDisconnectedClick end object tbClose: TToolButton Left = 110 Top = 0 Caption = '關閉' ImageIndex = 3 OnClick = tbCloseClick end end end object Edit1: TEdit Left = 0 Top = 232 Width = 473 Height = 21 TabOrder = 1 Text = '你好！' end object Memo1: TMemo Left = 0 Top = 30 Width = 476 Height = 195 Align = alTop TabOrder = 2 end object StatusBar: TStatusBar Left = 0 Top = 257 Width = 476 Height = 22 Panels = < item Width = 50 end> SimplePanel = False end object ServerSocket: TServerSocket Active = False Port = 1025 ServerType = stNonBlocking OnListen = ServerSocketListen OnGetSocket = ServerSocketGetSocket OnClientConnect = ServerSocketClientConnect OnClientDisconnect = ServerSocketClientDisconnect OnClientRead = ServerSocketClientRead OnClientError = ServerSocketClientError Left = 368 end end uClientMain.pas對應的DFM文件(uClientMain.dfm) object frmClientMain: TfrmClientMain Left = 361 Top = 290 BorderIcons = [biSystemMenu, biMinimize] BorderStyle = bsSingle Caption = 'ClientSocket' ClientHeight = 230 ClientWidth = 402 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False Position = poScreenCenter OnClose = FormClose OnShow = FormShow PixelsPerInch = 96 TextHeight = 13 object ControlBar1: TControlBar Left = 0 Top = 0 Width = 402 Height = 30 Align = alTop AutoSize = True TabOrder = 0 object ToolBar1: TToolBar Left = 11 Top = 2 Width = 385 Height = 22 ButtonHeight = 21 ButtonWidth = 55 Caption = 'ToolBar1' EdgeInner = esNone EdgeOuter = esNone Flat = True ShowCaptions = True TabOrder = 0 object tbConnected: TToolButton Left = 0 Top = 0 Caption = ' 連接 ' ImageIndex = 0 OnClick = tbConnectedClick end object tbSend: TToolButton Left = 55 Top = 0 Caption = '發送' Enabled = False ImageIndex = 1 OnClick = tbSendClick end object tbDisconnected: TToolButton Left = 110 Top = 0 Caption = '斷開' Enabled = False ImageIndex = 3 OnClick = tbDisconnectedClick end object tbClose: TToolButton Left = 165 Top = 0 Caption = '退出' ImageIndex = 2 OnClick = tbCloseClick end end end object Edit1: TEdit Left = 0 Top = 184 Width = 321 Height = 21 TabOrder = 1 Text = '問候' end object Memo1: TMemo Left = 0 Top = 30 Width = 402 Height = 147 Align = alTop TabOrder = 2 end object StatusBar: TStatusBar Left = 0 Top = 208 Width = 402 Height = 22 Panels = < item Width = 50 end> SimplePanel = False end object btnSend: TBitBtn Left = 336 Top = 183 Width = 60 Height = 22 Caption = '發送' Enabled = False TabOrder = 4 OnClick = tbSendClick end object ClientSocket: TClientSocket Active = False ClientType = ctNonBlocking Port = 1025 OnConnecting = ClientSocketConnecting OnConnect = ClientSocketConnect OnDisconnect = ClientSocketDisconnect OnRead = ClientSocketRead OnError = ClientSocketError Left = 320 end end ********************************************************* 哈哈&兵燹 最會的2大絕招 這個不會與那個也不會 哈哈哈 粉好 Delphi K.Top的K.Top分兩個字解釋Top代表尖端的意思,希望本討論區能提供Delphi的尖端新知 K.表Knowlege 知識,就是本站的標語:Open our mind to make knowledge together! 希望能大家敞開心胸,將知識寶庫結合一起

------
**********************************************************
哈哈&兵燹
最會的2大絕招 這個不會與那個也不會 哈哈哈 粉好

Delphi K.Top的K.Top分兩個字解釋Top代表尖端的意思,希望本討論區能提供Delphi的尖端新知
K.表Knowlege 知識,就是本站的標語:Open our mind