(转帖)组播实现

组播使用在internet上面并不是一个好办法,很多的路由器是不支持 组播的(以前华为的路由器也不支持,现在不知道),就算现在有路由器支持,你也没有办法保证你的包所经过的路由都是支持 组播协议的.
我觉得在WINDOWS下面还是使用TCP(或者UDP的PTOP)的IOCP模型的通用性好一些.至少不用担心你说的问题.
下面的是一段 组播程序:
unit UdpSocket;

interface

uses
 Classes, SysUtils, WinSock, Windows;

const
 DEFAULTBUFFERSIZE = 16384;
 MAXBUFFERSIZE = 63488;
 MULTICAST_TTL = 10;

type
 PIP_mreq = ^TIP_mreq;
 TIP_mreq = record
    imr_multiaddr  : in_addr;
    imr_interface  : in_addr;
 end;

 ESocketError = class(Exception);

 TSockSytle = (MultCastSend, MultCastRecv);

 TUdpRecv = procedure(var Buf; Len: Integer;
   FromIP: string; FromPort: u_Short) of object;

 TUcpRecvThd = class(TThread)
 private
   FSocket     : TSocket;
   FBufSize    : Integer;
   FOnUdpRecv  : TUdpRecv;
 protected
   procedure Execute; override;
 end;

 TUcpSocket = class(TObject)
 private
   class procedure StartSocket();
   class procedure StopSocket();
 private
   FOnUdpRecv  : TUdpRecv;
   FLocalAddr  : String;
   FPort       : u_Short;
   FSocket     : TSocket;
   FAddrTo     : TSockAddr;
   FStyle      : TSockSytle;
   FBufSize    : Integer;
   FRemoteAddr : String;
   FMCReq      : TIP_mreq;
   FUcpRecvThd : TUcpRecvThd;
 private
   procedure SetLocalAddr(Value: String);
   procedure SetPort(Value: u_Short);
   procedure SetSytle(Value: TSockSytle);
   procedure SetBufSize(Value: Integer);
   procedure SetRemoteAddr(Value: String);
 public
   function Send(var Buf; Len: Integer): Boolean;
   procedure Busk();
 published
   property LocalAddr: String read FLocalAddr write SetLocalAddr;
   property Port: u_Short read FPort write SetPort;
   property Style: TSockSytle write SetSytle;
   property BufSize: Integer read FBufSize write SetBufSize;
   property RemoteAddr: String read FRemoteAddr write SetRemoteAddr;
   property OnUdpRecv: TUdpRecv read FOnUdpRecv write FOnUdpRecv;
 public
   constructor Create();
   destructor Destroy; override;
 end;

implementation

{ TUcpSocket }

procedure TUcpSocket.Busk;
var
 pPE   : PProtoEnt;
 Sock  : TSocket;
 SockAddrLocal, SockAddrRemote : TSockAddr;
 nTTL, nReuseAddr : integer;
 MCReq : TIP_mreq;
