UDP操作类

udpHelper.pas

unit udpHelper;

interface

uses
  Classes, Windows, SysUtils, 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
    { Private declarations }
    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;
  protected
    procedure Execute; override;
  public
    constructor Create;
    destructor Destroy; override;
    function SendBuf(Host: string; Buf: PAnsiChar; 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

{ 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: PAnsiChar;
  Buffer: array[0..63] of AnsiChar;
  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: PAnsiChar; BufSize: Integer; Broadcast: boolean = false): Integer;
var
  optval: Integer;
begin
  if Broadcast then
  begin
    optval := 1;
    if setsockopt(WSocket, SOL_SOCKET, SO_BROADCAST, PAnsiChar(@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(PAnsiChar(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.

使用：

var
  sText: AnsiString;
begin
  sText := AnsiString(Edit1.Text);
  FUdp.SendPort := 9000;
  FUdp.SendBuf('192.168.x.x', PAnsiChar(sText), Length(sText), True);
end;