unit untUDPSock;
interface
uses Windows, SysUtils, Winsock;
const
MAX_BUFCOUNT = 65535; // 64k
type
TBuf = array[0 .. MAX_BUFCOUNT -1] of char; // 64k缓冲区
TReceiveEvent = procedure(RemoteIP: string; Buf: TBuf; RecvLen: integer) of Object;
TUDPSock = class
FThreadHandle: THandle;
private
FLocalPort: DWORD;
FTargetPort: DWORD;
FTargetIP: string;
FOnReceived: TReceiveEvent;
FActive: boolean;
FSock: TSocket;
procedure InitSocket;
procedure Start;
procedure Stop;
procedure SetLocalPort(const Value: DWORD);
procedure SetTargetIP(const Value: string);
procedure SetTargetPort(const Value: DWORD);
procedure SetOnReceived(const Value: TReceiveEvent);
procedure SetActive(const Value: boolean);
procedure SetSock(const Value: TSocket);
protected
procedure DoReceiveBuf;
public
constructor Create();
destructor Destroy(); override;
procedure SendBuf(Buf: TBuf; BufSize: integer);
procedure SendText(Text: string);
property OnReceived: TReceiveEvent read FOnReceived write SetOnReceived;
property Sock: TSocket read FSock write SetSock;
property Active: boolean read FActive write SetActive;
property TargetIP: string read FTargetIP write SetTargetIP;
property TargetPort: DWORD read FTargetPort write SetTargetPort;
property LocalPort: DWORD read FLocalPort write SetLocalPort;
end;
implementation
//-----------------------------------------
// 名称：WSAStartUp
// 参数：无
// 功能：启动Socket
// 返回值：执行成功返回True，失败返回False
//-----------------------------------------
function StartUp: boolean;
var
WSAData: TWSAData;
begin
if WSAStartUp($0202, WSAData) <> 0 then
result := False
else
result := True;
end;
//----------------------------------------
// 名称：WSACleanUp
// 参数：无
// 功能：关闭Socket
// 返回值：执行成功返回True，失败返回False
//----------------------------------------
function CleanUp: boolean;
begin
if WSACleanUp <> 0 then
result := False
else
result := True;
end;
//---------------------------------------------------------
// 名称：InitSockAddrIn
// 参数：
// IP 如果服务器端使用则置为空('')，
// 如果客户端使用则为服务器的IP地址('127.0.0.1')；
// Port 端口号。
// 功能：根据所给参数生成一个TSockAddrIn类型的结构并返回
// 以共其他函数使用。
// 返回值：TSockAddrIn
//---------------------------------------------------------
function InitSockAddrIn(IP: string; Port: word): TSockAddrIn;
begin
result.sin_family := PF_INET;
if IP <> '' then
result.sin_addr.S_addr := inet_addr(pchar(IP))
else
result.sin_addr.S_addr := INADDR_ANY;
result.sin_port := htons(Port);
end;
{ TUDPSock }
// 工作线程
procedure WorkThread(ThreadParam: TUDPSock);
var
Sock: TSocket;
fdread: TFDSET;
ret: integer;
begin
Sock := ThreadParam.Sock;
while True do
begin
FD_ZERO(fdread);
FD_SET(Sock, fdread);
ret := select(0, @fdread, nil, nil, nil);
if ret = SOCKET_ERROR then
break;
if ret > 0 then
try
ThreadParam.DoReceiveBuf;
except
ThreadParam.Active := False;
closesocket(Sock);
break;
end;
end;
raise Exception.Create('接收数据时出错！'); // 当出现这个异常时，就必须重新启动TUDPSock了
end;
constructor TUDPSock.Create;
begin
StartUp;
InitSocket;
end;
procedure TUDPSock.InitSocket;
begin
Sock := socket(AF_INET, SOCK_DGRAM, IPPROTO_UDP);
if Sock = INVALID_SOCKET then
raise Exception.Create('socket function error!');
end;
procedure TUDPSock.DoReceiveBuf;
var
Buf: TBuf;
RemoteAddr: TSockAddrIn;
RemoteAddrSize: integer;
RecvLen: integer;
RemoteIP: string;
begin
RecvLen := recvfrom(Sock, Buf, MAX_BUFCOUNT, 0, RemoteAddr, RemoteAddrSize);
case RecvLen of
0: raise Exception.Create('对方已经关闭！');
SOCKET_ERROR: raise Exception.Create('发生未知错误：' + IntToStr(WSAGetLastError));
end;
try
RemoteIP := inet_ntoa(RemoteAddr.sin_addr);
except
RemoteIP := '未提供IP地址解析！';
end;
if Assigned(FOnReceived) then
FOnReceived(RemoteIP, Buf, RecvLen);
end;
procedure TUDPSock.SendBuf(Buf: TBuf; BufSize: integer);
var
TargetAddr: TSockAddrIn;
begin
TargetAddr := InitSockAddrIn(TargetIP, TargetPort);
try
Sendto(Sock, Buf, BufSize, 0, TargetAddr, sizeof(TargetAddr));
except
raise Exception.Create('发送失败！');
end;
end;
procedure TUDPSock.SendText(Text: string);
var
Buf: TBuf;
len: integer;
begin
len := length(Text);
if len < MAX_BUFCOUNT then
begin
move(pointer(Text)^, buf, len);
SendBuf(Buf, len);
end else
raise Exception.Create(format('一次发送不能超过%n字节', [MAX_BUFCOUNT]));
end;
procedure TUDPSock.SetActive(const Value: boolean);
begin
FActive := Value;
if FActive then
Start
else
Stop;
end;
procedure TUDPSock.SetLocalPort(const Value: DWORD);
begin
if FActive then
raise Exception.Create('不可更改一个正在接受数据的Socket的端口！')
else
FLocalPort := Value;
end;
procedure TUDPSock.SetOnReceived(const Value: TReceiveEvent);
begin
FOnReceived := Value;
end;
procedure TUDPSock.SetSock(const Value: TSocket);
begin
FSock := Value;
end;
procedure TUDPSock.SetTargetIP(const Value: string);
begin
FTargetIP := Value;
end;
procedure TUDPSock.SetTargetPort(const Value: DWORD);
begin
FTargetPort := Value;
end;
procedure TUDPSock.Start;
var
thrdID: DWORD;
LocalAddr: TSockAddrIn;
begin
LocalAddr := InitSockAddrIn('', LocalPort);
if bind(Sock, LocalAddr, sizeof(LocalAddr)) = SOCKET_ERROR then
begin
// 重新创建套接字
closesocket(Sock);
InitSocket;
// 还出错就是有问题了
if bind(Sock, LocalAddr, sizeof(LocalAddr)) = SOCKET_ERROR then
raise Exception.Create('Socket bind ERROR!');
end;
FThreadHandle := BeginThread(nil, 0, @WorkThread, pointer(self), 0, thrdID); // BeginThread函数不错哦，从TThread类抄袭
end;
procedure TUDPSock.Stop;
begin
TerminateThread(FThreadHandle, 0);
end;
destructor TUDPSock.Destroy;
begin
if Active then
Active := False;
closesocket(Sock);
CleanUp;
end;
end.
Demo 程序
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, untUDPSock, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Memo1: TMemo;
Button2: TButton;
Button3: TButton;
Label1: TLabel;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
Listen: TUDPSock;
aSender: TUDPSock;
public
{ Public declarations }
procedure ReadIt(RemoteIP: string; Buf: TBuf; RecvLen: integer);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Listen := TUDPSock.Create;
Listen.LocalPort := 5000; // 接收数据的端口
Listen.OnReceived := ReadIt;
Listen.Active := True;
aSender := TUDPSock.Create; // 发送者无需设定Active为True
// 在一台计算机上同一个端口只能有一个TUDPSock可以接受数据
aSender.TargetIP := '127.0.0.1'; // 目的IP地址
aSender.TargetPort := 5000; // 目的端口
end;
procedure TForm1.ReadIt(RemoteIP: string; Buf: TBuf; RecvLen: integer);
//var
// fs: TFileStream;
begin
// fs := TFileStream.Create('d:/aa.jpg', fmCreate);
// fs.Write(buf, recvlen);
// fs.Free;
Memo1.Lines.Add(format('[IP]%s->[DATA]%s', [RemoteIP, string(Buf)]));
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
aSender.SendText(Edit1.Text);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Listen.Active := False;
Listen.Active := True;
end;
procedure TForm1.Button3Click(Sender: TObject);
//var
/// fs: TFileStream;
// buf: TBuf;
// s: Cardinal;
begin
// fs := TFileStream.Create('G:/desktop/overload_jpg.jpg', 0); // 文件大小不可以大于64k
// s := fs.Size;
// fs.ReadBuffer(buf, s);
// aSender.SendBuf(buf, s);
// fs.Free;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Listen.Free;
aSender.Free;
end;
end.