begin
 pPE := GetProtoByName('UDP');

 Sock := Socket(AF_INET, SOCK_DGRAM, pPE.p_proto);
 if Sock = INVALID_SOCKET then
   raise ESocketError.Create('创建Socket失败！');

 nReuseAddr := 1;
 if SetSockOpt(Sock, SOL_SOCKET, SO_REUSEADDR, @nReuseAddr, SizeOf(integer)) = SOCKET_ERROR then
 begin
   CloseSocket(Sock);
   Exit;
 end;

 FillChar(SockAddrLocal, SizeOf(SockAddrLocal), 0);
 SockAddrLocal.sin_family := AF_INET;
 if FStyle = MultCastSend then
   SockAddrLocal.sin_port := htons(0)
 else
   SockAddrLocal.sin_port := htons(Port);
 SockAddrLocal.sin_addr.S_addr := Inet_Addr(PChar(FLocalAddr));
 if Bind(Sock, SockAddrLocal, SizeOf(SockAddrLocal)) = SOCKET_ERROR then
 begin
   CloseSocket(Sock);
   Exit;
 end;

 if FStyle = MultCastSend then
 begin
   //设置发送缓冲大小
   if SetSockOpt(Sock, SOL_SOCKET, SO_SNDBUF,
     @FBufSize, SizeOf(Integer)) = SOCKET_ERROR then
   begin
     CloseSocket(Sock);
     Exit;
   end;

   //设置发送时的参数
   if SetSockOpt(Sock, IPPROTO_IP, IP_MULTICAST_IF, @(SockAddrLocal.sin_addr),
                 SizeOf(In_Addr)) = SOCKET_ERROR then
   begin
     CloseSocket(Sock);
     Exit;
   end;
   nTTL := MULTICAST_TTL;
   if SetSockOpt(Sock, IPPROTO_IP, IP_MULTICAST_TTL, @nTTL, SizeOf(integer)) = SOCKET_ERROR then
   begin
     CloseSocket(Sock);
     Exit;
   end;

   FillChar(SockAddrRemote, SizeOf(SockAddrRemote), 0);
   SockAddrRemote.sin_family := AF_INET;
   SockAddrRemote.sin_port := htons(Port);

   SockAddrRemote.sin_addr.S_addr := Inet_Addr(PChar(FRemoteAddr));

   FAddrTo := SockAddrRemote;
 end else //接收
 begin
   //设置接收缓冲大小
   if SetSockOpt(Sock, SOL_SOCKET, SO_RCVBUF, @fBufSize, SizeOf(integer)) = SOCKET_ERROR then
   begin
     CloseSocket(Sock);
     Exit;
   end;

   //加入组
   MCReq.imr_multiaddr.S_addr := Inet_Addr(PChar(FRemoteAddr));
   MCReq.imr_interface.S_addr := Inet_Addr(PChar(FLocalAddr));
   if SetSockOpt(Sock, IPPROTO_IP, IP_ADD_MEMBERSHIP, @MCReq,
     SizeOf(TIP_mreq)) = SOCKET_ERROR then
   begin
     CloseSocket(Sock);
     Exit;
   end;

   fMCReq := MCReq;
 end;

 FSocket := Sock;

 if FStyle = MultCastRecv then
 begin
   FUcpRecvThd.FSocket := FSocket;
   FUcpRecvThd.FBufSize := FBufSize;
   FUcpRecvThd.FOnUdpRecv := FOnUdpRecv;
   FUcpRecvThd.Resume;
 end;
end;

constructor TUcpSocket.Create;
begin
 FOnUdpRecv  := nil;
 FLocalAddr  := '127.0.0.1';
 FPort       := 0;
 FStyle      := MultCastRecv;
 FBufSize    := DEFAULTBUFFERSIZE;
 FUcpRecvThd := TUcpRecvThd.Create(true);
end;

destructor TUcpSocket.Destroy;
begin
 CloseSocket(FSocket);
 FUcpRecvThd.Free;
 inherited;
end;

function TUcpSocket.Send(var Buf; Len: Integer): Boolean;
begin
 Result := false;
 if SendTo(FSocket, Buf, Len, MSG_DONTROUTE, FAddrTo,
           SizeOf(FAddrTo)) <> SOCKET_ERROR then
   Result := true;
end;

procedure TUcpSocket.SetLocalAddr(Value: String);
begin
 FLocalAddr := Value;
end;

procedure TUcpSocket.SetBufSize(Value: Integer);
begin
 FBufSize := Value;
end;

procedure TUcpSocket.SetPort(Value: u_Short);
begin
 FPort := Value;
end;

procedure TUcpSocket.SetRemoteAddr(Value: String);
var
 nMCAddr : Cardinal;
begin
 FRemoteAddr := Value;
 nMCAddr := ntohl(inet_addr(PChar(FRemoteAddr)));
 if not ((nMCAddr <= $efffffff) and (nMCAddr >= $e0000100)) then
   raise ESocketError.Create('无效的 组播地址！');
end;

procedure TUcpSocket.SetSytle(Value: TSockSytle);
begin
 FStyle := Value;
end;

class procedure TUcpSocket.StartSocket;
var
 WsData:  TWSAData;
 err: Integer;
begin
 err := WSAStartup(MAKEWORD(2, 2), WsData);
 if err <> 0 then
   raise ESocketError.Create('不能使用SOCKET服务！');

 if ( LOBYTE( WsData.wVersion ) <> 2 ) or
       ( HIBYTE( WsData.wVersion ) <> 2 ) then
   raise ESocketError.Create('没有找到所需要的SOCKET版本！');
end;

class procedure TUcpSocket.StopSocket;
begin
 WSACleanup;
end;

{ TUcpRecvThd }

procedure TUcpRecvThd.Execute;
var
 readFDs : TFDSet;
 nRecved, nAddrLen: integer;
 Buf : array [0..MAXBUFFERSIZE] of Byte;
 SockFrom : TSockAddr;
begin
 Priority := tpHighest;
 while not Terminated do
 begin
   nAddrLen := SizeOf(SockFrom);
   FD_ZERO(readFDs);
   FD_SET(FSocket, readFDs);

   Select(0, @readFDs, nil, nil, nil);

   if FD_ISSET(FSocket, readFDs) then
   begin
     nRecved := RecvFrom(FSocket, buf, FBufSize, 0, SockFrom, nAddrLen);

     if Assigned(FOnUdpRecv) then
       FOnUdpRecv(Buf, nRecved, string(Inet_Ntoa(SockFrom.sin_addr)),
               Cardinal(Ntohs(SockFrom.sin_port)));
   end;
 end;
end;

initialization
 TUcpSocket.StartSocket;
finalization
 TUcpSocket.StopSocket;

end.
调用如下:

unit Demo;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, UdpSocket, WinSock;

const
 MULTCASTADDR: String = '225.0.1.177';
 MULTCASTPORT: Integer = 10000;

type
 TUdpSocketDemo = class(TForm)
   edtSendText: TEdit;
   meoRecvText: TMemo;
   cmdSend: TButton;
   cmdInit: TButton;
   cmdExit: TButton;
   procedure FormClose(Sender: TObject; var Action: TCloseAction);
   procedure cmdExitClick(Sender: TObject);
   procedure cmdSendClick(Sender: TObject);
   procedure cmdInitClick(Sender: TObject);
 private
   { Private declarations }
   FMultCastUdpSend: TUcpSocket;      //Send Socket
   FMultCastUdpRecv: TUcpSocket;      //Recv Socket
 public
   { Public declarations }

   procedure OnUdpRecv(var Buf; Len: Integer;
     FromIP: string; FromPort: u_Short);
 end;

var
 UdpSocketDemo: TUdpSocketDemo;

implementation

{$R *.dfm}

procedure TUdpSocketDemo.cmdInitClick(Sender: TObject);
begin
 FMultCastUdpSend := TUcpSocket.Create;
 FMultCastUdpSend.LocalAddr := '172.18.2.111';
 FMultCastUdpSend.Port := MULTCASTPORT;
 FMultCastUdpSend.Style := MultCastSend;
 FMultCastUdpSend.RemoteAddr := MULTCASTADDR;
 FMultCastUdpSend.Busk;

 FMultCastUdpRecv := TUcpSocket.Create;
 FMultCastUdpRecv.LocalAddr := '172.18.2.111';
 FMultCastUdpRecv.Port := MULTCASTPORT;
 FMultCastUdpRecv.Style := MultCastRecv;
 FMultCastUdpRecv.RemoteAddr := MULTCASTADDR;
 FMultCastUdpRecv.OnUdpRecv := OnUdpRecv;
 FMultCastUdpRecv.Busk;
 
 cmdInit.Enabled := false;
end;

procedure TUdpSocketDemo.cmdSendClick(Sender: TObject);
var
 Buf: array of Char;
 Len: Integer;
begin
 Len := Length(edtSendText.Text);
 SetLength(Buf, Len);
 StrPCopy(@Buf[0], edtSendText.Text);

 FMultCastUdpSend.Send(Buf, Len);
end;

procedure TUdpSocketDemo.cmdExitClick(Sender: TObject);
begin
 Close;
end;

procedure TUdpSocketDemo.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 FMultCastUdpSend.Free;
end;

procedure TUdpSocketDemo.OnUdpRecv(var Buf; Len: Integer; FromIP: string;
 FromPort: u_Short);
begin
 meoRecvText.Lines.Add(String(Buf));
end;

end.