unit UDPNet;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Winsock;
// 为了提高效率，本单元所有的地址都使用winsock内部格式，和习惯IP之间用AddrToIP和IPToAdr转换！
const
UDPACKETSIZE = 512; // 最大UDP包大小
UDPXHEADSIZE = 8; // 数据包头大小
UDPXDATASIZE = UDPACKETSIZE - UDPXHEADSIZE ; // 最大数据包大小
UDPXDATAFLAG = AC5; // 转发数据包头标志
WM_TERMINATE = WM_USER + 100; // 结束线程
WM_SENDDATA = WM_USER + 101; // 发送数据
type
TSyncSignal = class(TObject) // 线程安全信号
private
FSignal: Boolean;
FCritical: _RTL_CRITICAL_SECTION;
function GetSignal: Boolean;
public
constructor Create(IniState: Boolean);
destructor Destroy; override;
procedure Reset;
property IsSafe: Boolean read GetSignal;
end;
ESocketError = class(Exception);
TSyncUDPSocket = class(TObject) // 封装API
protected
FHandle: TSocket;
FLastError: Integer;
function GetBroadcast: Boolean;
function GetReuseAddr: Boolean;
function GetRecvBufSize: Integer;
function GetSendBufSize: Integer;
procedure SetBroadcast(Value: Boolean);
procedure SetReuseAddr(Value: Boolean);
procedure SetRecvBufSize(Value: Integer);
procedure SetSendBufSize(Value: Integer);
public
constructor Create;
destructor Destroy; override;
function RecvBuffer(var Buffer; Len: Integer): Integer;
function RecvFrom(var Buffer; Len: Integer; var Addr: Integer; var Port: Word): Integer;
function ByteCanRead: Integer;
function SendBuffer(var Buffer; Len: Integer): Integer;
function SendTo(Addr: Integer; Port: Word; var Buffer; Len: Integer): Integer;
function WaitForData(TimeOut: Integer): Boolean;
procedure Bind(Addr: Integer; Port: Word);
procedure Connect(Addr: Integer; Port: Word);
procedure CreateSocket;
procedure GetLocalHost(var IP: string; var Port: Word);
procedure GetRemoteHost(var IP: string; var Port: Word);
property Broadcast: Boolean read GetBroadcast write SetBroadcast;
property Handle: TSocket read FHandle write FHandle;
property LastError: Integer read FLastError;
property ReuseAddr: Boolean read GetReuseAddr write SetReuseAddr;
property SizeRecvBuffer: Integer read GetRecvBufSize write SetRecvBufSize;
property SizeSendBuffer: Integer read GetSendBufSize write SetSendBufSize;
end;
TUDPXDataBuffer = packed record // 转发数据包
Flag: Word;
Port: Word;
Addr: Integer;
Data: array [0..UDPXDATASIZE-1] of Byte;
end;
TUDPXServerThread = class(TThread) // 数据转发服务器
protected
FUDPSock: TSyncUDPSocket;
FUDPort: Word;
public
constructor Create(Port: Word);
destructor Destroy; override;
procedure Execute; override;
end;
TUDPQueData = packed record // 队列数据
Addr: Integer;
Port: Word;
Len: Word;
Data: array [0..UDPACKETSIZE-1] of Byte;
end;
TUDPQueBuffer = array [0..1] of TUDPQueData;
PUDPQueBuffer = ^TUDPQueBuffer;
TUDPDataQue = record // 队列
Header, Tail, BufSize: Integer;
IsFull: Boolean;
Queue: PUDPQueBuffer;
end;
TUDPReceiver = class;
TUDPDataNotify = procedure(Sender: TUDPReceiver; const Data: TUDPQueData) of object;
TUDPReceiver = class(TThread) // 接收器
protected
FUDPSock: TSyncUDPSocket;
FOnData: TUDPDataNotify;
public
constructor Create(Sock: TSyncUDPSocket);
procedure Execute; override;
property OnData: TUDPDataNotify read FOnData write FOnData;
property UDPSock: TSyncUDPSocket read FUDPSock write FUDPSock;
end;
TUDPQueSender = class(TThread) // 队列发送器，通过消息WM_TERMINATE结束
protected
FUDPSock: TSyncUDPSocket;
FBuffer: TUDPDataQue;
FSync: TSyncSignal;
public
constructor Create(Sock: TSyncUDPSocket; BufSize: Integer);
destructor Destroy; override;
function AddData(Addr: Integer; Port: Word; const Header; HLen: Word;
const Data; DLen: Word): Boolean; // 要发送数据调用本函数
procedure Execute; override;
property Buffer: TUDPDataQue read FBuffer;
property UDPSock: TSyncUDPSocket read FUDPSock write FUDPSock;
end;
function AddrToIP(Addr: Integer): string;
function IPToAddr(const IP: string): Integer;
implementation
constructor TSyncSignal.Create(IniState: Boolean);
begin
inherited Create;
InitializeCriticalSection(FCritical);
FSignal := IniState;
end;
destructor TSyncSignal.Destroy;
begin
DeleteCriticalSection(FCritical);
inherited Destroy;
end;
function TSyncSignal.GetSignal: Boolean;
begin
EnterCriticalSection(FCritical);
Result := FSignal;
FSignal := False;
LeaveCriticalSection(FCritical);
end;
procedure TSyncSignal.Reset;
begin
FSignal := True;
end;
constructor TSyncUDPSocket.Create;
begin
inherited Create;
FLastError := 0;
FHandle := INVALID_SOCKET;
end;
destructor TSyncUDPSocket.Destroy;
begin
if FHandle <> INVALID_SOCKET then CloseSocket(FHandle);
inherited Destroy;
end;
function TSyncUDPSocket.GetBroadcast: Boolean;
var m, n: Integer;
begin
FLastError := 0;
n := Sizeof(Integer);
if GetSockOpt(FHandle, SOL_SOCKET, SO_BROADCAST, @m, n) <> 0 then
begin
FLastError := WSAGetLastError;
Result := False;
end
else Result := m <> 0;
end;
function TSyncUDPSocket.GetReuseAddr: Boolean;
var m, n: Integer;
begin
FLastError := 0;
n := Sizeof(Integer);
if GetSockOpt(FHandle, SOL_SOCKET, SO_REUSEADDR, @m, n) <> 0 then
begin
FLastError := WSAGetLastError;
Result := False;
end
else Result := m <> 0;
end;
function TSyncUDPSocket.GetRecvBufSize: Integer;
var n: Integer;
begin
n := SizeOf(Result);
FLastError := 0;
if GetSockOpt(FHandle, SOL_SOCKET, SO_RCVBUF, @Result, n) <> 0 then
begin
FLastError := WSAGetLastError;
Result := -1;
end;
end;
function TSyncUDPSocket.GetSendBufSize: Integer;
var n: Integer;
begin
n := SizeOf(Result);
FLastError := 0;
if GetSockOpt(FHandle, SOL_SOCKET, SO_SNDBUF, @Result, n) <> 0 then
begin
FLastError := WSAGetLastError;
Result := -1;
end;
end;
procedure TSyncUDPSocket.SetBroadcast(Value: Boolean);
var n: Integer;
begin
FLastError := 0;
if Value then n := -1 else n := 0;
if SetSockOpt(FHandle, SOL_SOCKET, SO_BROADCAST, @n, SizeOf(Integer)) <> 0 then
FLastError := WSAGetLastError;
end;
procedure TSyncUDPSocket.SetReuseAddr(Value: Boolean);
var n: Integer;
begin
FLastError := 0;
if Value then n := -1 else n := 0;
if SetSockOpt(FHandle, SOL_SOCKET, SO_REUSEADDR, @n, SizeOf(Integer)) <> 0 then
FLastError := WSAGetLastError;
end;
procedure TSyncUDPSocket.SetRecvBufSize(Value: Integer);
begin
FLastError := 0;
if SetSockOpt(FHandle, SOL_SOCKET, SO_RCVBUF, @Value, SizeOf(Integer)) <> 0 then
FLastError := WSAGetLastError;
end;
procedure TSyncUDPSocket.SetSendBufSize(Value: Integer);
begin
FLastError := 0;
if SetSockOpt(FHandle, SOL_SOCKET, SO_SNDBUF, @Value, SizeOf(Integer)) <> 0 then
FLastError := WSAGetLastError;
end;
function TSyncUDPSocket.ByteCanRead: Integer;
var n: Integer;
begin
FLastError := 0;
if IoctlSocket(FHandle, FIONREAD, n) = 0 then Result := n
else begin
FLastError := WSAGetLastError;
Result := 0;
end;
end;
function TSyncUDPSocket.WaitForData(TimeOut: Integer): Boolean;
var tv: TTimeVal;
pt: PTimeVal;
n: Integer;
fs: TFDSet;
begin
if TimeOut < 0 then pt := nil else
begin
tv.tv_sec := TimeOut div 1000;
tv.tv_usec := (TimeOut mod 1000) * 1000;
pt := @tv;
end;
FD_ZERO(fs);
FD_SET(FHandle, fs);
n := select(0, @fs, nil, nil, pt);
if n = SOCKET_ERROR then
begin
FLastError := WSAGetLastError;
n := 0;
end
else FLastError := 0;
Result := n > 0;
end;
function TSyncUDPSocket.RecvBuffer(var Buffer; Len: Integer): Integer;
begin
FLastError := 0;
Result := WinSock.recv(FHandle, Buffer, Len, 0);
if Result = SOCKET_ERROR then FLastError := WSAGetLastError;
end;
function TSyncUDPSocket.RecvFrom(var Buffer; Len: Integer; var Addr: Integer; var Port: Word): Integer;
var a: TSockAddr;
n: Integer;
begin
FLastError := 0;
Result := WinSock.RecvFrom(FHandle, Buffer, Len, 0, a, n);
Port := ntohs(a.sin_port);
Addr := a.sin_addr.s_addr;
if Result = SOCKET_ERROR then FLastError := WSAGetLastError;
end;
function TSyncUDPSocket.SendBuffer(var Buffer; Len: Integer): Integer;
begin
FLastError := 0;
Result := WinSock.send(FHandle, Buffer, Len, 0);
if Result = SOCKET_ERROR then FLastError := WSAGetLastError;
end;
function TSyncUDPSocket.SendTo(Addr: Integer; Port: Word; var Buffer; Len: Integer): Integer;
var a: TSockAddr;
begin
FLastError := 0;
a.sin_family := AF_INET;
a.sin_port := htons(Port);
a.sin_addr.s_addr := Addr;
Result := WinSock.SendTo(FHandle, Buffer, Len, 0, a, Sizeof(TSockAddr));
if Result = SOCKET_ERROR then FLastError := WSAGetLastError;
end;
procedure TSyncUDPSocket.Bind(Addr: Integer; Port: Word);
var a: TSockAddr;
begin
if FHandle = INVALID_SOCKET then
begin
CreateSocket;
if FLastError <> 0 then Exit;
end;
FLastError := 0;
a.sin_family := AF_INET;
a.sin_port := htons(Port);
a.sin_addr.s_addr := Addr;
if WinSock.Bind(FHandle, a, Sizeof(TSockAddr)) = SOCKET_ERROR then
FLastError := WSAGetLastError;
end;
procedure TSyncUDPSocket.Connect(Addr: Integer; Port: Word);
var a: TSockAddr;
begin
if FHandle = INVALID_SOCKET then
begin
CreateSocket;
if FLastError <> 0 then Exit;
end;
FLastError := 0;
a.sin_family := AF_INET;
a.sin_port := htons(Port);
a.sin_addr.s_addr := Addr;
if WinSock.Connect(FHandle, a, Sizeof(TSockAddr)) = SOCKET_ERROR then
FLastError := WSAGetLastError;
end;
procedure TSyncUDPSocket.CreateSocket;
begin
FLastError := 0;
FHandle := Socket(AF_INET, SOCK_DGRAM, IPPROTO_UDP);
if FHandle = INVALID_SOCKET then FLastError := WSAGetLastError;
end;
procedure TSyncUDPSocket.GetLocalHost(var IP: string; var Port: Word);
var addr: TSockAddr;
len: Integer;
begin
FillChar(addr, Sizeof(TSockAddr), 0);
len := Sizeof(TSockAddr);
GetSockName(FHandle, addr, len);
IP := inet_ntoa(addr.sin_addr);
Port := ntohs(addr.sin_port);
end;
procedure TSyncUDPSocket.GetRemoteHost(var IP: string; var Port: Word);
var addr: TSockAddr;
len: Integer;
begin
FillChar(addr, Sizeof(TSockAddr), 0);
len := Sizeof(TSockAddr);
GetPeerName(FHandle, addr, len);
IP := inet_ntoa(addr.sin_addr);
Port := ntohs(addr.sin_port);
end;
constructor TUDPXServerThread.Create(Port: Word);
begin
inherited Create(True);
FUDPort := Port;
end;
destructor TUDPXServerThread.Destroy;
begin
FUDPSock.Free;
inherited Destroy;
end;
procedure TUDPXServerThread.Execute;
var n, a: Integer;
p: Word;
buf: TUDPXDataBuffer;
begin
FUDPSock := TSyncUDPSocket.Create;
FUDPSock.Bind(0, FUDPort);
while not Terminated do
begin
if FUDPSock.WaitForData(100) then
begin
n := FUDPSock.ByteCanRead;
if n > UDPACKETSIZE then n := UDPACKETSIZE;
FUDPSock.RecvFrom(buf, n, a, p);
if (buf.Flag = UDPXDATAFLAG) and (n > UDPXHEADSIZE) then
FUDPSock.SendTo(buf.Addr, buf.Port, buf.Data, n - UDPXHEADSIZE);
end;
end;
end;
constructor TUDPReceiver.Create(Sock: TSyncUDPSocket);
begin
inherited Create(True);
FUDPSock := Sock;
FOnData := nil;
end;
procedure TUDPReceiver.Execute;
var buf: TUDPQueData;
begin
while not Terminated do
begin
if FUDPSock.WaitForData(100) then with buf do
begin
Len := FUDPSock.ByteCanRead;
if Len > UDPACKETSIZE then Len := UDPACKETSIZE;
FUDPSock.RecvFrom(Data, Len, Addr, Port);
if (FUDPSock.FLastError = 0) and Assigned(FOnData) then FOnData(Self, buf);
end;
end;
end;
constructor TUDPQueSender.Create(Sock: TSyncUDPSocket; BufSize: Integer);
begin
inherited Create(True);
FUDPSock := Sock;
FBuffer.Header := 0;
FBuffer.Tail := 0;
FBuffer.IsFull := False;
if BufSize < 4 then BufSize := 4;
FBuffer.BufSize := BufSize;
GetMem(FBuffer.Queue, FBuffer.BufSize * Sizeof(TUDPQueData));
FSync := TSyncSignal.Create(True);
FreeOnTerminate := True;
end;
destructor TUDPQueSender.Destroy;
begin
FreeMem(FBuffer.Queue, FBuffer.BufSize * Sizeof(TUDPQueData));
FSync.Free;
inherited Destroy;
end;
function TUDPQueSender.AddData(Addr: Integer; Port: Word; const Header; HLen: Word;
const Data; DLen: Word): Boolean;
var i, n: Integer;
begin
while not FSync.IsSafe do Sleep(0);
i := FBuffer.Tail;
Result := not ((i = FBuffer.Header) and FBuffer.IsFull);
if Result and ((HLen > 0) or (DLen > 0)) then
begin
if HLen > UDPACKETSIZE then HLen := UDPACKETSIZE;
n := HLen + DLen;
if n > UDPACKETSIZE then DLen := UDPACKETSIZE - HLen;
FBuffer.Queue.Addr := Addr;
FBuffer.Queue.Port := Port;
FBuffer.Queue.Len := n;
if HLen > 0 then Move(Header, FBuffer.Queue.Data[0], HLen);
if DLen > 0 then Move(Data, FBuffer.Queue.Data[HLen], DLen);
Inc(i);
if i >= FBuffer.BufSize then i := 0;
FBuffer.Tail := i;
FBuffer.IsFull := i = FBuffer.Header;
end;
FSync.Reset;
PostThreadMessage(ThreadID, WM_SENDDATA, 0, 0);
end;
procedure TUDPQueSender.Execute;
var i: Integer;
ms: MSG;
begin
while not Terminated do
begin
GetMessage(ms, 0, 0, 0);
case ms.message of
WM_SENDDATA: begin
while (FBuffer.Header <> FBuffer.Tail) or FBuffer.IsFull do
begin
i := FBuffer.Header;
with FBuffer.Queue do
begin
if Len > UDPACKETSIZE then Len := UDPACKETSIZE;
FUDPSock.SendTo(Addr, Port, Data, Len);
Inc(i);
if i >= FBuffer.BufSize then i := 0;
while not FSync.IsSafe do Sleep(0);
FBuffer.Header := i;
FBuffer.IsFull := False;
FSync.Reset;
end;
end;
end;
WM_TERMINATE: Terminate;
end;
end;
end;
function AddrToIP(Addr: Integer): string;
var a: in_addr absolute Addr;
begin
Result := inet_ntoa(a);
end;
function IPToAddr(const IP: string): Integer;
begin
Result := inet_addr(PChar(IP));
end;
var
WSAData: TWSAData;
procedure Startup;
begin
if WSAStartup(01, WSAData) <> 0 then raise ESocketError.Create('WSAStartup');
end;
procedure Cleanup;
begin
if WSACleanup <> 0 then raise ESocketError.Create('WSACleanup');
end;
initialization
Startup;
finalization
Cleanup;
end.
|
