delphi能否实现multi-cast功能?(50分)

multi-cast
前面已有讨论查 “广播”

好象D的现成空间有问题

我有一篇关于用Delphi实现Multicast的文章，英文的，本想抽时间翻译一下骗点
稿费的，要的话发给你。

xeceyes,能不能给我一份?
chaozai@mars.ahu.edu.cn
谢谢

receyes,谢谢!
我的Email: zh51@hotmail.com

receyes的那篇文章我也想要一份，如能发到我的邮箱里，
万分感谢。Email: windiny@263.net

udp? 是不是?

一种方法是分别连接每个客户, 实现广播.
另外一种办法是 RFC 1112. 在 Winsock 2 中相关的函数是:

WSAEnumProtocols()
To determine multicast support
WSASocket()
To specify the multipoint type
WSAJoinLeaf()
To join a multicast group and specify role (sender and/or receiver)
WSAIoctl()
SIO_MULTICAST_SCOPE To set IP time-to-live
WSAIoctl()
SIO_MULTIPOINT_LOOPBACK To disable loopback

这个pas文件里面定义了一个TUDPSock2的类，利用
它你可以得到本机的IP与MAC地址。可以发送与接受
UDP的multicast，broadcast与unicast包。

使用方法:
1.创建:
Sock := TUDPSock2.Create;

2.得到IP地址:
slIP := TStringList.Create;
Sock.LocalIPs(slIP);
然后slIP里面就是字符串形式的本机IP了。
例如199.111.111.111

3.得到Mac地址:
slMac := TStringList.Create;
Sock.LocalMac(slMac);
然后旧可以得到Mac地址了,例如
00-10-5a-3e-76-88

4.发送与接受（以multicast为例)
buf : array [0..8192] of Char;

Sock.Setup(stMulticastSender);
Sock.Add('225.0.0.1', 6000);
//前者为multicast地址，后者为端口号
设置好要发送的buf的值，数据长度设为len
Sock.Send(0, @buf, len);

SockRecv := TUDPSock2.Create;
SockRecv.Setup(stMulticastReceiver);
SockRecv.Add('225.0.0.1', 6000);
SockRecv.OnRecv := OnMyRecv;
SockRecv.StartReceive;

5.销毁:
Sock.Free;
SockRecv.Free;

下面是Source:

unit U_UDPSock;

interface

uses
Classes, SysUtils, WinSock, Windows, NB30;

const
MINBUFFERSIZE = 2048;
DEFAULTBUFFERSIZE = 16384;
MAXBUFFERSIZE = 63488; //62*1024
MULTICAST_TTL = 10;

type
TArraySocket = Array Of TSocket;

PASTAT = ^TASTAT;
TASTAT = record
adapter : TAdapterStatus;
name_buf : TNameBuffer;
end;

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

TAPInAddr = Array [0..10] of PInAddr; // array of pInaddr
PAPInAddr = ^TAPInaddr; // pointer of Array
//Note : Dut to broadcast fragmentation's problem, broadcast message can be at most
//512 bytes long defined by WinSock, not longer than 1472 by Berkeley Socket
//not longer than 1468 under MIPS machine
//So don't send a broadcast message longer than 512 here, no use
TUDPSockType = (stMultiCastSender, stMultiCastReceiver, stUnicastSender, stUnicastReceiver,
stBroadcastSender, stBroadcastReceiver);

TUDPOnRecv = procedure (buffer: Pointer; len: integer; fromIP: string; fromPort: u_Short) of Object;

TUDPRecvThd = class(TThread)
private
fSocks : TArraySocket;
fSockCount : integer;
fBufSize : integer;
fOnRecv : TUDPOnRecv;
protected
procedure Execute ; override;
public
constructor Create(var Socks : TArraySocket; OnRecv : TUDPOnRecv; BufSize : integer);
end;

