这里有一个fox1999发过的WSAEventSelect的server类
关于Delphi的WSAEventSelect例子实在是难找,再加上我太菜,拭了试不太会用
能不能帮我讲一讲怎么使用这个类呢? 写成例子当然更好
我会快速结帖的!
先谢谢了,下面是这个类的代码:
unit ServerSocketLite;{******************************************************************************}
{  Unit Name   : ServerSocketLite.pas                                          }
{  Author      : RedFox /Foxbat  CopyRight (c)                                 }
{  E-mail      : [email protected]                                             }
{  Blog        : redsoft.yculblog.com                                          }
{  Baidu Hi    : redfox_hi                                                     }
{  Datetime    : 2008-05-03                                                    }
{  Version     : v1.1                                                          }
{  Description : ServerSocket Class Lite                                       }
{                                                                              }
{  History List                                                                }
{     1. 2008-05-03  Version 1.0                                               }
{     2. 2008-07-06  Version 1.1                                               }  
{******************************************************************************}interfaceuses
  Windows, Messages, WinSock2, SysUtils, Classes;type
  {====================== TTcpServerLite forward define ======================}
  TTcpServerLite = class;  {===================== TTcpClientLite =======================================}
  TTcpClientLite = class
  protected
    m_socket    : TSocket;
    m_saddr     : TSockAddr;
    m_serv      : TTcpServerLite;
    m_csSend    : TRTLCriticalSection;
    m_PeerIp    : string;
    m_PeerPort  : Word;
    m_Closing   : Boolean;
  public
    constructor Create(hsocket : TSocket; saddr : TSockAddr); virtual;
    destructor  Destroy; override;    procedure Close; virtual;
    property  Server: TTcpServerLite read m_serv;
    
    function  Send(Buf: Pointer; BufLen :Integer): Boolean;
  end;  {==================== Event Define ==========================================}
  TClientCloseEvent   = procedure(Sender: TObject; Client: TTcpClientLite) of object;
  TClientConnectEvent = procedure(Sender: TObject; Client: TTcpClientLite) of object;
  TClientRecvEvent    = procedure(Sender: TObject; Client: TTcpClientLite) of object;  TTcpClientLiteClass = class of TTcpClientLite;  {======================== TTcpServerLite ====================================}
  TTcpServerLite = class
  protected
    m_hWnd           : HWND;
    m_ListenSocket   : TSocket;
    m_Clients        : TList;
    m_ClientLock     : TRTLCriticalSection;
    m_Port           : Word;    fOnClientClose   : TClientCloseEvent;
    fOnClientConnect : TClientConnectEvent;
    fOnClientRecv    : TClientRecvEvent;
    function getActive: Boolean;
  protected
    TcpClientClass : TTcpClientLiteClass;
    function  NewClient(hClient: TSocket; saddr : TSockAddr):Boolean;
    function  GetClient(hClient: TSocket): TTcpClientLite;
    procedure DelClient(sckt: TTcpClientLite);
    
    procedure DoClientClose(Client: TTcpClientLite); virtual;
    procedure DoClientConnect(Client: TTcpClientLite);    
    procedure DoClientRecv(Client: TTcpClientLite); virtual;    procedure WndProc(var msg: TMessage);
  public
    constructor Create;
    destructor  Destroy; override;    function  Open(nPort: Word):Boolean;
    procedure Close();
    property Active :Boolean read getActive;
    property Clients:TList read m_Clients;
     
    property OnClientClose: TClientCloseEvent read fOnClientClose write fOnClientClose;
    property OnClientRecv : TClientRecvEvent read fOnClientRecv write fOnClientRecv;
    property OnClientConnect: TClientConnectEvent read fOnClientConnect write fOnClientConnect;  
  end;  implementation const
  WM_SOCKET = WM_APP + 1;{=========================== TTcpClientLite ==================================}//--------------------------------------------------------------------------
// Close TcpClientLite Connection 
procedure TTcpClientLite.Close;
begin
  if (not m_Closing) then
  begin
    shutdown(m_socket, SD_BOTH);
    closesocket(m_socket);
    m_Closing := true;
  end;
end;//-------------------------------------------------------------------------
//  Create New TcpClientLite Object
//     hsocket   : socket handler
//     saddr     : Peer Socket Address
//     return    : New TcpClientLite Created
constructor TTcpClientLite.Create(hsocket: TSocket; saddr : TSockAddr);
begin
  m_socket  := hsocket;
  m_saddr   := saddr;
  m_PeerIp  := inet_ntoa(saddr.sin_addr);
  m_PeerPort:= ntohs(saddr.sin_port); 
  m_Closing := False;
  InitializeCriticalSection(m_csSend);
  inherited Create();
end;destructor TTcpClientLite.Destroy;
begin
  Close;
  DeleteCriticalSection(m_csSend);
  inherited;
