hxUdp.pas
上传用户:hylc_2004
上传日期:2014-01-23
资源大小:46800k
文件大小:18k
源码类别:

Delphi控件源码

开发平台:

Delphi

  1. unit hxUdp;
  2. interface
  3. uses
  4.   Windows, Classes, SysUtils, WinSock2;
  5. const
  6.   DEFAULT_SENDBUF_SIZE = 8192;
  7.   DEFAULT_RECVBUF_SIZE = 8192;
  8. type
  9.   TAuthenType = (atNone, atUserPass);
  10.   ThxUDPRecvThread = class;
  11.   ThxUDPSocket = class;
  12.   TProxyInfo = record
  13.     Enabled:  Boolean;  
  14.     Address:  string;   
  15.     Port:     Integer;  
  16.     Username: string;   
  17.     Password: string;
  18.   end;
  19.   TUDPException = class(Exception);
  20.   TPeerInfo = record
  21.     PeerIP: string;   
  22.     PeerPort: integer;
  23.   end;
  24.   TUDPErrorType = (utInit, utSend, utRecv, utClose);
  25.   TUDPErrorEvent = procedure(Sender: TObject; ErrorType: TUDPErrorType;
  26.     var ErrorCode: Integer) of object;
  27.   TUDPReadEvent = procedure(UDPSocket: ThxUDPSocket; const PeerInfo: TPeerInfo) of object;
  28.   PhxUDPSocket = ^ThxUDPSocket;
  29.   ThxUDPSocket = class(TObject)
  30.   private
  31.     FSocket: TSocket;
  32.     FPort: integer;
  33.     FOnSocketError: TUDPErrorEvent;
  34.     FOnDataRead: TUDPReadEvent;
  35.     FSendBufSize: Integer;
  36.     FRecvBufSize: Integer;
  37.     FPeerInfo: TPeerInfo;
  38.     FTimeOut: Longword;
  39.     FOnTimeOut: TThreadMethod;
  40.     FActive: Boolean;
  41.     FBroadcast: Boolean;
  42.     FProxyInfo: TProxyInfo;
  43.     FTcpSocket: TSocket;
  44.     FUdpProxyAddr: TSockAddrIn;
  45.     function GetSendBufSize: Integer;
  46.     function GetRecvBufSize: Integer;
  47.     procedure SetSendBufSize(Value: Integer);
  48.     procedure SetRecvBufSize(Value: Integer);
  49.     procedure SetActive(Value: Boolean);
  50.     procedure SetTimeOut(Value: Longword);
  51.     function InitSocket: Boolean;
  52.     procedure FreeSocket;
  53.     procedure DoActive(Active: boolean);
  54.     procedure DataReceive;
  55.     function ConnectToProxy: Boolean;
  56.     function Handclasp(Socket: TSocket; AuthenType: TAuthenType): Boolean;
  57.     function MapUdpChannel(Socket: TSocket): Boolean;
  58.     function SendByProxy(Socket: TSocket; var buf; len: Integer; RemoteIP: string;
  59.       RemotePort: Integer): Integer;
  60.     function RecvByProxy(Socket: TSocket; var buf; len: Integer; RemoteIP: string;
  61.       RemotePort: Integer): Integer;
  62.   protected
  63.     FUdpRecvThread: ThxUdpRecvThread;
  64.   public
  65.     constructor Create;
  66.     destructor Destroy; override;
  67.     function SendBuf(var Buf; Size: Integer; IP: string; Port: Integer): Boolean;
  68.     function SendText(Text: string; IP: string; Port: integer): Boolean;
  69.     function BroadcastBuf(var Buf; Size: Integer; Port: Integer): Boolean;
  70.     function BroadcastText(Text: string; Port: Integer): Boolean;
  71.     function RecvBuf(var Buf; Size: Integer; IP: string; Port: Integer): Boolean;
  72.     property PeerInfo: TPeerInfo read FPeerInfo;
  73.     property SendBufSize: Integer read GetSendBufSize write SetSendBufSize;
  74.     property RecvBufSize: Integer read GetRecvBufSize write SetRecvBufSize;
  75.     property Port: Integer read FPort write FPort;
  76.     property TimeOut: DWORD read FTimeOut write SetTimeOut;
  77.     property Active: Boolean read FActive write SetActive;
  78.     property EnableBroadcast: Boolean read FBroadcast write FBroadcast;
  79.     property ProxyInfo: TProxyInfo read FProxyInfo write FProxyInfo;
  80.     property OnDataRead: TUdpReadEvent read FOnDataRead write FOnDataRead;
  81.     property OnSocketError: TUdpErrorEvent read FOnSocketError write FOnSocketError;
  82.     property OnTimeOut: TThreadMethod read FOnTimeOut write FOnTimeOut;
  83.   end;
  84.   ThxUdpRecvThread = class(TThread)
  85.   private
  86.     FSocket: ThxUdpSocket;
  87.     FEvent: WSAEvent;
  88.     FOnDataRecv: TThreadMethod;
  89.     procedure InitEvent;
  90.     procedure FreeEvent;
  91.   protected
  92.     procedure Execute; override;
  93.   public
  94.     constructor Create(CreateSuspended: Boolean; AUdpSocket: ThxUdpSocket);
  95.     destructor Destroy; override;
  96.     property OnDataRecv: TThreadMethod read FOnDataRecv write FOnDataRecv;
  97.     procedure Stop;
  98.   end;
  99. implementation
  100. { ThxUDPSocket }
  101. function ThxUDPSocket.BroadcastBuf(var Buf; Size, Port: Integer): Boolean;
  102. var
  103.   ret, ErrorCode: Integer;
  104.   saRemote: TSockAddrIn;
  105. begin
  106.   Result:= False;
  107.   saRemote.sin_family:= AF_INET;
  108.   saRemote.sin_port:= htons(Port);
  109.   saRemote.sin_addr.S_addr:= htonl(INADDR_BROADCAST);
  110.   if FProxyInfo.Enabled then
  111.     ret:= SendByProxy(FSocket, Buf, Size, inet_ntoa(saRemote.sin_addr), ntohs(saRemote.sin_port))
  112.   else
  113.     ret:= sendto(FSocket, Buf, Size, 0, saRemote, SizeOf(saRemote));
  114.   if ret = SOCKET_ERROR then
  115.   begin
  116.     ErrorCode:= GetLastError;
  117.     if ErrorCode <> WSAEWOULDBLOCK then
  118.     begin
  119.       if Assigned(FOnSocketError) then
  120.         FOnSocketError(Self, utSend, ErrorCode);
  121.       if ErrorCode <> 0 then
  122.         raise TUDPException.CreateFmt('广播数据时出错。错误码是%d', [ErrorCode]);
  123.     end;
  124.   end
  125.   else
  126.     Result:= True;
  127. end;
  128. function ThxUDPSocket.BroadcastText(Text: string; Port: Integer): Boolean;
  129. begin
  130.   Result:= BroadcastBuf(Text[1], Length(Text), Port);
  131. end;
  132. constructor ThxUDPSocket.Create;
  133. var
  134.   WSAData: TWSAData;
  135. begin
  136.   FActive:= False;
  137.   FPort:= 0;
  138.   FillChar(FPeerInfo, SizeOf(TPeerInfo), 0);
  139.   FSendBufSize:= DEFAULT_SENDBUF_SIZE;
  140.   FRecvBufSize:= DEFAULT_RECVBUF_SIZE;
  141.   FSocket:= INVALID_SOCKET;
  142.   FUdpRecvThread:= nil;
  143.   FTimeOut:= $FFFFFFFF;
  144.   FBroadcast:= False;
  145.   FTcpSocket:= INVALID_SOCKET;
  146.   if WSAStartup(MakeWord(2, 2), WSAData) <> 0 then
  147.     raise TUDPException.Create('本程序需要WinSock2,该机器上的Socket版本太低!');
  148. end;
  149. destructor ThxUDPSocket.Destroy;
  150. begin
  151.   if FActive then
  152.     DoActive(False);
  153.   if FTcpSocket <> INVALID_SOCKET then
  154.     closesocket(FTcpSocket);
  155.   if WSACleanup <> 0 then
  156.     MessageBox(0, 'Socket清理失败!', '错误', MB_OK + MB_ICONERROR);
  157.   inherited Destroy;
  158. end;
  159. procedure ThxUDPSocket.DoActive(Active: boolean);
  160. var
  161.   ErrorCode: Integer;
  162. begin
  163.   if Active = True then
  164.   begin
  165.     if InitSocket then
  166.     begin
  167.       FActive:= True;
  168.       try
  169.         SetSendBufSize(FSendBufSize);
  170.         SetRecvBufSize(FRecvBufSize);
  171.         FUdpRecvThread:= ThxUDPRecvThread.Create(True, Self);
  172.         FUdpRecvThread.FOnDataRecv:= DataReceive;
  173.         FUdpRecvThread.Resume;
  174.       except
  175.         DoActive(False);
  176.         raise TUDPException.Create('建立监听线程发生错误!');
  177.       end;
  178.     end
  179.     else
  180.     begin
  181.       ErrorCode:= GetLastError;
  182.       if Assigned(FOnSocketError) then
  183.         FOnSocketError(Self, utInit, ErrorCode);
  184.       if ErrorCode <> 0 then
  185.         raise TUDPException.CreateFmt('初始化套接字发生错误,错误码是%d', [ErrorCode]);
  186.     end;
  187.   end
  188.   else
  189.   begin
  190.     if Assigned(FUDPRecvThread) then
  191.     begin
  192.       FUdpRecvThread.Stop;
  193.       FreeAndNil(FUDPRecvThread);
  194.     end;
  195.     FreeSocket;
  196.     FActive:= False;
  197.   end;
  198. end;
  199. procedure ThxUDPSocket.FreeSocket;
  200. begin
  201.   if FSocket <> INVALID_SOCKET then
  202.   begin
  203.     closesocket(FSocket);
  204.     FSocket:= INVALID_SOCKET;
  205.   end;
  206.   if FTcpSocket <> INVALID_SOCKET then
  207.   begin
  208.     closesocket(FTcpSocket);
  209.     FTcpSocket:= INVALID_SOCKET;
  210.   end;
  211. end;
  212. function ThxUDPSocket.GetRecvBufSize: Integer;
  213. begin
  214.   Result:= FRecvBufSize;
  215. end;
  216. function ThxUDPSocket.GetSendBufSize: Integer;
  217. begin
  218.   Result:= FSendBufSize;
  219. end;
  220. function ThxUDPSocket.InitSocket: Boolean;
  221. var
  222.   saLocal: TSockAddrIn;
  223.   bReLinten: Boolean;
  224.   length:Integer;
  225. begin
  226.   Result:= False;
  227.   FSocket:= WSASocket(AF_INET, SOCK_DGRAM, 0, nil, 0, WSA_FLAG_OVERLAPPED);
  228.   if FSocket = INVALID_SOCKET then
  229.     Exit;
  230.   bReLinten:= True;
  231.   if setsockopt(FSocket, SOL_SOCKET, SO_REUSEADDR, @bReLinten, SizeOf(bReLinten)) <> 0 then
  232.     Exit;
  233.   if setsockopt(FSocket, SOL_SOCKET, SO_BROADCAST, @FBroadcast, SizeOf(Integer)) <> 0 then
  234.     Exit;
  235.   saLocal.sin_family:= AF_INET;
  236.   saLocal.sin_port:= htons(FPort);
  237.   saLocal.sin_addr.S_addr:= INADDR_ANY;
  238.   if bind(FSocket, @saLocal, SizeOf(saLocal)) = SOCKET_ERROR then
  239.   begin
  240.     FreeSocket;
  241.     Exit;
  242.   end;
  243.   length:=SizeOf(saLocal);
  244.   getsockname(FSocket, saLocal, length);
  245.   Port:=ntohs(saLocal.sin_port);
  246.   if FProxyInfo.Enabled then
  247.   begin
  248.     if not ConnectToProxy then
  249.       Exit;
  250.   end;
  251.   Result:= True;
  252. end;
  253. procedure ThxUDPSocket.DataReceive;
  254. begin
  255.   if Assigned(FOnDataRead) then
  256.     FOnDataRead(Self, FPeerInfo);
  257. end;
  258. function ThxUDPSocket.RecvBuf(var Buf; Size: Integer; IP: string; Port: Integer): Boolean;
  259. var
  260.   saRemote: TSockAddrIn;
  261.   ret, fromlen: Integer;
  262.   ErrorCode: Integer;
  263. begin
  264.   Result:= False;
  265.   saRemote.sin_family:= AF_INET;
  266.   saRemote.sin_addr.S_addr:= inet_addr(PChar(IP));
  267.   saRemote.sin_port:= htons(Port);
  268.   fromlen:= SizeOf(saRemote);
  269.   if FProxyInfo.Enabled then
  270.     ret:= RecvByProxy(FSocket, Buf, Size, IP, Port)
  271.   else
  272.     ret:= recvfrom(FSocket, Buf, Size, 0, saRemote, fromlen);
  273.   with FPeerInfo do
  274.   begin
  275.     PeerIP:= inet_ntoa(saRemote.sin_addr);
  276.     PeerPort:= ntohs(saRemote.sin_port);
  277.   end;
  278.   if ret = SOCKET_ERROR then
  279.   begin
  280.     ErrorCode:= GetLastError;
  281.     if ErrorCode <> WSAEWOULDBLOCK then
  282.     begin
  283.       if Assigned(FOnSocketError) then
  284.         FOnSocketError(Self, utRecv, ErrorCode);
  285.       if ErrorCode <> 0 then
  286.         raise TUDPException.CreateFmt('接收数据出错。错误码是%d', [ErrorCode]);
  287.     end;
  288.   end
  289.   else
  290.     Result:= True;
  291. end;
  292. function ThxUDPSocket.SendBuf(var Buf; Size: Integer; IP: string; Port: Integer): Boolean;
  293. var
  294.   ret, ErrorCode: Integer;
  295.   saRemote: TSockAddrIn;
  296. begin
  297.   Result:= False;
  298.   saRemote.sin_family:= AF_INET;
  299.   saRemote.sin_port:= htons(Port);
  300.   saRemote.sin_addr.S_addr:= inet_addr(PChar(IP));
  301.   if saRemote.sin_addr.S_addr = INADDR_NONE then
  302.     raise TUDPException.Create('无效的远程主机地址!');
  303.   if FProxyInfo.Enabled then
  304.     ret:= SendByProxy(FSocket, Buf, Size, IP, Port)
  305.   else
  306.     ret:= sendto(FSocket, Buf, Size, 0, saRemote, SizeOf(saRemote));
  307.   if ret = SOCKET_ERROR then
  308.   begin
  309.     ErrorCode:= GetLastError;
  310.     if ErrorCode <> WSAEWOULDBLOCK then
  311.     begin
  312.       if Assigned(FOnSocketError) then
  313.         FOnSocketError(Self, utSend, ErrorCode);
  314.       if ErrorCode <> 0 then
  315.         raise TUDPException.CreateFmt('发送数据时出错。错误码是%d', [ErrorCode]);
  316.     end;
  317.   end
  318.   else
  319.     Result:= True;
  320. end;
  321. function ThxUDPSocket.SendText(Text, IP: string; Port: integer): Boolean;
  322. begin
  323.   Result := SendBuf(Pointer(Text)^, Length(Text), IP, Port);
  324. end;
  325. procedure ThxUDPSocket.SetActive(Value: Boolean);
  326. begin
  327.   if FActive <> Value then
  328.     DoActive(Value);
  329. end;
  330. procedure ThxUDPSocket.SetRecvBufSize(Value: Integer);
  331. var
  332.   ErrorCode: Integer;
  333. begin
  334.   if FRecvBufSize <> Value then
  335.   begin
  336.     ErrorCode:= setsockopt(FSocket, SOL_SOCKET, SO_RCVBUF, @Value, sizeof(Value));
  337.     if ErrorCode = SOCKET_ERROR then
  338.       raise TUDPException.CreateFmt('设置接收缓冲区出错。错误码是%d', [GetLastError]);
  339.     FRecvBufSize:= Value;
  340.   end;
  341. end;
  342. procedure ThxUDPSocket.SetSendBufSize(Value: Integer);
  343. var
  344.   ErrorCode: Integer;
  345. begin
  346.   if FSendBufSize <> Value then
  347.   begin
  348.     ErrorCode:= setsockopt(FSocket, SOL_SOCKET, SO_SNDBUF, @Value, sizeof(Value));
  349.     if ErrorCode = SOCKET_ERROR then
  350.       raise TUDPException.CreateFmt('设置发送缓冲区错误。错误码是%d', [GetLastError]);
  351.     FSendBufSize:= Value;
  352.   end;
  353. end;
  354. procedure ThxUDPSocket.SetTimeOut(Value: Longword);
  355. begin
  356.   if FTimeOut <> Value then
  357.     FTimeOut:= Value;
  358. end;
  359. function ThxUDPSocket.ConnectToProxy: Boolean;
  360. var
  361.   saProxy: TSockAddrIn;
  362.   ret: Integer;
  363.   bRet: Boolean;
  364. begin
  365.   Result:= False;
  366.   if FTcpSocket = INVALID_SOCKET then
  367.     FTcpSocket:= socket(AF_INET, SOCK_STREAM, 0);
  368.   saProxy.sin_family:= AF_INET;
  369.   saProxy.sin_port:= htons(FProxyInfo.Port);
  370.   saProxy.sin_addr.S_addr:= inet_addr(PChar(FProxyInfo.Address));
  371.   ret:= connect(FTcpSocket, @saProxy, SizeOf(saProxy));
  372.   if ret = SOCKET_ERROR then
  373.     raise Exception.CreateFmt('无法连接到代理服务器,错误码是%d', [WSAGetLastError]);
  374.   if Trim(FProxyInfo.Username) <> '' then
  375.     bRet:= Handclasp(FTcpSocket, atUserPass)
  376.    else
  377.     bRet:= Handclasp(FTcpSocket, atNone);
  378.   if not bRet then
  379.   begin
  380.     closesocket(FTcpSocket);
  381.     raise Exception.CreateFmt('代理服务器身份验证失败!错误码是%d', [WSAGetLastError]);
  382.   end;
  383.   if not MapUdpChannel(FTcpSocket) then
  384.   begin
  385.     closesocket(FTcpSocket);
  386.     raise Exception.CreateFmt('代理服务器不支持UDP!错误码是%d', [WSAGetLastError]);
  387.   end;
  388.   Result:= True;
  389. end;
  390. function ThxUDPSocket.Handclasp(Socket: TSocket; AuthenType: TAuthenType): Boolean;
  391. var
  392.   Buf: array[0..255] of Byte;
  393.   I, Ret: Integer;
  394.   Username, Password: string;
  395. begin
  396.   Result:= False;
  397.   case AuthenType of
  398.     atNone:
  399.     begin
  400.       Buf[0]:= $05;
  401.       Buf[1]:= $01;
  402.       Buf[2]:= $00;
  403.       Ret:= send(Socket, Buf, 3, 0);
  404.       if Ret = -1 then Exit;
  405.       FillChar(Buf, 256, #0);
  406.       Ret:= recv(Socket, Buf, 256, 0);
  407.       if Ret < 2 then Exit;
  408.       if Buf[1] <> $00 then Exit;
  409.       Result:= True;
  410.     end;
  411.     atUserPass:
  412.     begin
  413.       Buf[0]:= $05; // Socks版本号
  414.       Buf[1]:= $02; // 两种认证方法
  415.       Buf[2]:= $00; // 无需校验
  416.       Buf[3]:= $02; // 需用户名密码校验
  417.       Ret:= send(Socket, Buf, 4, 0);
  418.       if Ret = -1 then Exit;
  419.       FillChar(Buf, 256, #0);
  420.       Ret:= recv(Socket, Buf, 256, 0);
  421.       if Ret < 2 then Exit;
  422.       if Buf[1] <> $02 then Exit;
  423.       Username:= FProxyInfo.Username;
  424.       Password:= FProxyInfo.Password;
  425.       FillChar(Buf, 256, #0);
  426.       Buf[0]:= $01;
  427.       Buf[1]:= Length(Username);
  428.       for I:= 0 to Buf[1] - 1 do
  429.         Buf[2 + I]:= Ord(Username[I + 1]);
  430.       Buf[2 + Length(Username)]:= Length(Password);
  431.       for I:= 0 to Buf[2 + Length(Username)] - 1 do
  432.         Buf[3 + Length(Username) + I]:= Ord(Password[I + 1]);
  433.       Ret:= send(Socket, Buf, Length(Username) + Length(Password) + 3, 0);
  434.       if Ret = -1 then Exit;
  435.       Ret:= recv(Socket, Buf, 256, 0);
  436.       if Ret = -1 then Exit;
  437.       if Buf[1] <> $00 then Exit;
  438.       Result:= True;
  439.     end;
  440.   end;
  441. end;
  442. function ThxUDPSocket.MapUdpChannel(Socket: TSocket): Boolean;
  443. var
  444.   saLocal: TSockAddrIn;
  445.   NameLen: Integer;
  446.   ProxyAddr: TInAddr;
  447.   ProxyPort: Word;
  448.   Buf: array[0..255] of Byte;
  449. begin
  450.   Result:= False;
  451.   NameLen:= SizeOf(saLocal);
  452.   getsockname(FSocket, saLocal, NameLen);
  453.   Buf[0]:= $05;
  454.   Buf[1]:= $03;
  455.   Buf[2]:= $00;
  456.   Buf[3]:= $01;
  457.   CopyMemory(@Buf[4], @saLocal.sin_addr, 4);
  458.   CopyMemory(@Buf[8], @saLocal.sin_port, 2);
  459.   send(Socket, Buf, 10, 0);
  460.   FillChar(Buf, 256, #0);
  461.   recv(Socket, Buf, 256, 0);
  462.   if (Buf[0] <> $05) and (Buf[1] <> $00) then
  463.     Exit;
  464.   CopyMemory(@ProxyAddr, @Buf[4], 4); 
  465.   CopyMemory(@ProxyPort, @Buf[8], 2);
  466.   FUdpProxyAddr.sin_family:= AF_INET;
  467.   FUdpProxyAddr.sin_port:= ProxyPort;
  468.   FUdpProxyAddr.sin_addr:= ProxyAddr;
  469.   Result:= True;
  470. end;
  471. function ThxUDPSocket.SendByProxy(Socket: TSocket; var buf; len: Integer;
  472.   RemoteIP: string; RemotePort: Integer): Integer;
  473. var
  474.   TempBuf: array[0..1023] of Byte;
  475.   saRemote: TSockAddrIn;
  476. begin
  477.   saRemote.sin_family:= AF_INET;
  478.   saRemote.sin_port:= htons(RemotePort);
  479.   saRemote.sin_addr.S_addr:= inet_addr(PChar(RemoteIP));
  480.   FillChar(TempBuf, 1023, $0);
  481.   TempBuf[0]:= $00;  
  482.   TempBuf[1]:= $00;  
  483.   TempBuf[2]:= $00;  
  484.   TempBuf[3]:= $01;
  485.   CopyMemory(@TempBuf[4], @saRemote.sin_addr, 4);  
  486.   CopyMemory(@TempBuf[8], @saRemote.sin_port, 2);
  487.   CopyMemory(@TempBuf[10], @buf, len);
  488.   Result:= sendto(Socket, TempBuf, len + 10, 0, FUdpProxyAddr, SizeOf(FUdpProxyAddr));
  489.   if Result = SOCKET_ERROR then
  490.     raise Exception.CreateFmt('发送数据错误!错误号是%d', [WSAGetLastError]);
  491. end;
  492. function ThxUDPSocket.RecvByProxy(Socket: TSocket; var buf; len: Integer;
  493.   RemoteIP: string; RemotePort: Integer): Integer;
  494. var
  495.   TempBuf: array[0..1023] of Byte;
  496.   saRemote: TSockAddrIn;
  497.   fromlen: Integer;
  498. begin
  499.   FillChar(TempBuf, 1024, #0);
  500.   saRemote.sin_family:= AF_INET;
  501.   saRemote.sin_port:= htons(RemotePort);
  502.   saRemote.sin_addr.S_addr:= inet_addr(PChar(RemoteIP));
  503.   fromlen:= SizeOf(saRemote);
  504.   Result:= recvfrom(Socket, TempBuf, len, 0, saRemote, fromlen);
  505.   if Result = SOCKET_ERROR then
  506.     raise Exception.CreateFmt('接收数据错误!错误号是%d', [WSAGetLastError]);
  507.   Assert(TempBuf[0] = $00); 
  508.   Assert(TempBuf[1] = $00); 
  509.   Assert(TempBuf[2] = $00); 
  510.   Assert(TempBuf[3] = $01);
  511.   CopyMemory(@saRemote.sin_addr, @TempBuf[4], 4); 
  512.   CopyMemory(@saRemote.sin_port, @TempBuf[8], 2);
  513.   CopyMemory(@buf, @TempBuf[10], len);
  514. end;
  515. { ThxUdpRecvThread }
  516. constructor ThxUdpRecvThread.Create(CreateSuspended: Boolean; AUdpSocket: ThxUdpSocket);
  517. begin
  518.   inherited Create(CreateSuspended);
  519.   FSocket:= AUDPSocket;
  520.   FEvent:= WSA_INVALID_EVENT;
  521.   InitEvent;
  522. end;
  523. destructor ThxUdpRecvThread.Destroy;
  524. begin
  525.   if not Terminated then
  526.     Stop;
  527.   FreeEvent;
  528.   inherited Destroy;
  529. end;
  530. procedure ThxUdpRecvThread.Execute;
  531. var
  532.   ErrorCode: Integer;
  533. begin
  534.   while not Terminated do
  535.   begin
  536.     ErrorCode:= WSAWaitForMultipleEvents(
  537.       1,      
  538.       @FEvent,
  539.       False,
  540.       FSocket.FTimeOut,
  541.       False   
  542.     );
  543.     if Terminated then
  544.       Break;
  545.     if ErrorCode = WAIT_IO_COMPLETION then
  546.     begin
  547.       Break;
  548.     end
  549.     else
  550.     begin
  551.       WSAResetEvent(FEvent);
  552.       if ErrorCode = WSA_WAIT_TIMEOUT then
  553.       begin
  554.         if Assigned(FSocket.FOnTimeOut) then
  555.           Synchronize(FSocket.FOnTimeOut);
  556.       end
  557.       else if Assigned(FOnDataRecv) then
  558.         Synchronize(FOnDataRecv);
  559.     end;
  560.   end;
  561. end;
  562. procedure ThxUdpRecvThread.FreeEvent;
  563. begin
  564.   if FEvent <> WSA_INVALID_EVENT then
  565.     WSACloseEvent(FEvent);
  566. end;
  567. procedure ThxUdpRecvThread.InitEvent;
  568. var
  569.   ErrorCode: Integer;
  570. begin
  571.   FEvent:= WSACreateEvent;
  572.   if FEvent = WSA_INVALID_EVENT then
  573.     raise TUDPException.CreateFmt('创建套接字事件句柄出错。错误码是%d', [WSAGetLastError]);
  574.   ErrorCode:= WSAEventSelect(FSocket.FSocket, FEvent, FD_READ);
  575.   if ErrorCode = SOCKET_ERROR then
  576.     raise TUDPException.CreateFmt('设置套接字事件句柄出错。错误码是%d', [WSAGetLastError]);
  577. end;
  578. procedure ThxUdpRecvThread.Stop;
  579. begin
  580.   Terminate;
  581.   SetEvent(FEvent);
  582.   WaitFor;
  583. end;
  584. end.