TUDPSock2 = class(TObject)
private
fbSetupReady : Boolean;
fSockType : TUDPSockType;
fOnRecv : TUDPOnRecv;
fSockCount : integer;
fAddrTo : array of TSockAddr;
fMCReq : array of TIP_mreq;
fSocks : TArraySocket;
fRecvThd : TUDPRecvThd;
fLocalIP : String;
fBufSize : integer;
function LocalIPValid(var LocalIP : string): Boolean;
public
property OnRecv : TUDPOnRecv read fOnRecv write fOnRecv;
constructor Create; ReIntroduce;
destructor Destroy; Override;
procedure LocalIPs(slIPs : TStringList);
procedure LocalMAC(slMac : TStringList);
procedure StartReceive;
function Add(RemoteIP : string; Port : u_Short): integer;
function Setup(udpSockType : TUDPSockType; LocalIP : string = '';
BufferSize : integer = DEFAULTBUFFERSIZE) : Boolean;
function Close : Boolean;
function Send(index : integer; buffer : Pointer; len : integer) : Boolean;
end;


implementation

var
wsData : TWSAData;

procedure TUDPRecvThd.Execute;
var
readFDs : TFDSet;
i, 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);
for i := 0 to fSockCount-1 do
FD_SET(fSocks, readFDs);
//The first param of select is provided just for
//compatibility with Berkeley Sockets, no meaning in WinSock
//Note!!! the select's last param here is nil
//so it can be blocked forever
Select(0, @readFDs, nil, nil, nil);
for i := 0 to fSockCount-1 do
if FD_ISSET(fSocks, readFDs) then
begin
nRecved := RecvFrom(fSocks, buf, fBufSize, 0, SockFrom, nAddrLen);
if Assigned(fOnRecv) then
//Note!!! I didn't call Synchronize here so u can call Terminate and WaitFor
//but I suggest using Suspend and Free STRONGLY!
//For the call of select can be blocked forever
fOnRecv(@buf, nRecved, string(Inet_Ntoa(SockFrom.sin_addr)),
Cardinal(Ntohs(SockFrom.sin_port)));
end;
end;
end;

constructor TUDPRecvThd.Create(var Socks : TArraySocket; OnRecv : TUDPOnRecv; BufSize : integer);
begin
fSocks := Socks;
fOnRecv := OnRecv;
fBufSize := BufSize;
fSockCount := High(Socks) + 1; //must start with 0, Low(Socks) is always 0
FreeOnTerminate := True;
inherited Create(False);
end;

procedure TUDPSock2.LocalIPs(slIPs : TStringList);
var
strLocalHost : string;
pHE : PHostent;
pInAd : PAPInAddr;
saLocal : TSockAddr;
i : integer;
begin
SetLength(strLocalHost, 255);
if GetHostName(PChar(strLocalHost), 254) = SOCKET_ERROR then
Exit;

pHE := GetHostByName(PChar(strLocalHost));
pInAd := PAPInAddr(pHE^.h_addr_list);
saLocal.sin_addr := (pInAd^[0]^);
i := 0;
while True do
begin
slIPs.Add(inet_ntoa(saLocal.sin_addr));
i := i + 1;
if(pInAd^ <> nil) then
saLocal.sin_addr := (pInAd^^) //local host
else
break;
end;
end;

procedure TUDPSock2.LocalMAC(slMac : TStringList);
var
ncb : TNCB;
adapt : TASTAT;
lanaEnum : TLanaEnum;
i, j : integer;
strPart, strMac : string;
begin
FillChar(ncb, SizeOf(TNCB), 0);
ncb.ncb_command := Char(NCBEnum);
ncb.ncb_buffer := PChar(@lanaEnum);
ncb.ncb_length := SizeOf(TLanaEnum);
Netbios(@ncb);

for i := 0 to integer(lanaEnum.length)-1 do
begin
FillChar(ncb, SizeOf(TNCB), 0);
ncb.ncb_command := Char(NCBReset);
ncb.ncb_lana_num := lanaEnum.lana;
Netbios(@ncb);

FillChar(ncb, SizeOf(TNCB), 0);
ncb.ncb_command := Chr(NCBAstat);
ncb.ncb_lana_num := lanaEnum.lana;
ncb.ncb_callname := '* ';
ncb.ncb_buffer := PChar(@adapt);
ncb.ncb_length := SizeOf(TASTAT);
if Netbios(@ncb) = Chr(0) then
begin
strMac := '';
for j := 0 to 5 do
begin
strPart := IntToHex(integer(adapt.adapter.adapter_address[j]), 2);
strMac := strMac + strPart + '-';
end;
SetLength(strMac, Length(strMac)-1);
slMac.Add(strMac);
end;
end;
end;

