投稿
  1. 首页
  2. 软件运维

delphi通信

野草题辞 • 2023-5-24 • 软件运维 • 阅读 15

delphi通信,第1张

原来保存的一个东西,你看看吧

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: TObjectvar Action: TCloseAction)

procedure ServerSocketGetSocket(Sender: TObjectSocket: Integer

var ClientSocket: TServerClientWinSocket)

procedure ServerSocketClientError(Sender: TObject

Socket: TCustomWinSocketErrorEvent: 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: Integervar ClientSocket: TServerClientWinSocket)

begin

StatusBar.Panels[0].Text :='客户端正在连接...'

end

//客户端发生错误

procedure TfrmServerMain.ServerSocketClientError(Sender: TObject

Socket: TCustomWinSocketErrorEvent: 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: TObjectSocket: 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: TObjectvar Action: TCloseAction)

procedure ClientSocketError(Sender: TObjectSocket: TCustomWinSocket

ErrorEvent: TErrorEventvar 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: TCustomWinSocketErrorEvent: 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

这个叫进程间通信，你说的那个是在同一个进程内的，进程间通信是在不同进程之间传送数据或信号的一些技术或方法。windows支持很多种进程间通信的方法，如窗口消息，共享内存，消息管道，Windows套接字，COM/DCOM等等，具体源码搜"delphi 进程间通信"可找到很多。下面只是一例：一.第一种办法,利用注册Windows全局的消息.并覆盖wndProc过程来监听消息处理.1. 发送消息方: privatestrWM:Cardinal //定义一个局部变量 ... proccedure Form1.Create(sender:TObject) begin strWM:= RegisterWindowMessage('newspopMessage')//注册一个windows全局消息,通过这个消息与其它进程通信 end ... procedure Form1.Button1Click1(Sender:TObject) var h:Cardinal begin //通信的步骤得先找到要通信的信息窗口Handle h:=findWindow('目标进程窗口类名','窗口Caption') //发送消息消息类型为自定义的strWM SendMessage(h,strWM,0,0) //这里同样可以带参数.wParam,lParam.但我传一个PChar,读取的时候总报错.不知道为啥 end2. 接收消息方: privatestrWM:Cardinal //定义一个局部变量 procedure wndProc(varmsg:Tmessage)override//覆盖这个方法,可以监听所有的Windows消息回调函数 ... proccedure Form1.Create(sender:TObject) begin strWM:= RegisterWindowMessage('newspopMessage')//注册一个windows全局消息,这个相当于暗号 end procecure form1.wndProc(var msg:TMessage) begin //在这里处理这个消息就行了 showmessage(strpas(PChar(mes.lparam)))//这样写会报错的.但可以处理其它无参数的事情 end ----------------------------------------------------------------------------------------------二.第二种办法,发送一个WM_COPYDATA的销扮消息.并且可以带一个TCopyDataStruct的结构类型参数. 1. 发送消息方: procedure TMainForm.CallAgent(msg: string) var HlAgent:HWND ds:TCopyDatastruct //定义一个TCopyDatastruct结构体变量 begin AgentMsg := msg ds.cbData := Length(msg)+1//结构体的第一个元素: 长度cbDataGetMem(ds.lpData,ds.cbData)//分配内存,结构体的衫模第或斗缓二个参数: 数据的指针lpDATA StrCopy(ds.lpData,PChar(msg))//复制值到结构指针HlAgent :=FindWindow('TmsgpopMainCaller','调用者') //查找目标窗体的Handle if HlAgent <>0 then begin //ShowMessage('主' + IntToStr(Cardinal(@ds)))SendMessage(HlAgent,WM_COPYDATA,0,Cardinal(@ds)) //发送WM_COPYDATA消息,并带上参数 @ds end FreeMem(ds.lpData)//释放数据内存 end2.接收方程序: publicprocedure MyMessage(varm:TWmCopyData)message WM_CopyData //定义一个消息响应过程,并传入一个TWmCopyData的参数 ... procedure TmsgpopMainCaller.MyMessage(var m: TWmCopyData)//实现响应 var msg:string begin msg :=StrPas(m.CopyDataStruct^.lpData) //获取参数数据 ShowMessageForm := TShowMessageForm.Create(self,msg) //处理 end

欢迎分享，转载请注明来源：内存溢出

原文地址: http://outofmemory.cn/yw/12361811.html

赞 (0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
野草题辞 野草题辞 一级用户组
0 0
上一篇 2023-05-24
下一篇 2023-05-24

发表评论

登录后才能评论

评论列表（0条）

保存