您的位置:首页 > 编程语言 > Delphi

基于Delphi API写的UDP通讯类

2020-02-29 20:23 453 查看

转载地址:http://www.codefans.net/articles/159.shtml

基于Delphi API写的UDP通讯类,可以广播和单播,类作者:王彦鹏。这个类是作者2007年的时候写的,代码里基本没什么注释,有需要的朋友自己摸索下,懂Delphi的应该可以看懂。

unit TUdp_Class;
interface
uses
Classes,Windows,WinSock;
type
TRecv= procedure (RIP:string;buf:pchar;Bufsize:integer) of object;
TRecvExpand= procedure (RIP:string;Port:integer;buf:pchar;Bufsize:integer) of object;
TUdp = class(TThread)
private
WSocket:TSocket;
FActive:Boolean;
FPort,FSendPort:integer;
Addr: TSockAddr;
FSockAddrIn : TSockAddrIn;
FOnRecv:TRecv;
FOnRecvExpand:TRecvExpand;
Rtl:TRTLCriticalSection;
procedure SetPort(Value:integer);
procedure SetOnRecv(value:TRecv);
procedure SetOnRecvExpand(value:TRecvExpand);
function GetCurPort:integer;
{ Private declarations }
protected
procedure Execute; override;
public
constructor Create;
destructor Destroy; override;
function SendBuf(Host:string;Buf:pchar;BufSize:integer;Broadcast:boolean=false):integer;
Function GetLocalIP():string;
published
property Port:integer read FPort write SetPort default 0;
property SendPort:integer read FSendPort write FSendPort default 0;
property OnRecv:TRecv read FOnRecv write SetOnRecv;
property OnRecvExpand:TRecvExpand read FOnRecvExpand write SetOnRecvExpand;
property CurPort:Integer read GetCurPort;
end;
implementation
uses SysUtils;
{ TUdp }
constructor TUdp.Create();
var wsadata: Twsadata;
begin
InitializeCriticalSection(rtl);
if wsastartup($2, wsadata) <> 0 then
begin
Raise Exception.Create(SysErrorMessage(GetLastError));
end
else
WSocket:=socket(AF_INET,SOCK_DGRAM,IPPROTO_UDP);
if WSocket= INVALID_SOCKET then
Raise Exception.Create(SysErrorMessage(GetLastError))
else
inherited create(true);
end;
destructor TUdp.Destroy;
begin
closesocket(WSocket);
wsacleanup();
DeleteCriticalSection(Rtl);
inherited;
end;
procedure TUdp.Execute;
var
buf: pchar;
Len: integer;
FDS:TFDSet;
TimeOut:TimeVal;
begin
buf := AllocMem(10240);
timeout.tv_sec := 0;
timeout.tv_usec := 10;
FSockAddrIn.SIn_Port := htons(FPort);
while not Terminated do
begin
EnterCriticalSection(rtl);
fillchar(Fds,sizeof(Fds),0);
FD_SET(WSocket ,fds);
len:=select(0,@fds,nil,nil,@TimeOut);
if len>0 then
begin
len:=sizeof(FSockAddrIn);
fillchar(buf[0],10240,0);
len := recvfrom(WSocket, buf[0], 10240, 0,FSockAddrIn,len);
if (len<>0) and (len<>-1) then
begin
if Assigned(fonRecv) then
FOnRecv(inet_ntoa(FSockAddrIn.sin_addr) ,buf,len);
if Assigned(fOnRecvExpand) then
FOnRecvExpand(inet_ntoa(FSockAddrIn.sin_addr),htons(FSockAddrIn.sin_port),buf,len);
end;
end;
LeaveCriticalSection(rtl);
sleep(10);
end;
freemem(buf);
closesocket(WSocket);
end;

function TUdp.GetCurPort: integer;
begin
Result:=htonl(FSockAddrIn.SIn_Port);
end;

function TUdp.GetLocalIP(): string;
var
HostEnt: PHostEnt;
Ip: string;
addr: pchar;
Buffer: array [0..63] of char;
GInitData: TWSADATA;
begin
Result := '';
try
WSAStartup(2, GInitData);
GetHostName(Buffer, SizeOf(Buffer));
HostEnt := GetHostByName(buffer);
if HostEnt = nil then Exit;
addr := HostEnt^.h_addr_list^;
ip := Format('%d.%d.%d.%d', [byte(addr [0]),
byte (addr [1]), byte (addr [2]), byte (addr [3])]);
Result :=Ip;
finally
WSACleanup;
end;
end;

function TUdp.SendBuf(Host: string; Buf:pchar; BufSize: integer;Broadcast:boolean=false  ): integer;
var optval:integer;
begin
if Broadcast then
begin
optval:= 1;
if setsockopt(WSocket,SOL_SOCKET,SO_BROADCAST,pchar(@optval),sizeof(optval)) = SOCKET_ERROR then
Raise Exception.Create(SysErrorMessage(GetLastError))
else
begin
FSockAddrIn.SIn_Family := AF_INET;
FSockAddrIn.SIn_Port := htons(FSendPort);
FSockAddrIn.SIn_Addr.S_addr := INADDR_BROADCAST;
result:=sendto(WSocket,buf[0],BufSize,0,FSockAddrIn,sizeof(FSockAddrIn));
end;
end
else
begin
FSockAddrIn.SIn_Family := AF_INET;
FSockAddrIn.SIn_Port := htons(FSendPort);
FSockAddrIn.SIn_Addr.S_addr :=inet_addr(pchar(host));
result:=sendto(WSocket,buf[0],BufSize,0,FSockAddrIn,sizeof(FSockAddrIn));
end;
end;

procedure TUdp.SetOnRecv(value: TRecv);
begin
if @FOnRecv = @value then
exit;
FOnRecv:=value;
Addr.sin_family := AF_INET;
addr.sin_addr.S_addr := INADDR_ANY;
addr.sin_port := htons(FPort);
if Bind(WSocket, addr, sizeof(addr)) <> 0  then
Raise Exception.Create(SysErrorMessage(GetLastError));
Resume;
end;

procedure TUdp.SetOnRecvExpand(value:TRecvExpand);
begin
if @FOnRecvExpand = @value then
exit;
FOnRecvExpand:=value;
Addr.sin_family := AF_INET;
addr.sin_addr.S_addr := INADDR_ANY;
addr.sin_port := htons(FPort);
if Bind(WSocket, addr, sizeof(addr)) <> 0  then
Raise Exception.Create(SysErrorMessage(GetLastError));
Resume;
end;

procedure TUdp.SetPort(Value: integer);
begin
if FPort =Value then
exit;
if FActive then
Suspend;
FPort:=Value;
end;
end.

转载于:https://my.oschina.net/yichenbaby/blog/786139

  • 点赞
  • 收藏
  • 分享
  • 文章举报
chentang1007 发布了0 篇原创文章 · 获赞 0 · 访问量 254 私信 关注
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: