RealICQClient/Controls/RealICQSockets/BlockingUDPSocket.pas

{
文件名：BlockingUDPSocket.pas
功  能：阻塞方式UDP套接字组件，单独线程接收数据。
建  立：尹进
历  史：
2005.12.23：补文件说明信息（尹进）
}
unit BlockingUDPSocket;

interface

uses
  WinSock2, RealICQSocket, dialogs,RealICQProxy,
  SysUtils, Classes, Windows;

const
  DEFAULT_SENDBUF_SIZE = 8192;
  DEFAULT_RECVBUF_SIZE = 8192;

type
{$M+}
  //绑定UDP端口时出错,端口被占用
  TBindUDPPortFailException = class(TSocketException);

  TBlockingUDPSocketRevcBuf = array of byte;
  TBlockingUDPSocketReceivedDataEvent = procedure(Sender: TObject;
    RecvBuf: TBlockingUDPSocketRevcBuf;
    RecvBytes: Integer;
    RemoteAddress: String;
    RemotePort: Integer) of object;

  TBlockingUDPSocketRecvThread = class;  
  TBlockingUDPSocket = class
  private
    FListening: Boolean;

    FListenSocket: TSocket;
    FListenPort: Integer;
    
    FProxySocket: TSocket;
    FProxy: TProxy;
    FBindProxyAddr: TSockAddrIn;
    
    //发送和接受缓冲大小
    FSendBufSize: Integer;
    FRecvBufSize: Integer;

    FRecvThread: TBlockingUDPSocketRecvThread;
    FCallSynchronize: Boolean;

    FConnectted: Boolean;
    
    FOnStartListen: TNotifyEvent;
    FOnStopListen: TNotifyEvent;
    FOnReceivedData: TBlockingUDPSocketReceivedDataEvent;

    procedure SetProxy(Value: TProxy);
    
    //得到和设置缓冲大小的函数
    function GetSendBufSize: Integer;
    function GetRecvBufSize: Integer;
    procedure SetSendBufSize(Value: Integer);
    procedure SetRecvBufSize(Value: Integer);

    function SendByProxy(var buf;
      Len: Integer;
      RemoteAddress: String;
      RemotePort: Integer): Integer;
  protected
    procedure DoStartListen;
    procedure DoStopListen;
    procedure DoReceivedData(RecvBuf: TBlockingUDPSocketRevcBuf;
      RecvBytes: Integer;
      RemoteAddress: String;
      RemotePort: Integer);
  public
    constructor Create;
    destructor Destroy; override;

    procedure StartListen(AListenPort: Integer);
    procedure StopListen;
    
    procedure Connect(RemoteAddress: String;
      RemotePort: Integer);
    
    procedure SendBuffer(var Buf;
      Size: Integer;
      RemoteAddress: String;
      RemotePort: Integer);
    procedure SendBufferToConnectted(var Buf;
      Size: Integer);
  published
    property Connectted: Boolean read FConnectted;
    property CallSynchronize: Boolean read FCallSynchronize write FCallSynchronize;
    property SendBufSize: Integer read GetSendBufSize write SetSendBufSize;
    property RecvBufSize: Integer read GetRecvBufSize write SetRecvBufSize;
    property Listening: Boolean read FListening;
    property ListenPort: Integer read FListenPort;
    property Proxy: TProxy read FProxy write SetProxy;
    property OnStartListen: TNotifyEvent read FOnStartListen write FOnStartListen;
    property OnStopListen: TNotifyEvent read FOnStopListen write FOnStopListen;
    property OnReceivedData: TBlockingUDPSocketReceivedDataEvent read FOnReceivedData write FOnReceivedData;
  end;

  //用于接收数据的线程
  TBlockingUDPSocketRecvThread = class(TThread)
  private
    FBlockingUDPSocket: TBlockingUDPSocket;
    FBuf: TBlockingUDPSocketRevcBuf;
    FRecvBytes: Integer;
    FRemoteAddr: TSockAddrIn;
    procedure DoReceivedData;
  protected
    procedure Execute; override;
  public
    constructor Create(ABlockingUDPSocket: TBlockingUDPSocket);
    destructor Destroy; override;
  published
  end;

implementation
{TBlockingUDPSocketRecvThread}
//------------------------------------------------------------------------------
procedure TBlockingUDPSocketRecvThread.DoReceivedData();
begin
  if Assigned(FBlockingUDPSocket) then
    FBlockingUDPSocket.DoReceivedData(FBuf, FRecvBytes, inet_ntoa(FRemoteAddr.sin_addr), ntohs(FRemoteAddr.sin_port));
