基于Delphi API写的UDP通讯类

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