procedure TUDPSock2.StartReceive;
begin
if fRecvThd <> nil then
Exit;

if ((fSockType = stUnicastReceiver) or (fSockType = stMulticastReceiver)
or (fSockType = stBroadcastReceiver)) and (fSockCount > 0) then
fRecvThd := TUDPRecvThd.Create(fSocks, fOnRecv, fBufSize);
end;

function TUDPSock2.LocalIPValid(var LocalIP : string): Boolean;
var
i : integer;
slLocalIPs : TStringList;
begin
Result := False;
slLocalIPs := TStringList.Create;
Self.LocalIPs(slLocalIPs);
if slLocalIPs.Count = 0 then
begin
slLocalIPs.Free;
Exit;
end;

if LocalIP = '' then
begin
LocalIP := slLocalIPs[0]; //Default Interface
Result := True;
end else
for i:=0 to slLocalIPs.Count-1 do
if Trim(slLocalIPs) = Trim(LocalIP) then
begin
Result := True;
Break;
end;
slLocalIPs.Free;
end;

function TUDPSock2.Setup(udpSockType : TUDPSockType; LocalIP : string = '';
BufferSize : integer = DEFAULTBUFFERSIZE):Boolean;
begin
Result := False;
//Already started?
if fSockCount > 0 then
Exit;

//Local IP set valid?
if not LocalIPValid(LocalIP) then
Exit;

//Buffer Size Valid?
if not ((BufferSize <= MAXBUFFERSIZE) and (BufferSize >= MINBUFFERSIZE)) then
Exit;

fSockType := udpSockType;
fBufSize := BufferSize;
fLocalIP := LocalIP;
fbSetupReady := True;
Result := True;
end;

function TUDPSock2.Add(RemoteIP : string; Port : u_Short): integer;
var
nMCAddr : Cardinal;
nTTL, nReuseAddr : integer;
Sock : TSocket;
SockAddrLocal, SockAddrRemote : TSockAddr;
MCReq : TIP_mreq;
pPE : PProtoEnt;
begin
Result := -1;
//Maximum fds allowed
if fSockCount = FD_SETSIZE then
Exit;

//Already started?
if (fRecvThd <> nil) or (not fbSetupReady) then
Exit;

//Multicast address valid?
if (fSockType = stMultiCastSender) or (fSockType = stMultiCastReceiver) then
begin
nMCAddr := ntohl(inet_addr(PChar(RemoteIP)));
//though Multicast ip is between 224.0.0.0 to 239.255.255.255
//the 224.0.0.0 to 224.0.0.225 ips are reserved for system
if not ((nMCAddr <= $efffffff) and (nMCAddr >= $e0000100)) then
Exit;
end;

pPE := GetProtoByName('UDP');
//Create Socket
Sock := Socket(AF_INET, SOCK_DGRAM, pPE.p_proto);
if Sock = INVALID_SOCKET then
Exit;

//Reuse the address, according to WinSock help, nReuseAddr must be a BOOL and
//the fifth param must be SizeOf(integer), but in a sample codes, the fifth is SizeOf(BOOL)
//faint! I used integer and SizeOf(integer) is also OK
nReuseAddr := 1;
if SetSockOpt(Sock, SOL_SOCKET, SO_REUSEADDR, @nReuseAddr, SizeOf(integer)) = SOCKET_ERROR then
begin
CloseSocket(Sock);
Exit;
end;

//Set Local Address and bind
FillChar(SockAddrLocal, SizeOf(SockAddrLocal), 0);
SockAddrLocal.sin_family := AF_INET;
if (fSockType = stMultiCastSender) or (fSockType = stUnicastSender)
or (fSockType = stBroadcastSender) then
SockAddrLocal.sin_port := htons(0)
else
SockAddrLocal.sin_port := htons(Port);
SockAddrLocal.sin_addr.S_addr := Inet_Addr(PChar(fLocalIP));
if Bind(Sock, SockAddrLocal, SizeOf(SockAddrLocal)) = SOCKET_ERROR then
begin
CloseSocket(Sock);
Exit;
end;