end;

//------------------------------------------------------------------------------
procedure TBlockingUDPSocketRecvThread.Execute;
var
  fromLen,
  ErrorCode: Integer;
begin
  FreeOnTerminate := True;
  FRemoteAddr.sin_port:= htons(FBlockingUDPSocket.FListenPort);
  FRemoteAddr.sin_addr.S_addr:= htonl(INADDR_ANY);
  FRemoteAddr.sin_family:= AF_INET;
  fromLen := SizeOf(FRemoteAddr);
  while (not Terminated) do
  begin
    if FBlockingUDPSocket = nil then break;
    FRecvBytes := recvfrom(FBlockingUDPSocket.FListenSocket, FBuf[0], Length(FBuf), 0, FRemoteAddr, fromLen);
    if FRecvBytes = SOCKET_ERROR then
    begin
      ErrorCode := GetLastError;
      if (ErrorCode = WSAENOTSOCK) then
      begin
        FRecvBytes := 0;
      end
      else
      begin
        Sleep(1);
        Continue;
      end;
    end;

    if FRecvBytes = 0 then
    begin
      if Assigned(FBlockingUDPSocket) then
        Synchronize(FBlockingUDPSocket.StopListen);
      Exit;  
    end;

    if FBlockingUDPSocket = nil then break;    
    if (FBlockingUDPSocket.Proxy.ProxyType = ptSocks5) then
    begin

      if (FBlockingUDPSocket.FBindProxyAddr.sin_addr.S_addr = FRemoteAddr.sin_addr.S_addr) and
        (FBlockingUDPSocket.FBindProxyAddr.sin_port = FRemoteAddr.sin_port) and
        (FBuf[0] = $00) and
        (FBuf[1] = $00) and
        (FBuf[2] = $00) and
        (FBuf[3] = $01) then
      begin
        CopyMemory(@FRemoteAddr.sin_addr, @FBuf[4], 4);  //远程机器地址
        CopyMemory(@FRemoteAddr.sin_port, @FBuf[8], 2);  //远程机器端口
      
        FRecvBytes := FRecvBytes - 10;
        CopyMemory(@FBuf[0], @FBuf[10], FRecvBytes);   //实际数据
      end;
    end;

      
    if FRecvBytes = 0 then
    begin
      if Assigned(FBlockingUDPSocket) then
        Synchronize(FBlockingUDPSocket.StopListen);
      Exit;  
    end
    else
    begin  
      try
        if Assigned(FBlockingUDPSocket) then
        begin
          if FBlockingUDPSocket.FCallSynchronize then
            Synchronize(DoReceivedData)
          else
            DoReceivedData;
        end;
      except
      end;
    end;
  end;
end;
//------------------------------------------------------------------------------
constructor TBlockingUDPSocketRecvThread.Create(ABlockingUDPSocket: TBlockingUDPSocket);
begin
  inherited Create(True);

  FBlockingUDPSocket := ABlockingUDPSocket;
  SetLength(FBuf, FBlockingUDPSocket.RecvBufSize);
  Resume;
end;

//------------------------------------------------------------------------------
destructor TBlockingUDPSocketRecvThread.Destroy;
begin
  if FBlockingUDPSocket <> nil then FBlockingUDPSocket.FRecvThread := nil;
  
  inherited Destroy;
end;


{TBlockingUDPSocket}
//------------------------------------------------------------------------------
procedure TBlockingUDPSocket.SetProxy(Value: TProxy);
begin
  if Assigned(Value) then FProxy.Assign(Value);
end;

//------------------------------------------------------------------------------
function TBlockingUDPSocket.GetRecvBufSize: Integer;
begin
  Result:= FRecvBufSize;
end;

//------------------------------------------------------------------------------
function TBlockingUDPSocket.GetSendBufSize: Integer;
begin
  Result:= FSendBufSize;
end;

//------------------------------------------------------------------------------
procedure TBlockingUDPSocket.SetRecvBufSize(Value: Integer);
var
  ErrorCode: Integer;
begin
  if FRecvBufSize <> Value then
  begin
    ErrorCode:= setsockopt(FListenSocket, SOL_SOCKET, SO_RCVBUF, @Value, sizeof(Value));
    if ErrorCode = SOCKET_ERROR then
      raise TSocketException.CreateFmt('设置接收缓冲区出错。错误码是%d', [GetLastError]);
    FRecvBufSize:= Value;
  end;
end;

