Delphi WinSocket 通信

本示例中，涉及到的缓冲，均采取1024长度，采用的select轮询，现在select轮询已经被认为是比较低级的方法了，微软也不推荐使用，这里就以它开头吧，有时间，大家可以研究其他用法，比如WSAAsyncSelect模型 ，WSAEventSelect模型 ，Overlapped I/O 事件通知模型 ，Overlapped I/O 完成例程模型 ，IOCP模型 。下面开始贴代码了：

 

服务端单元：SocketServer

unit SocketServer;

interface

uses
  Windows, Classes,SyncObjs ,WinSock ,SysUtils;

type
  TGetDataEvent = procedure(const stream:TMemoryStream) of object;
  TClientConnected = procedure(const socket: TSocket) of object;

  TWorkThread = class;
  TServerItem = class;
  TSocketServer = class
  private
    FServerSocket : TSocket;
    //客户端连接列表
    FClientSocketList : TStringList;
    FServerItem : TServerItem;

    //允许最大连接数
    FMaxClientCount : Integer;
    //客户端连接数
    FClientCount : Integer;
    //当前客户端的索引
    FClientIndex : Integer;
    //调用方的Handle
    FCallHandle : HWND;
    //接收用的内存流
    FRecStream : TMemoryStream;
    //接收缓冲区
    FRecBuf : array of byte;

    FHost : AnsiString;
    FPort : Integer;

    FTimeVal: TTimeVal;

    //工作线程
    FWorkThread : TWorkThread;

    //以下是自定义事件
    FOnGetData : TGetDataEvent;
    FOnClientConnected : TClientConnected;

    //初始化套接字
    function InitSocket:Boolean;
    //从某个客户端套接字中获取数据
    procedure GetDataFromClient(socket:TSocket);
    //检查是否有新的客户端连接
    procedure CheckNewSocket;

    procedure SetMaxClientCount(const Value:Integer);
    function GetMaxClientCount:Integer;

    function GetClientCount:Integer;
    function GetMaxClient: Integer;
    procedure SetMaxClient(const Value: Integer);


  protected
    procedure DoRevData(stream:TMemoryStream);
    procedure DoClientConnected(socket:TSocket);
    //取得某个套接字的IP地址
    function GetItemIP(index:Integer):PAnsiChar;

    function GetItemActived(index:Integer):Boolean;
    procedure SetItemActived(index:Integer;const Value:Boolean);

  public
    //ACallHandle:调用者的句柄, CreateSuspended:线程是否挂起
    constructor Create(ACallHandle:HWND;CreateSuspended: Boolean);overload;
    //启用监听
    function ListenStart:Boolean;
    //执行线程
    procedure ResumeThread;

    property Host : AnsiString read FHost write FHost;
    property Port : Integer read FPort write FPort;
    property MaxClientCount : Integer read GetMaxClientCount write SetMaxClientCount;

    property OnClientConnected : TClientConnected read FOnClientConnected write FOnClientConnected;
    property OnGetData : TGetDataEvent read FOnGetData write FOnGetData;
    property ClientSocketList : TStringList read FClientSocketList;
    property IP[index: Integer] : PAnsiChar read GetItemIP;
    property ItemActived[index: Integer] : Boolean read GetItemActived write SetItemActived;

    property ClientCount : Integer read GetClientCount write FClientCount;
    property ClientIndex : Integer read FClientIndex;
end;

  TWorkThread = class(TThread)
    private
      //临界
      FLock : TCriticalSection;
      FSocketServer : TSocketServer;

      procedure Execute;override;
      procedure ReciveFromClient;
    public
      constructor Create(ASocketServer:TSocketServer;CreateSuspended: Boolean);overload;
  end;

  TServerItem = class
    private
      FSocket : TSocket;
      FIP : PAnsiChar;
      FActived : Boolean;
    public
      property Socket : TSocket read FSocket write FSocket;
      property IP : PAnsiChar read FIP write FIP;
      property Actived : Boolean read FActived write FActived;
  end;

implementation
const
  BufLen = 1024;

{ TSocketServer }

procedure TSocketServer.CheckNewSocket;
var
  fd : TFDSet;
  addr: sockaddr_in;
  addrlen: Integer;
  val: Integer;
  rec : TSocket;
  item : TServerItem;
begin
  WinSock.FD_ZERO(fd);
  WinSock.FD_SET(FServerSocket,fd);
  val := WinSock.select(FServerSocket,@fd,nil,nil,@FTimeVal);
  if val > 0 then
  begin
    addrlen := SizeOf(addr);
    //接收可用连接
    rec := WinSock.accept(FServerSocket,@addr,@addrlen);
    if rec <> INVALID_SOCKET then
    begin
      item := TServerItem.Create;
      item.Socket := rec;
      item.IP := WinSock.inet_ntoa(addr.sin_addr);
      item.Actived := True;
      //发现有新连接，添加到列表
      FClientSocketList.AddObject(IntToStr(rec),TObject(item));
      FClientIndex := FClientSocketList.Count - 1;
      FClientCount := FClientSocketList.Count;
      //触发连接事件
      DoClientConnected(rec);
    end;
  end;
end;

constructor TSocketServer.Create(ACallHandle: HWND; CreateSuspended: Boolean);
begin
  FCallHandle := ACallHandle;
  FClientIndex := -1;
  SetLength(FRecBuf,BufLen);
  FPort := 80;
  InitSocket;
  FRecStream := TMemoryStream.Create;
  FClientSocketList := TStringList.Create;
  FWorkThread := TWorkThread.Create(Self,True);
  //设置等待时间
  FTimeVal.tv_sec := 0;     {单位:毫秒}
  FTimeVal.tv_usec := 10;   {单位:秒}
end;

procedure TSocketServer.DoClientConnected(socket: TSocket);
begin
  if Assigned(OnClientConnected) then
  begin
    OnClientConnected(socket);
  end;
end;

procedure TSocketServer.DoRevData(stream: TMemoryStream);
begin
  if Assigned(OnGetData) then
  begin
    OnGetData(FRecStream);
  end;
end;

function TSocketServer.GetClientCount: Integer;
begin
  Result := FClientSocketList.Count;
end;

procedure TSocketServer.GetDataFromClient(socket: TSocket);
var
  fd : TFDSet;
  val,reclen,i : Integer;
begin
  WinSock.FD_ZERO(fd);
  WinSock.FD_SET(socket,fd);
  val := WinSock.select(socket,@fd,nil,nil,@FTimeVal);
  if val > 0 then
  begin
    FClientIndex := FClientSocketList.IndexOf(IntToStr(socket));
    FRecStream.Clear;
    //接收数据，reclen为接收到的数据长度
    reclen := WinSock.recv(socket,FRecBuf,BufLen,0);
    if reclen = 0 then
      Exit;
    //写入到接收内存流中
    FRecStream.Write(FRecBuf,reclen);
    //触发调用者的接收数据事件
    DoRevData(FRecStream);
  end;
end;

function TSocketServer.GetItemActived(index: Integer): Boolean;
begin
  Result := TServerItem(FClientSocketList.Objects[index]).Actived;
end;

function TSocketServer.GetItemIP(index: Integer): PAnsiChar;
begin
  Result := TServerItem(FClientSocketList.Objects[index]).IP;
end;

function TSocketServer.GetMaxClient: Integer;
begin
  Result := FMaxClientCount;
end;

function TSocketServer.GetMaxClientCount: Integer;
begin

end;

function TSocketServer.InitSocket: Boolean;
var
  WSA : TWSAData;
begin
  Result := False;
  if WSAStartup($0101,WSA) <> 0 then
  begin
    Result := False;
    Exit;
  end
  else
  begin
  end;
  Result := True;
end;

function TSocketServer.ListenStart: Boolean;
var
  addr : sockaddr_in;
begin
  Result := False;
  FServerSocket := socket(PF_INET,Sock_Stream,IPPROTO_IP);
  if FServerSocket = INVALID_SOCKET then
  begin
    Result := False;
    Exit;
  end
  else
  begin
  end;
  addr.sin_family := PF_INET;
  addr.sin_port := htons(FPort);
  addr.sin_addr.S_addr := INADDR_ANY;
  if bind(FServerSocket,addr,SizeOf(addr)) = SOCKET_ERROR then
  begin
    Result := False;
    closesocket(FServerSocket);
    Exit;
  end
  else
  begin
  end;
  listen(FServerSocket,5);
  Result := True;