end;//-----------------------------------------------------------------------
// Send Data from TcpClientLite to Peer, Thread safed 
//    Buf     : Data Pointer for send
//    BufLen  : Data length want to send
//    return  : true -- Success 
function TTcpClientLite.Send(Buf: Pointer; BufLen: Integer): Boolean;
var
  nSend : Integer;
  pData : PChar;
begin  EnterCriticalSection(m_csSend);
  pData := Buf;
  try
    while BufLen > 0 do
    begin
      nSend := WinSock2.send(m_socket, pData^, BufLen, 0);      if (nSend = SOCKET_ERROR) then
      begin
        if  (WSAGetLastError() = WSAEWOULDBLOCK) then
        begin
          Sleep(5);
          Continue;
        end
        else begin
           Result    := False;
           m_Closing := True; 
           Exit;
        end;
      end;
      Inc(pData, nSend);      Dec(BufLen, nSend);      
    end;
    Result := true;
  finally
    LeaveCriticalSection(m_csSend);
  end;
end;
procedure TTcpServerLite.Close;
var
  i : Integer;
  sckt: TTcpClientLite;
begin
  if not Active then Exit;  WSAAsyncSelect(m_ListenSocket, m_hWnd, WM_SOCKET, 0);
  shutdown(m_ListenSocket, SD_BOTH);
  closesocket(m_ListenSocket);
  m_ListenSocket := INVALID_SOCKET;  // Clear Client List
  EnterCriticalSection(m_ClientLock);
  try
    for i := 0 to m_Clients.Count -1 do
    begin
      sckt := TTcpClientLite(m_Clients.Items[i]);
      WSAAsyncSelect(sckt.m_socket, m_hWnd, WM_SOCKET, 0);
      sckt.Close;
      DoClientClose(sckt);
      sckt.Free;
    end;    m_Clients.Clear;
  finally
    LeaveCriticalSection(m_ClientLock);
  end;
end;
constructor TTcpServerLite.Create;
var
  wsData : TWSAData;
begin
  ZeroMemory(@wsData, SizeOf(TWSAData));
  WSAStartup(2, wsData);
  m_ListenSocket := INVALID_SOCKET;  m_Clients := TList.Create;
  InitializeCriticalSection(m_ClientLock);  TcpClientClass := TTcpClientLite;  m_hWnd := AllocateHWnd(WndProc);
  inherited Create;
end;procedure TTcpServerLite.DelClient(sckt: TTcpClientLite);
begin
  EnterCriticalSection(m_ClientLock);
  try
    m_Clients.Remove(sckt);
    sckt.Free;
  finally
    LeaveCriticalSection(m_ClientLock);
  end;
end;destructor TTcpServerLite.Destroy;
begin
  Close;
  m_Clients.Free;
  DeleteCriticalSection(m_ClientLock);  DeallocateHWnd(m_hWnd);
  WSACleanup;
  inherited;
end;

解决方案 »

  1.   

    procedure TTcpServerLite.DoClientClose(Client: TTcpClientLite);
    begin
      if Assigned(fOnClientClose) then
         fOnClientClose(self, Client);end;procedure TTcpServerLite.DoClientConnect(Client: TTcpClientLite);
    begin
      if Assigned(fOnClientConnect) then
         fOnClientConnect(self, Client);
    end;procedure TTcpServerLite.DoClientRecv(Client: TTcpClientLite);
    begin
      if Assigned(fOnClientRecv) then
         fOnClientRecv(Self, Client);
    end;function TTcpServerLite.getActive: Boolean;
    begin
      Result := m_ListenSocket <> INVALID_SOCKET;
    end;//--------------------------------------------------------------------
    // Find Client Object from ClientList by Socket Handle
    //    hClient : Client Object Socket Handle
    //    return  : Client Object maybe null 
    function TTcpServerLite.GetClient(hClient: TSocket): TTcpClientLite;
    var
      i : Integer;
      sckt: TTcpClientLite;
    begin
      Result := nil;
      EnterCriticalSection(m_ClientLock);
      try
        for i := 0 to m_Clients.Count -1 do
        begin
          sckt := TTcpClientLite(m_Clients[i]);
          if (sckt <> nil) and (sckt.m_socket = hClient) then
          begin
            Result := sckt;
            Exit;
          end;
        end;
      finally
        LeaveCriticalSection(m_ClientLock);
      end;
    end;
    //-----------------------------------------------------------------
    // Create New Client Object and add to ClientList
    //
    function TTcpServerLite.NewClient(hClient: TSocket; saddr: TSockAddr):Boolean;
    var
      Client : TTcpClientLite;
    begin
      Result := false;
      Client := TcpClientClass.Create(hClient, saddr);
      Client.m_serv := Self;
      EnterCriticalSection(m_ClientLock);
      try
        m_Clients.Add(Client);
      finally
        LeaveCriticalSection(m_ClientLock);
      end;  DoClientConnect(Client);
      WSAAsyncSelect(Client.m_socket, m_hWnd, WM_SOCKET, FD_READ or FD_CLOSE);
      
      Result := True;
    end;//----------------------------------------------------------------------
    //  Open Tcp Port to Listen
    //     nPort  : Listen Port, if nPort = 0 then Randmoze Port
    //
    function TTcpServerLite.Open(nPort : Word): Boolean;
    var
      saddr   : TSockAddr;
      nameLen : Integer;
    begin
      Result := False;
      
      if Active then Close;  m_ListenSocket := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);  if m_ListenSocket = INVALID_SOCKET then
      begin
        OutputDebugString('TTcpServerLite.Open: socket error!!!');
        Exit;
      end;  ZeroMemory(@saddr, SizeOf(TSockAddr));
      saddr.sin_family := AF_INET;
      saddr.sin_port   := htons(nPort);  if bind(m_ListenSocket, @saddr, SizeOf(TSockAddr)) = SOCKET_ERROR then
      begin
        OutputDebugString('TTcpServerLite.Open: bind error!!!');
        Exit;
      end;  if listen(m_ListenSocket, 5) = SOCKET_ERROR then
      begin
        OutputDebugString('TTcpServerLite.Open: listen error!!!');
        Exit;
      end;  if nPort = 0 then
      begin
        getsockname(m_ListenSocket, saddr, nameLen);
        m_Port := ntohs(saddr.sin_port);
      end
      else
        m_Port := nPort;  WSAAsyncSelect(m_ListenSocket, m_hWnd, WM_SOCKET, FD_ACCEPT);  Result := True;
    end;
    //-------------------------------------------------------------------
    // Socket Message Process
    //
    procedure TTcpServerLite.WndProc(var msg: TMessage);
    var
      sckt    : TTcpClientLite;
      nErr    : Word;
      nEvt    : Word;
      saddr   : TSockAddrIn;
      addrLen : Integer;
      hClient : TSocket;  
    begin
      case msg.Msg of
        WM_SOCKET:
          begin
            nErr := HiWord(msg.LParam);
            nEvt := loWord(msg.LParam);        case nEvt of
              FD_ACCEPT:
                 begin
                   ZeroMemory(@saddr, SizeOf(TSockAddrIn));
                   addrLen := SizeOf(TSockAddrIn);
                   if (nErr <> 0) then Exit;
                   hClient := accept(m_ListenSocket,saddr, addrLen);
                   if hClient <> INVALID_SOCKET then
                   begin
                     self.NewClient(hClient, saddr);
                   end;
                 end;
                 
              FD_READ:
                 begin
                   hClient := msg.WParam;
                   if nErr <> 0 then Exit;
                   sckt := GetClient(hClient);
                   WSAAsyncSelect(sckt.m_socket, m_hWnd, WM_SOCKET, 0);
                   //WSAAsyncSelect(sckt.m_socket, m_hWnd, WM_SOCKET,FD_WRITE or FD_CLOSE);
                   Self.DoClientRecv(sckt);
                   if sckt.m_Closing then
                   begin
                     DoClientClose(sckt);
                     DelClient(sckt);
                   end
                   else
                     WSAAsyncSelect(sckt.m_socket, m_hWnd, WM_SOCKET, FD_READ or FD_CLOSE);
                 end;          FD_CLOSE:
                 begin
                   hClient := msg.WParam;
                   if nErr <> 0 then Exit;
                   sckt := GetClient(hClient);
                   WSAAsyncSelect(sckt.m_socket, m_hWnd, WM_SOCKET, 0);
                   sckt.Close;
                   Self.DoClientClose(sckt);
                   DelClient(sckt);
                 end;
            end; 
          end;
        else begin
          msg.Result := DefWindowProc(m_hWnd, msg.Msg, msg.WParam, msg.LParam);
        end;
      end;
    end;end.
      

  2.   

    建立一个服务端的话:先创建TTcpServerLite对象,调用Open方向开个端口,等客户端程序连上来,就可以通信了。有数据时会触发OnClientConnect, OnClientRecv事件,在里面写处理代码。
    需要往客户端发数据的话调用Clients[i].Send方法就行了。
      

  3.   

    谢谢liangqingzhi !
    请问Clients对象怎么建立的呢
    比如, MyServer.OnClientConnect:=我的事件;
    但是这个事件要求一个TTcpClientLite参数, 而我只建立了个MyServer对象,Clients对象该怎么建立呢?
      

  4.   

    MyServer.OnClientConnect:=我的事件( TTcpClientLite这个参数怎么写呢? );
      

  5.   

    另外, Clients[i].Send(Buf: Pointer; BufLen: Integer)  Buf和BufLen这两个参数怎么得到呢?
      

  6.   

    当发现有连接上来时,Client对象会自动建立
    比如:MyServer.Clients.Count 就是连上来的客户端的个数
      

  7.   

    标的是WSAEentSelect,实际却用的WSAAsyncSelect
    算了,结帖