//------------------------------------------------------------------------------
procedure TBlockingUDPSocket.SetSendBufSize(Value: Integer);
var
  ErrorCode: Integer;
begin
  if FSendBufSize <> Value then
  begin
    ErrorCode:= setsockopt(FListenSocket, SOL_SOCKET, SO_SNDBUF, @Value, sizeof(Value));
    if ErrorCode = SOCKET_ERROR then
      raise TSocketException.CreateFmt('设置发送缓冲区错误。错误码是%d', [GetLastError]);
    FSendBufSize:= Value;
  end;
end;

//------------------------------------------------------------------------------
function TBlockingUDPSocket.SendByProxy(var Buf;
  Len: Integer;
  RemoteAddress: String;
  RemotePort: Integer): Integer;
var
  TempBuf: array[0..2047] of Byte;
  saRemote: TSockAddrIn;
begin
  saRemote.sin_family:= AF_INET;
  saRemote.sin_port:= htons(RemotePort);
  saRemote.sin_addr.S_addr:= inet_addr(PChar(RemoteAddress));
  
  // 加上报头
  FillChar(TempBuf, 2047, $0);
  TempBuf[0]:= $00;  //保留
  TempBuf[1]:= $00;  //保留
  TempBuf[2]:= $00;  //是否分段重组(此处不用)
  TempBuf[3]:= $01;  //IPv4
  CopyMemory(@TempBuf[4], @saRemote.sin_addr, 4);    //代理服务器地址
  CopyMemory(@TempBuf[8], @saRemote.sin_port, 2);  //代理服务器端口
  CopyMemory(@TempBuf[10], @Buf, Len); //实际数据
  Result:= sendto(FListenSocket, TempBuf, Len + 10, 0, FBindProxyAddr, SizeOf(FBindProxyAddr));
end;

//------------------------------------------------------------------------------
procedure TBlockingUDPSocket.Connect(RemoteAddress: String;
      RemotePort: Integer);
var
  serverAddr: TSockAddrIn;
  lastError: Integer;
  ARemoteIP: String;
begin
  FConnectted := False; 
  if not HostToIP(RemoteAddress, ARemoteIP) then ARemoteIP := RemoteAddress;
         
  serverAddr.sin_family:= AF_INET;
  serverAddr.sin_port:= htons(RemotePort);
  serverAddr.sin_addr.S_addr:= inet_addr(PAnsiChar(ARemoteIP));

  WinSock2.connect(FListenSocket, @serverAddr, SizeOf(serverAddr));
  lastError := WSAGetLastError();
  if lastError <> 0 then
    FConnectted := False
  else
    FConnectted := (Proxy.ProxyType = ptNone); 
end;

//------------------------------------------------------------------------------
procedure TBlockingUDPSocket.SendBufferToConnectted(var Buf;
      Size: Integer);
//var
//  SendBytes,
//  ErrorCode:Integer;
begin
  //SendBytes:=
  send(FListenSocket, Buf, Size, 0);
  {if SendBytes = SOCKET_ERROR then
  begin
    ErrorCode := GetLastError;
    if ErrorCode <> WSAEWOULDBLOCK then
    begin
      if ErrorCode <> 0 then Disconnect;
    end;
  end;}
end;

//------------------------------------------------------------------------------
procedure TBlockingUDPSocket.SendBuffer(var Buf;
      Size: Integer;
      RemoteAddress: String;
      RemotePort: Integer);
var
  ret, ErrorCode: Integer;
  saRemote: TSockAddrIn;
  ARemoteIP: String;
begin
  if not HostToIP(RemoteAddress, ARemoteIP) then ARemoteIP := RemoteAddress;

  saRemote.sin_family:= AF_INET;
  saRemote.sin_port:= htons(RemotePort);
  saRemote.sin_addr.S_addr:= inet_addr(PChar(ARemoteIP));

  if saRemote.sin_addr.S_addr = INADDR_NONE then
    raise TSocketException.Create('无效的远程主机地址!');

  if Proxy.ProxyType = ptSocks5 then
    ret:= SendByProxy(Buf, Size, RemoteAddress, RemotePort)
  else
    ret:= sendto(FListenSocket, Buf, Size, 0, saRemote, SizeOf(saRemote));
  if ret = SOCKET_ERROR then
  begin
    ErrorCode := GetLastError;
    if ErrorCode <> WSAEWOULDBLOCK then
    begin
      {
      if ErrorCode <> 0 then
        raise TSocketException.CreateFmt('发送数据时出错。错误码是%d', [ErrorCode]);
      }
    end;
  end;