end;

procedure TSocketServer.ResumeThread;
begin
  FWorkThread.Resume;
end;

procedure TSocketServer.SetItemActived(index: Integer; const Value: Boolean);
begin
  TServerItem(FClientSocketList.Objects[index]).Actived := Value;
end;

procedure TSocketServer.SetMaxClient(const Value: Integer);
begin
  FMaxClientCount := Value;
end;

procedure TSocketServer.SetMaxClientCount(const Value: Integer);
begin

end;

{ TWorkThread }

constructor TWorkThread.Create(ASocketServer: TSocketServer;
  CreateSuspended: Boolean);
begin
  FSocketServer := ASocketServer;
  FLock := TCriticalSection.Create;
  inherited Create(CreateSuspended);
  FreeOnTerminate := True;
end;

procedure TWorkThread.Execute;
begin
  inherited;
  FLock.Enter;
  while not Terminated do
  begin
    ReciveFromClient;
    FSocketServer.CheckNewSocket;
  end;
  FLock.Leave;
end;

//采用select轮询方式，从客户端获取数据
procedure TWorkThread.ReciveFromClient;
var
  i : Integer;
begin
  for i := FSocketServer.ClientSocketList.Count - 1 downto 0 do
  begin
    //如果套接字 Actived := False，则从列表中删除
    if not TServerItem(FSocketServer.ClientSocketList.Objects[i]).Actived then
    begin
      FSocketServer.ClientSocketList.Delete(i);
      FSocketServer.ClientCount := FSocketServer.ClientCount - 1;
      continue;
    end;
    FSocketServer.GetDataFromClient(TServerItem(FSocketServer.ClientSocketList.Objects[i]).Socket);
  end;
end;

end.

服务端窗体：ServerMain

unit ServerMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,WinSock,SocketServer;

type
  TServerForm = class(TForm)
    Label2: TLabel;
    ed_Port: TEdit;
    ListBox1: TListBox;
    btn_Start: TButton;
    Label1: TLabel;
    procedure btn_StartClick(Sender: TObject);
  private
    { Private declarations }
    Server: TSocket;
    FStop: Boolean;
    FServerThread: TServerThread;
    FServerSocket : TSocketServer;
    procedure DoGetData(const stream:TMemoryStream);
    procedure DoClientConnected(const socket:TSocket);
    procedure DoClientDisConnected;
  public
    { Public declarations }
  end;

var
  ServerForm: TServerForm;

implementation

{$R *.dfm}
procedure TServerForm.btn_StartClick(Sender: TObject);
begin
  FServerSocket := TSocketServer.Create(Self.Handle,False);
  FServerSocket.Port := StrToInt(ed_Port.Text);
  FServerSocket.OnGetData := Self.DoGetData;
  FServerSocket.OnClientConnected := Self.DoClientConnected;
  if FServerSocket.ListenStart then
    FServerSocket.ResumeThread;
end;

procedure TServerForm.DoClientConnected(const socket: TSocket);
begin
  ListBox1.Items.Add('用户:'+FServerSocket.IP[FServerSocket.ClientSocketList.Count - 1]+'已连接！');
  Label1.Caption := '客户端连接数：'+ IntToStr(FServerSocket.ClientCount);
end;

procedure TServerForm.DoClientDisConnected;
begin
  ListBox1.Items.Add('用户:'+FServerSocket.IP[FServerSocket.ClientSocketList.Count - 1]+'已断开！');
  Label1.Caption := '客户端连接数：'+ IntToStr(FServerSocket.ClientCount);
end;

procedure TServerForm.DoGetData(const stream: TMemoryStream);
var
  i:integer;
  buffer : array [0..1023] of AnsiChar;
  s : AnsiString;
begin
  FillChar(buffer,Length(buffer),0);
  stream.Position := 0;
  stream.Read(buffer,Length(buffer));
  SetString(s,buffer,Length(buffer));

  //Exit为退出标志
  if Trim(s) = 'Exit' then
  begin
    if FServerSocket.ClientIndex = -1 then
      Exit;
    DoClientDisConnected;
    //将退出的套接字的活动状态设置为False
    FServerSocket.ItemActived[FServerSocket.ClientIndex] := False;
    Exit;
  end;
  ListBox1.Items.Add(s);
end;

end.

 

下面是客户端，客户端比较简单，只是实现了发送字符串。

 

客户端单元：SocketClient

unit SocketClient;

interface

uses
  Windows, Classes,SyncObjs ,WinSock ,SysUtils;

type
  TSocketClient = class
  private
    //客户端套接字描述
    FClientSocket : TSocket;
    //服务端地址
    FHost : AnsiString;
    //端口
    FPort : Integer;

    //初始化套接字
    function InitSocket:Boolean;
  public
    constructor Create;overload;
    //连接服务端
    function ConnectToServer:Boolean;
    //发送字符串
    procedure SendData(s:AnsiString);

    property Host : AnsiString read FHost write FHost;
    property Port : Integer read FPort write FPort;
  end;

implementation
const
  BufLen = 1024;
{ TServerClient }

function TSocketClient.ConnectToServer: Boolean;
var
  addr : sockaddr_in;
  hostaddr : u_long;
begin
  Result := False;
  FClientSocket := socket(PF_INET,Sock_Stream,IPPROTO_IP);
  if FClientSocket <> INVALID_SOCKET then
  begin
    addr.sin_family := PF_INET;
    addr.sin_port := htons(FPort);
    hostaddr := inet_addr(PAnsiChar(FHost));
    if hostaddr = -1 then
    begin
      //ShowMessage('IP地址错误！');
      Exit;
    end;
    addr.sin_addr.S_addr := hostaddr;
    if connect(FClientSocket,addr,SizeOf(addr)) <> 0 then
    begin
      //ShowMessage('连接服务器超时！');
      Exit;
    end;
  end;
  Result := True;
  //Label3.Caption := '连接成功！'+IntToStr(Client);
end;

constructor TSocketClient.Create;
begin
  InitSocket;
end;

function TSocketClient.InitSocket: Boolean;
var
  WSA : TWSAData;
begin
  Result := True;
  if WSAStartup($0101,WSA) <> 0 then
  begin
    Result := False;
  end;
end;

procedure TSocketClient.SendData(s:AnsiString);
var
  buffer : array [0..1023] of byte;
begin
  FillChar(buffer,Length(buffer),0);
  Move(s[1],buffer,Length(s));
  WinSock.send(FClientSocket,buffer,Length(s),0);
end;

end.

客户端窗体：ClientMain

unit ClientMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,WinSock,SocketClient;

type
  TClientForm = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    ed_Host: TEdit;
    ed_Port: TEdit;
    btn_Connect: TButton;
    Label3: TLabel;
    Button3: TButton;
    Edit3: TEdit;
    Button5: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btn_ConnectClick(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private declarations }
    Client : TSocket;
    FServerClient : TSocketClient;
  public
    { Public declarations }
  end;

var
  ClientForm: TClientForm;

implementation
{$R *.dfm}

procedure TClientForm.btn_ConnectClick(Sender: TObject);
begin
  FServerClient := TSocketClient.Create;
  FServerClient.Port := StrToIntDef(ed_Port.Text,80);
  FServerClient.Host := AnsiString(ed_Host.Text);
  if FServerClient.ConnectToServer then
    Label3.Caption := '连接服务端成功！';
end;

procedure TClientForm.Button3Click(Sender: TObject);
begin
  FServerClient.SendData(AnsiString(Edit3.Text));
end;

procedure TClientForm.Button5Click(Sender: TObject);
begin
  //发送退出标志
  FServerClient.SendData('Exit');
  //关闭套接字
  WinSock.closesocket(Client);
end;

procedure TClientForm.FormCreate(Sender: TObject);
var
  WSA : TWSAData;
begin
  if WSAStartup($0101,WSA) <> 0 then
  begin
    ShowMessage('创建套接字失败！');
  end;
end;

end.