文档章节

基于Delphi API写的UDP通讯类

依宸2016
 依宸2016
发布于 2016/11/11 12:19
字数 611
阅读 134
收藏 0

转载地址: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.

本文转载自:http://blog.csdn.net/liwb1987/article/details/38319917

依宸2016
粉丝 1
博文 94
码字总数 0
作品 0
济南
高级程序员
私信 提问
一些常用软件的网络端口协议分类介绍

最近有朋友请教我有关实现校园局域网视频功能软件的编写问题,涉及到端口有关的知识,自己查了一些资料,发现这篇文章总结得比较不错,常用软件涵盖得比较丰富,很实用,需要用到的时候可以查...

长平狐
2012/11/12
884
0
jacob调用vb的dll报错,求指教

错误信息; Exception in thread "main" com.jacob.com.ComFailException: Can't find moniker at com.jacob.com.Dispatch.createInstanceNative(Native Method) at com.jacob.com.Dispatch.......

一号男嘉宾
2012/03/31
1K
4
Java远程通讯可选技术及原理

Java远程通讯可选技术及原理 在分布式服务框架中,一个最基础的问题就是远程服务是怎么通讯的,在Java领域中有很多可实现远程通讯的技术,例如:RMI、MINA、ESB、 Burlap、Hessian、SOAP、E...

青夜之衫
2017/12/05
0
0
WebSocket 和 Socket的区别与联系

首先,Socket 其实并不是一个协议。它工作在 OSI 模型会话层(第5层),是为了方便大家直接使用更底层协议(一般是 TCP 或 UDP )而存在的一个抽象层。Socket是对TCP/IP协议的封装,Socket本...

bengozhong
07/03
14
0
游戏通讯协议的选择TCP?UDP?HTTP?WebSocket?

(一)游戏通讯协议的选择TCP?UDP?HTTP?WebSocket? 网络游戏 游戏技术那些事儿(猴哥) · 2016-07-26 10:01 一、协议特性 游戏设计之初需要决定选择哪种协议来通讯,那么我整理了一张图,关于...

pingglala
2016/11/21
0
0

没有更多内容

加载失败,请刷新页面

加载更多

【2019个推开发者节】航母级APP都在用的SDK现在全部免费,35岁老程序员表示第一次见!

1024程序员节来了 双11近了 各路满减、折扣、领券、秒杀、集赞 营销玩法猛于虎,一看优惠两毛五 日常拼命赶“需求” 修“Bug”的开发者们 想找个好用又不贵的工具太难了 亲爱的开发者们,不要...

个推
31分钟前
9
0
Ceph对可用存储空间的校验与控制

Ceph一共使用了四个配置对可用存储空间进行校验并实施控制,如下: mon_osd_full_ratio:集群中的任一OSD空间使用率大于等于此数值时,集群将被标记为Full,此时集群将停止接受来自客户端的写...

浪里个浪浪
33分钟前
11
0
工厂方法模式

1.定义:创建一个接口,协助创建其它对象 2.优缺点 优: a.用户只需要知道这个工厂是创建哪种对象的,不需要知道创建的过程 b.满足开闭原则(开闭原则:对扩展开放,对修改关闭,即增加类可以...

wen123
34分钟前
6
0
Bootstrap Table -detailView和detailFilter的使用

查看表格 detailFilter 属性:data-detail-filter Type:Function Default:function(index,row){ return true} detailView 属性:data-detail-view Type:Boolean Default:false <table id="ta......

tianyawhl
39分钟前
4
0
场效应管的注意事项

  (1)为了安全使用场效应管,在线路的设计中不能超过管的耗散功率,最大漏源电压、最大栅源电压和最大电流等参数的极限值。   (2)各类型场效应管在使用时,都要严格按要求的偏置接入...

仙溪
42分钟前
6
0

没有更多内容

加载失败,请刷新页面

加载更多

返回顶部
顶部