利用Delphi編寫Socket通信程式 |
|
jackkcg
站務副站長 發表:891 回覆:1050 積分:848 註冊:2002-03-23 發送簡訊給我 |
此為轉貼資料 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 |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |