组播使用在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 TUdpSocketDem
nUdpRecv(var Buf; Len: Integer; FromIP: string;
FromPort: u_Short);
begin
meoRecvText.Lines.Add(String(Buf));
end;
end.
使用的时候注意防火墙.
);