DELPHI组播
组播技术可形象的描述如下：
假设一个企业分布于各地的子公司（两个以上）之间需要通过Internet进行实时的交换信息(数据，声音，图像)，他们的计算机可能不属于同一物理网 络，甚至不属于同一自治系统，这种通信的特点是“多点”式的。子公司发出的数据希望其他子公司都能收到，而总部发出的指示全体子公司都应收到。这种多点通信方式为组内广播，即组播技术，也称多播技术，多目网关技术。
1.2、TCP/IP传送方式
组播技术是TCP/IP传送方式的一种。在我们讨论组播技术之前先来看看TCP/IP传送方式。TCP/IP传送方式有三种：单播，广播，组播。
单播（Unicast）传输：在发送者和每一接收者之间需要单独的数据信道。 如果一台主机同时给很少量的接收者传输数据，一般没有什么问题。但如果有大量主机希望获得数据包的同一份拷贝时却很难实现。这将导致发送者负担沉重、延迟长、网络拥塞；为保证一定的服务质量需增加硬件和带宽。
组播（Multicast）传输：它提高了数据传送效率。减少了主干网出现拥塞的可能性。组播组中的主机可以是在同一个物理网络，也可以来自不同的物理网络（如果有组播路由器的支持）。
广播（Broadcast）传输：是指在IP子网内广播数据包，所有在子网内部的主机都将收到这些数据包。广播意味着网络向子网主机都投递一份数据包，不论这些主机是否乐于接收该数据包。然而广播的使用范围非常小， 只在本地子网内有效，因为路由器会封锁广播通信。广播传输增加非接收者的开销。
组播是一种允许一个或多个发送者（组播源）发送单一的数据包到多个接收者（一次的，同时的）的网络技术。 组播源把数据包发送到特定组播组，而只有属于该组播组的地址才能接收到数据包。组播可以大大的节省网络带宽， 因为无论有多少个目标地址，在整个网络的任何一条链路上只传送单一的数据包。 它提高了数据传送效率。减少了主干网出现拥塞的可能性。组播组中的主机可以是在同一个物理网络， 也可以来自不同的物理网络（如果有组播路由器的支持）。
下面是参考代码：
unit udp;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, winsock,
StdCtrls;
const
WM_SOCK = WM_USER + 1; //自定义windows消息
UDPPORT = 6543; //设定UDP端口号
//D类地址224.0.0.0 - 239.255.255.255
//若为224.0.0.1则本机也能收到，否则本机收不到，其它机器能收到。
MY_GROUP = '224.0.0.2';
(*
* Argument structure for IP_ADD_MEMBERSHIP and IP_DROP_MEMBERSHIP.
* Delphi5自带的winsock.pas中没有ip_mreq的定义。
*)
type
ip_mreq = record
imr_multiaddr: in_addr; (* IP multicast address of group *)
imr_interface: in_addr; (* local IP address of interface *)
end;
TIpMReq = ip_mreq;
PIpMReq = ^ip_mreq;
type
Tfrmmain = class(TForm)
Button1: TButton;
Edit1: TEdit;
Memo1: TMemo;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
s: TSocket;
addr: TSockAddr;
FSockAddrIn : TSockAddrIn;
mreq:ip_mreq;
//利用消息实时获知UDP消息
procedure ReadData(var Message: TMessage); message WM_SOCK;
public
{ Public declarations }
procedure SendData(Content: String);
end;
var
frmmain: Tfrmmain;
implementation
{$R *.DFM}
procedure Tfrmmain.FormCreate(Sender: TObject);
var
TempWSAData: TWSAData;
//optval: integer;
begin
Edit1.Text := MY_GROUP;
// 初始化SOCKET
if WSAStartup($101, TempWSAData)=1 then
showmessage('StartUp Error!');
s := Socket(AF_INET, SOCK_DGRAM, 0);
if (s = INVALID_SOCKET) then //Socket创建失败
begin
showmessage(inttostr(WSAGetLastError())+' Socket创建失败');
CloseSocket(s);
//exit;
end;
//发送方SockAddr绑定
addr.sin_family := AF_INET;
addr.sin_addr.S_addr := INADDR_ANY;
addr.sin_port := htons(UDPPORT);
if Bind(s, addr, sizeof(addr)) <> 0 then
begin
showmessage('bind fail');
end;
{optval:= 1;
if setsockopt(s,SOL_SOCKET,SO_BROADCAST,pchar(@optval),sizeof(optval)) = SOCKET_ERROR then
begin
showmessage('无法进行UDP广播');
end;}
mreq.imr_multiaddr.S_addr := inet_addr(pchar(MY_GROUP));//htonl(INADDR_ALLHOSTS_GROUP);
mreq.imr_interface.S_addr := htonl(INADDR_ANY);
if setsockopt(s,IPPROTO_IP,IP_ADD_MEMBERSHIP,pchar(@mreq),sizeof(mreq)) = SOCKET_ERROR then
begin
showmessage('无法进行UDP组播');
end;
WSAAsyncSelect(s, frmmain.Handle , WM_SOCK, FD_READ);
//接收端SockAddrIn设定
FSockAddrIn.SIn_Family := AF_INET;
FSockAddrIn.SIn_Port := htons(UDPPORT);
label3.Caption := '端口：'+inttostr(UDPPORT);
end;
procedure Tfrmmain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
CloseSocket(s);
end;
procedure Tfrmmain.ReadData(var Message: TMessage);
var
buffer: Array [1..4096] of char;
len: integer;
flen: integer;
Event: word;
value: string;
begin
flen:=sizeof(FSockAddrIn);
Event := WSAGetSelectEvent(Message.LParam);
if Event = FD_READ then
begin
len := recvfrom(s, buffer, sizeof(buffer), 0, FSockAddrIn, flen);
value := copy(buffer, 1, len);
Memo1.Lines.add(value)
end;
end;
procedure Tfrmmain.SendData(Content: String);
var
value{,hostname}: string;
len: integer;
begin
//FSockAddrIn.SIn_Addr.S_addr := INADDR_BROADCAST;
FSockAddrIn.SIn_Addr.S_addr := inet_addr(pchar(MY_GROUP));
value := Content;
len := sendto(s, value[1], Length(value), 0, FSockAddrIn, sizeof(FSockAddrIn));
if (WSAGetLastError() <> WSAEWOULDBLOCK) and (WSAGetLastError() <> 0) then
showmessage(inttostr(WSAGetLastError()));
if len = SOCKET_ERROR then
showmessage('send fail');
if len <> Length(value) then
showmessage('Not Send all');
end;
procedure Tfrmmain.Button1Click(Sender: TObject);
begin
senddata(Edit2.text);
end;
end.
浙公网安备 33010602011771号