分享
 
 
 

利用Delphi编写Socket通信程序

王朝delphi·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

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

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有