if (fSockType = stMultiCastSender) or (fSockType = stUnicastSender)
or (fSockType = stBroadcastSender)then
begin
//Set Send Buffer Size
if SetSockOpt(Sock, SOL_SOCKET, SO_SNDBUF, @fBufSize, SizeOf(integer)) = SOCKET_ERROR then
begin
CloseSocket(Sock);
Exit;
end;

//Set output interface
if fSockType = stMultiCastSender then
begin
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;
end else //For send, must set the opt SO_BROADCAST
if fSockType = stBroadcastSender then
if SetSockOpt(Sock, SOL_SOCKET, SO_BROADCAST, @nReuseAddr, 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);
if fSockType = stBroadcastSender then
SockAddrRemote.sin_addr.S_addr := htonl(INADDR_BROADCAST)
else
SockAddrRemote.sin_addr.S_addr := Inet_Addr(PChar(RemoteIP));

fSockCount := fSockCount + 1;
SetLength(fAddrTo, fSockCount);
fAddrTo[fSockCount-1] := SockAddrRemote;
end else //UDPReceiver or MulticastReceiver or BroadcastReceiver
begin
//Set Receive Buffer Size
if SetSockOpt(Sock, SOL_SOCKET, SO_RCVBUF, @fBufSize, SizeOf(integer)) = SOCKET_ERROR then
begin
CloseSocket(Sock);
Exit;
end;

//Join Group
if fSockType = stMulticastReceiver then
begin
MCReq.imr_multiaddr.S_addr := Inet_Addr(PChar(RemoteIP));
MCReq.imr_interface.S_addr := Inet_Addr(PChar(fLocalIP));
if SetSockOpt(Sock, IPPROTO_IP, IP_ADD_MEMBERSHIP, @MCReq,
SizeOf(TIP_mreq)) = SOCKET_ERROR then
begin
CloseSocket(Sock);
Exit;
end;
end;

fSockCount := fSockCount + 1;
if fSockType = stMulticastReceiver then
begin
SetLength(fMCReq, fSockCount);
fMCReq[fSockCount-1] := MCReq;
end;
end;

SetLength(fSocks, fSockCount);
fSocks[fSockCount-1] := Sock;
Result := fSockCount - 1;
end;

function TUDPSock2.Close:Boolean;
var
i : integer;
begin
Result := False;
if fSockCount = 0 then
Exit;

if (fSockType = stUnicastReceiver) or (fSockType = stMulticastReceiver)
or (fSockType = stBroadcastReceiver) then
begin
//Exception will be? I don't know
if fRecvThd <> nil then
begin
fRecvThd.Suspend;
fRecvThd.Free;
fRecvThd := nil;
end;

if fSockType = stMulticastReceiver then
for i := 0 to fSockCount - 1 do
SetSockOpt(fSocks, IPPROTO_IP, IP_DROP_MEMBERSHIP, @fMCReq, SizeOf(fMCReq));
end;

for i := 0 to fSockCount - 1 do
CloseSocket(fSocks);

SetLength(fMCReq, 0);
SetLength(fSocks, 0);
SetLength(fAddrTo, 0);
fbSetupReady := False;
fSockCount := 0;
end;

function TUDPSock2.Send(index : integer; buffer : Pointer; len : integer) : Boolean;
begin
Result := False;
if (len < 0) or (index < 0) or (index >= fSockCount) then
Exit;

if (fSockType <> stMultiCastSender) and (fSockType <> stUnicastSender)
and (fSockType <> stBroadcastSender) then
Exit;

if SendTo(fSocks[index], buffer^, len, 0{MSG_DONTROUTE}, fAddrTo[index],
SizeOf(fAddrTo[index])) <> SOCKET_ERROR then
Result := True;
end;

constructor TUDPSock2.Create;
begin
fbSetupReady := False;
fSockCount := 0;
fRecvThd := nil;
end;

destructor TUDPSock2.Destroy;
begin
if fSockCount > 0 then
Self.Close;
end;

initialization
if WSAStartup(MakeWord(2,0), wsData)<>0 then
raise Exception.Create('Cannot use the socket service!');

finalization
WSACleanup;

end.

接受答案了.