Question

那位大哥 给个delphi的SOCKET 程序 谢谢啦

Answer 1

笔者在工作中遇到对局域网中各工作站与服务器之间进行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