hxUdp.pas
上传用户:hylc_2004
上传日期:2014-01-23
资源大小:46800k
文件大小:18k
- unit hxUdp;
- interface
- uses
- Windows, Classes, SysUtils, WinSock2;
- const
- DEFAULT_SENDBUF_SIZE = 8192;
- DEFAULT_RECVBUF_SIZE = 8192;
- type
- TAuthenType = (atNone, atUserPass);
- ThxUDPRecvThread = class;
- ThxUDPSocket = class;
- TProxyInfo = record
- Enabled: Boolean;
- Address: string;
- Port: Integer;
- Username: string;
- Password: string;
- end;
- TUDPException = class(Exception);
- TPeerInfo = record
- PeerIP: string;
- PeerPort: integer;
- end;
- TUDPErrorType = (utInit, utSend, utRecv, utClose);
- TUDPErrorEvent = procedure(Sender: TObject; ErrorType: TUDPErrorType;
- var ErrorCode: Integer) of object;
- TUDPReadEvent = procedure(UDPSocket: ThxUDPSocket; const PeerInfo: TPeerInfo) of object;
- PhxUDPSocket = ^ThxUDPSocket;
- ThxUDPSocket = class(TObject)
- private
- FSocket: TSocket;
- FPort: integer;
- FOnSocketError: TUDPErrorEvent;
- FOnDataRead: TUDPReadEvent;
- FSendBufSize: Integer;
- FRecvBufSize: Integer;
- FPeerInfo: TPeerInfo;
- FTimeOut: Longword;
- FOnTimeOut: TThreadMethod;
- FActive: Boolean;
- FBroadcast: Boolean;
- FProxyInfo: TProxyInfo;
- FTcpSocket: TSocket;
- FUdpProxyAddr: TSockAddrIn;
- function GetSendBufSize: Integer;
- function GetRecvBufSize: Integer;
- procedure SetSendBufSize(Value: Integer);
- procedure SetRecvBufSize(Value: Integer);
- procedure SetActive(Value: Boolean);
- procedure SetTimeOut(Value: Longword);
- function InitSocket: Boolean;
- procedure FreeSocket;
- procedure DoActive(Active: boolean);
- procedure DataReceive;
- function ConnectToProxy: Boolean;
- function Handclasp(Socket: TSocket; AuthenType: TAuthenType): Boolean;
- function MapUdpChannel(Socket: TSocket): Boolean;
- function SendByProxy(Socket: TSocket; var buf; len: Integer; RemoteIP: string;
- RemotePort: Integer): Integer;
- function RecvByProxy(Socket: TSocket; var buf; len: Integer; RemoteIP: string;
- RemotePort: Integer): Integer;
- protected
- FUdpRecvThread: ThxUdpRecvThread;
- public
- constructor Create;
- destructor Destroy; override;
- function SendBuf(var Buf; Size: Integer; IP: string; Port: Integer): Boolean;
- function SendText(Text: string; IP: string; Port: integer): Boolean;
- function BroadcastBuf(var Buf; Size: Integer; Port: Integer): Boolean;
- function BroadcastText(Text: string; Port: Integer): Boolean;
- function RecvBuf(var Buf; Size: Integer; IP: string; Port: Integer): Boolean;
- property PeerInfo: TPeerInfo read FPeerInfo;
- property SendBufSize: Integer read GetSendBufSize write SetSendBufSize;
- property RecvBufSize: Integer read GetRecvBufSize write SetRecvBufSize;
- property Port: Integer read FPort write FPort;
- property TimeOut: DWORD read FTimeOut write SetTimeOut;
- property Active: Boolean read FActive write SetActive;
- property EnableBroadcast: Boolean read FBroadcast write FBroadcast;
- property ProxyInfo: TProxyInfo read FProxyInfo write FProxyInfo;
- property OnDataRead: TUdpReadEvent read FOnDataRead write FOnDataRead;
- property OnSocketError: TUdpErrorEvent read FOnSocketError write FOnSocketError;
- property OnTimeOut: TThreadMethod read FOnTimeOut write FOnTimeOut;
- end;
- ThxUdpRecvThread = class(TThread)
- private
- FSocket: ThxUdpSocket;
- FEvent: WSAEvent;
- FOnDataRecv: TThreadMethod;
- procedure InitEvent;
- procedure FreeEvent;
- protected
- procedure Execute; override;
- public
- constructor Create(CreateSuspended: Boolean; AUdpSocket: ThxUdpSocket);
- destructor Destroy; override;
- property OnDataRecv: TThreadMethod read FOnDataRecv write FOnDataRecv;
- procedure Stop;
- end;
- implementation
- { ThxUDPSocket }
- function ThxUDPSocket.BroadcastBuf(var Buf; Size, Port: Integer): Boolean;
- var
- ret, ErrorCode: Integer;
- saRemote: TSockAddrIn;
- begin
- Result:= False;
- saRemote.sin_family:= AF_INET;
- saRemote.sin_port:= htons(Port);
- saRemote.sin_addr.S_addr:= htonl(INADDR_BROADCAST);
- if FProxyInfo.Enabled then
- ret:= SendByProxy(FSocket, Buf, Size, inet_ntoa(saRemote.sin_addr), ntohs(saRemote.sin_port))
- else
- ret:= sendto(FSocket, Buf, Size, 0, saRemote, SizeOf(saRemote));
- if ret = SOCKET_ERROR then
- begin
- ErrorCode:= GetLastError;
- if ErrorCode <> WSAEWOULDBLOCK then
- begin
- if Assigned(FOnSocketError) then
- FOnSocketError(Self, utSend, ErrorCode);
- if ErrorCode <> 0 then
- raise TUDPException.CreateFmt('广播数据时出错。错误码是%d', [ErrorCode]);
- end;
- end
- else
- Result:= True;
- end;
- function ThxUDPSocket.BroadcastText(Text: string; Port: Integer): Boolean;
- begin
- Result:= BroadcastBuf(Text[1], Length(Text), Port);
- end;
- constructor ThxUDPSocket.Create;
- var
- WSAData: TWSAData;
- begin
- FActive:= False;
- FPort:= 0;
- FillChar(FPeerInfo, SizeOf(TPeerInfo), 0);
- FSendBufSize:= DEFAULT_SENDBUF_SIZE;
- FRecvBufSize:= DEFAULT_RECVBUF_SIZE;
- FSocket:= INVALID_SOCKET;
- FUdpRecvThread:= nil;
- FTimeOut:= $FFFFFFFF;
- FBroadcast:= False;
- FTcpSocket:= INVALID_SOCKET;
- if WSAStartup(MakeWord(2, 2), WSAData) <> 0 then
- raise TUDPException.Create('本程序需要WinSock2,该机器上的Socket版本太低!');
- end;
- destructor ThxUDPSocket.Destroy;
- begin
- if FActive then
- DoActive(False);
- if FTcpSocket <> INVALID_SOCKET then
- closesocket(FTcpSocket);
- if WSACleanup <> 0 then
- MessageBox(0, 'Socket清理失败!', '错误', MB_OK + MB_ICONERROR);
- inherited Destroy;
- end;
- procedure ThxUDPSocket.DoActive(Active: boolean);
- var
- ErrorCode: Integer;
- begin
- if Active = True then
- begin
- if InitSocket then
- begin
- FActive:= True;
- try
- SetSendBufSize(FSendBufSize);
- SetRecvBufSize(FRecvBufSize);
- FUdpRecvThread:= ThxUDPRecvThread.Create(True, Self);
- FUdpRecvThread.FOnDataRecv:= DataReceive;
- FUdpRecvThread.Resume;
- except
- DoActive(False);
- raise TUDPException.Create('建立监听线程发生错误!');
- end;
- end
- else
- begin
- ErrorCode:= GetLastError;
- if Assigned(FOnSocketError) then
- FOnSocketError(Self, utInit, ErrorCode);
- if ErrorCode <> 0 then
- raise TUDPException.CreateFmt('初始化套接字发生错误,错误码是%d', [ErrorCode]);
- end;
- end
- else
- begin
- if Assigned(FUDPRecvThread) then
- begin
- FUdpRecvThread.Stop;
- FreeAndNil(FUDPRecvThread);
- end;
- FreeSocket;
- FActive:= False;
- end;
- end;
- procedure ThxUDPSocket.FreeSocket;
- begin
- if FSocket <> INVALID_SOCKET then
- begin
- closesocket(FSocket);
- FSocket:= INVALID_SOCKET;
- end;
- if FTcpSocket <> INVALID_SOCKET then
- begin
- closesocket(FTcpSocket);
- FTcpSocket:= INVALID_SOCKET;
- end;
- end;
- function ThxUDPSocket.GetRecvBufSize: Integer;
- begin
- Result:= FRecvBufSize;
- end;
- function ThxUDPSocket.GetSendBufSize: Integer;
- begin
- Result:= FSendBufSize;
- end;
- function ThxUDPSocket.InitSocket: Boolean;
- var
- saLocal: TSockAddrIn;
- bReLinten: Boolean;
- length:Integer;
- begin
- Result:= False;
- FSocket:= WSASocket(AF_INET, SOCK_DGRAM, 0, nil, 0, WSA_FLAG_OVERLAPPED);
- if FSocket = INVALID_SOCKET then
- Exit;
- bReLinten:= True;
- if setsockopt(FSocket, SOL_SOCKET, SO_REUSEADDR, @bReLinten, SizeOf(bReLinten)) <> 0 then
- Exit;
- if setsockopt(FSocket, SOL_SOCKET, SO_BROADCAST, @FBroadcast, SizeOf(Integer)) <> 0 then
- Exit;
- saLocal.sin_family:= AF_INET;
- saLocal.sin_port:= htons(FPort);
- saLocal.sin_addr.S_addr:= INADDR_ANY;
- if bind(FSocket, @saLocal, SizeOf(saLocal)) = SOCKET_ERROR then
- begin
- FreeSocket;
- Exit;
- end;
- length:=SizeOf(saLocal);
- getsockname(FSocket, saLocal, length);
- Port:=ntohs(saLocal.sin_port);
- if FProxyInfo.Enabled then
- begin
- if not ConnectToProxy then
- Exit;
- end;
- Result:= True;
- end;
- procedure ThxUDPSocket.DataReceive;
- begin
- if Assigned(FOnDataRead) then
- FOnDataRead(Self, FPeerInfo);
- end;
- function ThxUDPSocket.RecvBuf(var Buf; Size: Integer; IP: string; Port: Integer): Boolean;
- var
- saRemote: TSockAddrIn;
- ret, fromlen: Integer;
- ErrorCode: Integer;
- begin
- Result:= False;
- saRemote.sin_family:= AF_INET;
- saRemote.sin_addr.S_addr:= inet_addr(PChar(IP));
- saRemote.sin_port:= htons(Port);
- fromlen:= SizeOf(saRemote);
- if FProxyInfo.Enabled then
- ret:= RecvByProxy(FSocket, Buf, Size, IP, Port)
- else
- ret:= recvfrom(FSocket, Buf, Size, 0, saRemote, fromlen);
- with FPeerInfo do
- begin
- PeerIP:= inet_ntoa(saRemote.sin_addr);
- PeerPort:= ntohs(saRemote.sin_port);
- end;
- if ret = SOCKET_ERROR then
- begin
- ErrorCode:= GetLastError;
- if ErrorCode <> WSAEWOULDBLOCK then
- begin
- if Assigned(FOnSocketError) then
- FOnSocketError(Self, utRecv, ErrorCode);
- if ErrorCode <> 0 then
- raise TUDPException.CreateFmt('接收数据出错。错误码是%d', [ErrorCode]);
- end;
- end
- else
- Result:= True;
- end;
- function ThxUDPSocket.SendBuf(var Buf; Size: Integer; IP: string; Port: Integer): Boolean;
- var
- ret, ErrorCode: Integer;
- saRemote: TSockAddrIn;
- begin
- Result:= False;
- saRemote.sin_family:= AF_INET;
- saRemote.sin_port:= htons(Port);
- saRemote.sin_addr.S_addr:= inet_addr(PChar(IP));
- if saRemote.sin_addr.S_addr = INADDR_NONE then
- raise TUDPException.Create('无效的远程主机地址!');
- if FProxyInfo.Enabled then
- ret:= SendByProxy(FSocket, Buf, Size, IP, Port)
- else
- ret:= sendto(FSocket, Buf, Size, 0, saRemote, SizeOf(saRemote));
- if ret = SOCKET_ERROR then
- begin
- ErrorCode:= GetLastError;
- if ErrorCode <> WSAEWOULDBLOCK then
- begin
- if Assigned(FOnSocketError) then
- FOnSocketError(Self, utSend, ErrorCode);
- if ErrorCode <> 0 then
- raise TUDPException.CreateFmt('发送数据时出错。错误码是%d', [ErrorCode]);
- end;
- end
- else
- Result:= True;
- end;
- function ThxUDPSocket.SendText(Text, IP: string; Port: integer): Boolean;
- begin
- Result := SendBuf(Pointer(Text)^, Length(Text), IP, Port);
- end;
- procedure ThxUDPSocket.SetActive(Value: Boolean);
- begin
- if FActive <> Value then
- DoActive(Value);
- end;
- procedure ThxUDPSocket.SetRecvBufSize(Value: Integer);
- var
- ErrorCode: Integer;
- begin
- if FRecvBufSize <> Value then
- begin
- ErrorCode:= setsockopt(FSocket, SOL_SOCKET, SO_RCVBUF, @Value, sizeof(Value));
- if ErrorCode = SOCKET_ERROR then
- raise TUDPException.CreateFmt('设置接收缓冲区出错。错误码是%d', [GetLastError]);
- FRecvBufSize:= Value;
- end;
- end;
- procedure ThxUDPSocket.SetSendBufSize(Value: Integer);
- var
- ErrorCode: Integer;
- begin
- if FSendBufSize <> Value then
- begin
- ErrorCode:= setsockopt(FSocket, SOL_SOCKET, SO_SNDBUF, @Value, sizeof(Value));
- if ErrorCode = SOCKET_ERROR then
- raise TUDPException.CreateFmt('设置发送缓冲区错误。错误码是%d', [GetLastError]);
- FSendBufSize:= Value;
- end;
- end;
- procedure ThxUDPSocket.SetTimeOut(Value: Longword);
- begin
- if FTimeOut <> Value then
- FTimeOut:= Value;
- end;
- function ThxUDPSocket.ConnectToProxy: Boolean;
- var
- saProxy: TSockAddrIn;
- ret: Integer;
- bRet: Boolean;
- begin
- Result:= False;
- if FTcpSocket = INVALID_SOCKET then
- FTcpSocket:= socket(AF_INET, SOCK_STREAM, 0);
- saProxy.sin_family:= AF_INET;
- saProxy.sin_port:= htons(FProxyInfo.Port);
- saProxy.sin_addr.S_addr:= inet_addr(PChar(FProxyInfo.Address));
- ret:= connect(FTcpSocket, @saProxy, SizeOf(saProxy));
- if ret = SOCKET_ERROR then
- raise Exception.CreateFmt('无法连接到代理服务器,错误码是%d', [WSAGetLastError]);
- if Trim(FProxyInfo.Username) <> '' then
- bRet:= Handclasp(FTcpSocket, atUserPass)
- else
- bRet:= Handclasp(FTcpSocket, atNone);
- if not bRet then
- begin
- closesocket(FTcpSocket);
- raise Exception.CreateFmt('代理服务器身份验证失败!错误码是%d', [WSAGetLastError]);
- end;
- if not MapUdpChannel(FTcpSocket) then
- begin
- closesocket(FTcpSocket);
- raise Exception.CreateFmt('代理服务器不支持UDP!错误码是%d', [WSAGetLastError]);
- end;
- Result:= True;
- end;
- function ThxUDPSocket.Handclasp(Socket: TSocket; AuthenType: TAuthenType): Boolean;
- var
- Buf: array[0..255] of Byte;
- I, Ret: Integer;
- Username, Password: string;
- begin
- Result:= False;
- case AuthenType of
- atNone:
- begin
- Buf[0]:= $05;
- Buf[1]:= $01;
- Buf[2]:= $00;
- Ret:= send(Socket, Buf, 3, 0);
- if Ret = -1 then Exit;
- FillChar(Buf, 256, #0);
- Ret:= recv(Socket, Buf, 256, 0);
- if Ret < 2 then Exit;
- if Buf[1] <> $00 then Exit;
- Result:= True;
- end;
- atUserPass:
- begin
- Buf[0]:= $05; // Socks版本号
- Buf[1]:= $02; // 两种认证方法
- Buf[2]:= $00; // 无需校验
- Buf[3]:= $02; // 需用户名密码校验
- Ret:= send(Socket, Buf, 4, 0);
- if Ret = -1 then Exit;
- FillChar(Buf, 256, #0);
- Ret:= recv(Socket, Buf, 256, 0);
- if Ret < 2 then Exit;
- if Buf[1] <> $02 then Exit;
- Username:= FProxyInfo.Username;
- Password:= FProxyInfo.Password;
- FillChar(Buf, 256, #0);
- Buf[0]:= $01;
- Buf[1]:= Length(Username);
- for I:= 0 to Buf[1] - 1 do
- Buf[2 + I]:= Ord(Username[I + 1]);
- Buf[2 + Length(Username)]:= Length(Password);
- for I:= 0 to Buf[2 + Length(Username)] - 1 do
- Buf[3 + Length(Username) + I]:= Ord(Password[I + 1]);
- Ret:= send(Socket, Buf, Length(Username) + Length(Password) + 3, 0);
- if Ret = -1 then Exit;
- Ret:= recv(Socket, Buf, 256, 0);
- if Ret = -1 then Exit;
- if Buf[1] <> $00 then Exit;
- Result:= True;
- end;
- end;
- end;
- function ThxUDPSocket.MapUdpChannel(Socket: TSocket): Boolean;
- var
- saLocal: TSockAddrIn;
- NameLen: Integer;
- ProxyAddr: TInAddr;
- ProxyPort: Word;
- Buf: array[0..255] of Byte;
- begin
- Result:= False;
- NameLen:= SizeOf(saLocal);
- getsockname(FSocket, saLocal, NameLen);
- Buf[0]:= $05;
- Buf[1]:= $03;
- Buf[2]:= $00;
- Buf[3]:= $01;
- CopyMemory(@Buf[4], @saLocal.sin_addr, 4);
- CopyMemory(@Buf[8], @saLocal.sin_port, 2);
- send(Socket, Buf, 10, 0);
- FillChar(Buf, 256, #0);
- recv(Socket, Buf, 256, 0);
- if (Buf[0] <> $05) and (Buf[1] <> $00) then
- Exit;
- CopyMemory(@ProxyAddr, @Buf[4], 4);
- CopyMemory(@ProxyPort, @Buf[8], 2);
- FUdpProxyAddr.sin_family:= AF_INET;
- FUdpProxyAddr.sin_port:= ProxyPort;
- FUdpProxyAddr.sin_addr:= ProxyAddr;
- Result:= True;
- end;
- function ThxUDPSocket.SendByProxy(Socket: TSocket; var buf; len: Integer;
- RemoteIP: string; RemotePort: Integer): Integer;
- var
- TempBuf: array[0..1023] of Byte;
- saRemote: TSockAddrIn;
- begin
- saRemote.sin_family:= AF_INET;
- saRemote.sin_port:= htons(RemotePort);
- saRemote.sin_addr.S_addr:= inet_addr(PChar(RemoteIP));
- FillChar(TempBuf, 1023, $0);
- TempBuf[0]:= $00;
- TempBuf[1]:= $00;
- TempBuf[2]:= $00;
- TempBuf[3]:= $01;
- CopyMemory(@TempBuf[4], @saRemote.sin_addr, 4);
- CopyMemory(@TempBuf[8], @saRemote.sin_port, 2);
- CopyMemory(@TempBuf[10], @buf, len);
- Result:= sendto(Socket, TempBuf, len + 10, 0, FUdpProxyAddr, SizeOf(FUdpProxyAddr));
- if Result = SOCKET_ERROR then
- raise Exception.CreateFmt('发送数据错误!错误号是%d', [WSAGetLastError]);
- end;
- function ThxUDPSocket.RecvByProxy(Socket: TSocket; var buf; len: Integer;
- RemoteIP: string; RemotePort: Integer): Integer;
- var
- TempBuf: array[0..1023] of Byte;
- saRemote: TSockAddrIn;
- fromlen: Integer;
- begin
- FillChar(TempBuf, 1024, #0);
- saRemote.sin_family:= AF_INET;
- saRemote.sin_port:= htons(RemotePort);
- saRemote.sin_addr.S_addr:= inet_addr(PChar(RemoteIP));
- fromlen:= SizeOf(saRemote);
- Result:= recvfrom(Socket, TempBuf, len, 0, saRemote, fromlen);
- if Result = SOCKET_ERROR then
- raise Exception.CreateFmt('接收数据错误!错误号是%d', [WSAGetLastError]);
- Assert(TempBuf[0] = $00);
- Assert(TempBuf[1] = $00);
- Assert(TempBuf[2] = $00);
- Assert(TempBuf[3] = $01);
- CopyMemory(@saRemote.sin_addr, @TempBuf[4], 4);
- CopyMemory(@saRemote.sin_port, @TempBuf[8], 2);
- CopyMemory(@buf, @TempBuf[10], len);
- end;
- { ThxUdpRecvThread }
- constructor ThxUdpRecvThread.Create(CreateSuspended: Boolean; AUdpSocket: ThxUdpSocket);
- begin
- inherited Create(CreateSuspended);
- FSocket:= AUDPSocket;
- FEvent:= WSA_INVALID_EVENT;
- InitEvent;
- end;
- destructor ThxUdpRecvThread.Destroy;
- begin
- if not Terminated then
- Stop;
- FreeEvent;
- inherited Destroy;
- end;
- procedure ThxUdpRecvThread.Execute;
- var
- ErrorCode: Integer;
- begin
- while not Terminated do
- begin
- ErrorCode:= WSAWaitForMultipleEvents(
- 1,
- @FEvent,
- False,
- FSocket.FTimeOut,
- False
- );
- if Terminated then
- Break;
- if ErrorCode = WAIT_IO_COMPLETION then
- begin
- Break;
- end
- else
- begin
- WSAResetEvent(FEvent);
- if ErrorCode = WSA_WAIT_TIMEOUT then
- begin
- if Assigned(FSocket.FOnTimeOut) then
- Synchronize(FSocket.FOnTimeOut);
- end
- else if Assigned(FOnDataRecv) then
- Synchronize(FOnDataRecv);
- end;
- end;
- end;
- procedure ThxUdpRecvThread.FreeEvent;
- begin
- if FEvent <> WSA_INVALID_EVENT then
- WSACloseEvent(FEvent);
- end;
- procedure ThxUdpRecvThread.InitEvent;
- var
- ErrorCode: Integer;
- begin
- FEvent:= WSACreateEvent;
- if FEvent = WSA_INVALID_EVENT then
- raise TUDPException.CreateFmt('创建套接字事件句柄出错。错误码是%d', [WSAGetLastError]);
- ErrorCode:= WSAEventSelect(FSocket.FSocket, FEvent, FD_READ);
- if ErrorCode = SOCKET_ERROR then
- raise TUDPException.CreateFmt('设置套接字事件句柄出错。错误码是%d', [WSAGetLastError]);
- end;
- procedure ThxUdpRecvThread.Stop;
- begin
- Terminate;
- SetEvent(FEvent);
- WaitFor;
- end;
- end.