自己封装的一个UDP通讯类

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.
--------------------------测试代码--------------------------------------

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.