end;

//------------------------------------------------------------------------------
procedure TBlockingUDPSocket.StartListen(AListenPort: Integer);
var
  localAddr: TSockAddrIn;
  length: Integer;
  lastError: Integer;
begin
  if (AListenPort < 0) or (AListenPort > 65535) then
    raise TSocketException.Create('端口号必须为0-65535之间的数值');

  FListenPort := AListenPort;
  if FListening then StopListen;

  FListenSocket := Socket(AF_INET, SOCK_DGRAM, IPPROTO_UDP);
  if FListenSocket = INVALID_SOCKET then raise TSocketException.CreateFmt('创建套接字失败，错误代码：%d',[WSAGetLastError]);

  //设置缓冲区大小
  RecvBufSize := FRecvBufSize;
  SendBufSize := FSendBufSize;

  {
  //设置在TIME_WAIT状态下可以再次在相同的端口上监听
  bReLinten:= True;
  setsockopt(FListenSocket, SOL_SOCKET, SO_REUSEADDR, @bReLinten, SizeOf(bReLinten));
  }
  
  localAddr.sin_family:= AF_INET;
  localAddr.sin_port:= htons(FListenPort);
  localAddr.sin_addr.S_addr:= htonl(INADDR_ANY);

  WinSock2.bind(FListenSocket, @localAddr, SizeOf(localAddr));
  lastError := WSAGetLastError();
  if lastError <> 0 then raise TBindUDPPortFailException.CreateFmt('绑定本地UDP端口 %d 失败，错误代码：%d',[FListenPort, lastError]);

  length := SizeOf(localAddr);
  getSockname(FListenSocket, localAddr, length);
  FListenPort := ntohs(localAddr.sin_port);

  case  FProxy.ProxyType of
    ptSocks5:
      begin
        if FProxy.Address = '' then raise TSocketException.Create('必须先设置代理服务器地址');
        if FProxy.Port = 0 then raise TSocketException.Create('必须先设置代理服务器端口');
        FProxySocket := ConnectToSocks5Proxy('', FListenPort,
                             FProxy.Address, FProxy.Port,
                             FProxy.Username, FProxy.Password,
                             ppUDP, FBindProxyAddr);
      end;
    ptHttp:
      begin
        raise TSocketException.Create('当前版本不支持UDP协议的HTTP代理');
      end;
  end;

  FRecvThread := TBlockingUDPSocketRecvThread.Create(Self);
  FListening := True;
  DoStartListen;
end;

//------------------------------------------------------------------------------
procedure TBlockingUDPSocket.StopListen;
begin
    try
      if FRecvThread <> nil then FRecvThread.FBlockingUDPSocket := nil;
      
      closeSocket(FListenSocket);
      FListenSocket := INVALID_SOCKET;

      try
        shutdown(FProxySocket, SD_BOTH);
      finally
        closeSocket(FProxySocket);
        FProxySocket:= INVALID_SOCKET;
      end;
    finally
      FListening := False;
      DoStopListen;
    end;
end;

//------------------------------------------------------------------------------
procedure TBlockingUDPSocket.DoReceivedData(RecvBuf: TBlockingUDPSocketRevcBuf;
  RecvBytes: Integer;
  RemoteAddress: String;
  RemotePort: Integer);
begin
 
  if Assigned(FOnReceivedData) then FOnReceivedData(Self, RecvBuf, RecvBytes, RemoteAddress, RemotePort);
end;

//------------------------------------------------------------------------------
procedure TBlockingUDPSocket.DoStartListen;
begin
  if Assigned(FOnStartListen) then FOnStartListen(Self);
end;

//------------------------------------------------------------------------------
procedure TBlockingUDPSocket.DoStopListen;
begin
  if Assigned(FOnStopListen) then FOnStopListen(Self);
end;

//------------------------------------------------------------------------------
constructor TBlockingUDPSocket.Create;
begin
  inherited Create;
  FConnectted := False;
  FCallSynchronize := True;
  
  FListening := False;
  FListenSocket := INVALID_SOCKET;
  FListenSocket := 0;

  FProxySocket := INVALID_SOCKET;
  FProxy := TProxy.Create();
  
  FSendBufSize := DEFAULT_SENDBUF_SIZE;
  FRecvBufSize := DEFAULT_RECVBUF_SIZE;
end;

//------------------------------------------------------------------------------
destructor TBlockingUDPSocket.Destroy;
begin
  if FListening then StopListen;
  
  FProxy.Free;
  inherited Destroy;
end;

end.