Hi,
this is an example of TUDP class that can be used in multicast (receive
and transmit).
This unit depends by other units, but you can easily extract what you need.
Note that I set multicast ttl.
I hope it will be usefull for you,
Bye
Emanuele
unit ewPlatform_UDP;
interface
uses
ewPlatform_Lists,
ewPlatform_Logger,
ewPlatform_Memory,
ewPlatform_Packets,
ewPlatform_Strings,
OverByteIcsWsocket,
WinSock,
Windows,
SysUtils,
Classes;
type
TOnUDPError=procedure(aError:integer)of object;
TOnUDPDataSent=procedure(aInteger:integer)of object;
TOnUDPDataAvailable=procedure(aSender:TObject;aData:pointer;aSize:integer;aPeerIP:string;aPeerPort:integer)
of object;
TUDP=class
protected
fWS:TWSocket;
fSent:boolean;
fPeerSrc:TSockAddr;
fPeerSrcLen:integer;
fRxData:pointer;
fRxSize:integer;
fWhiteList:TStringList;
fBlackList:TStringList;
fTxList:TStringList;
procedure DataAvailable(aSender:TObject;aError:word);
procedure DataSent(aSender:TObject;aErrCode:word);
procedure DnsLookupDone(aSender:TObject;aErrCode:word);
procedure ChangeState(aSender:TObject;aOldState,aNewState:TSocketState);
procedure Send;
function GetStarted:boolean;
public
pLocalIP:string;
pLocalPort:integer;
pPeerIP:string;
pPeerPort:integer;
pMultiThreaded:boolean;
pMulticast:boolean;
pUseWhiteList:boolean;
pUseBlackList:boolean;
pMulticastTTL:integer;
pGetPeerByData:boolean;
pOnDataSent:TOnUDPDataSent;
pOnDataAvailable:TOnUDPDataAvailable;
pOnError:TOnUDPError;
pOnChangeState:TChangeState;
constructor Create;
destructor Destroy;override;
procedure StartRx;
procedure SetTx;
procedure Disconnect;
procedure Connect;
function Add2WhiteList(aIPPort:string):boolean;
function Add2BlackList(aIPPort:string):boolean;
procedure DeleteFromWhiteList(aIPPort:string);
procedure DeleteFromBlackList(aIPPort:string);
procedure ClearWhiteList;
procedure ClearBlackList;
function NewData(aData:pointer;aSize:integer):integer;
property pStarted:boolean read GetStarted;
end;
implementation
//------------------------------------------------------------------------------
//TUDP
//------------------------------------------------------------------------------
constructor TUDP.Create;
begin
inherited Create;
TLogger.Log('UDP socket creation
threadID='+inttostr(GetCurrentThreadID),lsVerbose,true);
fWS:=TWSocket.Create(nil);
fWS.OnDataAvailable:=DataAvailable;
fWS.OnDataSent:=DataSent;
fWS.OnDnsLookupDone:=DnsLookUpDone;
fWS.OnChangeState:=ChangeState;
fWS.Proto:='udp';
pGetPeerByData:=false;
fTxList:=TStringList.Create;
fSent:=false;
pLocalIP:='0.0.0.0';
pLocalPort:=0;
pPeerIP:='';
pPeerPort:=0;
pMultiThreaded:=false;
pMulticast:=false;
pMulticastTTL:=32;
fWhiteList:=TStringList.Create;
fBlackList:=TStringList.Create;
pUseWhiteList:=false;
pUseBlackList:=false;
fRxSize:=256*1024;
getmem(fRxData,fRxSize);
fPeerSrcLen:=sizeof(fPeerSrc);
end;
destructor TUDP.Destroy;
begin
Disconnect;
FreeObjAndNil(fWS);
FreeMemAndNil(fRxData);
FreeObjAndNil(fWhiteList);
FreeObjAndNil(fBlackList);
FreeList(fTxList);
FreeObjAndNil(fTxList);
inherited Destroy;
end;
procedure TUDP.StartRx;
begin
Disconnect;
pLocalIP:=trim(pLocalIP);
if (pLocalIP<>'')and(pLocalPort>0) then
begin
fWS.Proto:='udp';
fWS.MultiThreaded:=pMultiThreaded;
fWS.Addr:=pLocalIP;
fWS.Port:=inttostr(pLocalPort);
if fWS.Addr='' then
fWS.Addr:='0.0.0.0';
if pMulticast then
begin
fWS.MultiCast:=true;
fWS.ReuseAddr:=true;
fWS.MultiCastAddrStr:=pPeerIP;
end;
fWS.Listen;
fWS.SocketRcvBufSize:=fRXSize;
if pMulticast then
setsockopt(fWS.HSocket,IPPROTO_IP,IP_MULTICAST_TTL,@pMulticastTTL,sizeof(pMulticastTTL));
end
else
TLogger.Log('UDP socket start rx error LocalIP='+pLocalIP+'
LocalPort='+inttostr(pLocalPort),lsError,true);
end;
function TUDP.GetStarted:boolean;
begin
result:=false;
if (assigned(fWS)) then
result:=(fWS.State=wsListening)or(fWS.State=wsConnected);
end;
procedure TUDP.SetTx;
var
lRes:boolean;
begin
pPeerIP:=trim(pPeerIP);
lRes:=(pPeerIp<>'')and(pPeerPort>0);
TLogger.Log('UDP socket set tx PeerIP='+pPeerIP+'
PeerPort='+inttostr(pPeerPort)+'...
'+Boolean2Str(lRes,'ok','ko'),Boolean2Severity(lRes,lsVerbose,lsError),true);
fPeerSrc.sin_family:=AF_INET;
fPeerSrc.sin_addr.s_addr:=WSocket_inet_addr(AnsiString(pPeerIP));
fPeerSrc.sin_port:=htons(word(pPeerPort));
fSent:=false;
FreeList(fTxList);
end;
procedure TUDP.Disconnect;
begin
fWS.Shutdown(SD_BOTH);
fWS.Close;
FreeList(fTxList);
fSent:=false;
end;
procedure TUDP.Connect;
begin
Disconnect;
fWS.Proto:='udp';
fWS.MultiThreaded:=pMultiThreaded;
fWS.LocalAddr:=pLocalIP;
fWS.Addr:=trim(pPeerIP);
fWS.Port:=inttostr(pPeerPort);
SetTx;
if (fWS.Addr<>'')and(pPeerPort>0) then
fWS.DnsLookup(fWS.Addr);
end;
procedure TUDP.DnsLookupDone(aSender:TObject;aErrCode:word);
begin
//se riesco a risolvere l'host mi connetto
if aErrCode=0 then
begin
fWS.Connect;
fWS.SocketRcvBufSize:=fRXSize;
end;
end;
procedure
TUDP.ChangeState(aSender:TObject;aOldState,aNewState:TSocketState);
begin
if assigned(pOnChangeState) then
pOnChangeState(self,aOldState,aNewState);
end;
function TUDP.NewData(aData:pointer;aSize:integer):integer;
var
lItem:TBufferItem;
begin
result:=0;
if (pPeerIP<>'')and(GetStarted) then
begin
lItem:=TBufferItem.Create(aData,aSize,0,0);
fTxList.AddObject(inttostr(aSize),lItem);
Send;
end;
end;
procedure TUDP.Send;
var
lItem:TBufferItem;
begin
if (not fSent)and(fTxList.Count>0) then
begin
lItem:=TBufferItem(fTxList.Objects[0]);
if (fWS.SendTo(fPeerSrc,fPeerSrcLen,lItem.pData,lItem.pSize)>0)or
(WSocket_WSAGetLastError=WSAEWOULDBLOCK)
then
fSent:=true;
end;
end;
procedure TUDP.DataSent(aSender:TObject;aErrCode:word);
var
lItem:TBufferItem;
lSize:integer;
begin
if fSent then
begin
fSent:=false;
lSIze:=0;
if fTxList.Count>0 then
begin
lItem:=TBufferItem(fTxList.Objects[0]);
if assigned(lItem) then
begin
lSize:=lItem.pSize;
FreeObjAndNil(lItem);
end;
fTxList.Delete(0);
end;
if assigned(pOnDataSent) then
pOnDataSent(lSize);
Send;
end;
end;
procedure TUDP.DataAvailable(aSender:TObject;aError:word);
var
lSize:integer;
lPeerSrc:TSockAddrIn;
lPeerSrcLen:integer;
lPeerIP:string;
lPeerPort:integer;
lValidPeer:boolean;
begin
lPeerSrcLen:=sizeof(lPeerSrc);
lSize:=fWS.ReceiveFrom(fRxData,fRxSize-2,lPeerSrc,lPeerSrcLen);
if lSize<0 then
begin
{
WSAEWOULDBLOCK=10035
Resource temporarily unavailable.
This error is returned from operations on nonblocking sockets that
cannot
be completed immediately, for example recv when no data is queued to be
read from the socket. It is a nonfatal error, and the operation
should be
retried later. It is normal for WSAEWOULDBLOCK to be reported as the
result from calling connect on a nonblocking SOCK_STREAM socket,
since some time must elapse for the connection to be established.
}
{
WSAECONNRESET=10054
Connection reset by peer.
An existing connection was forcibly closed by the remote host. This
normally
results if the peer application on the remote host is suddenly stopped,
the host is rebooted, the host or remote network interface is disabled,
or the remote host uses a hard close (see setsockopt for more
information on the SO_LINGER option on the remote socket). This
error may
also result if a connection was broken due to keep-alive activity
detecting a
failure while one or more operations are in progress. Operations that
were in progress fail with WSAENETRESET. Subsequent operations
fail with WSAECONNRESET.
}
if assigned(pOnError) then
pOnError(WSocket_WSAGetLastError);
end
else
begin
lPeerIP:=string(AnsiString(inet_ntoa(lPeerSrc.sin_addr)));
lPeerPort:=ntohs(lPeerSrc.sin_port);
if pGetPeerByData then
begin
pGetPeerByData:=false;
pPeerIP:=lPeerIP;
pPeerPort:=lPeerPort;
SetTx;
end;
lValidPeer:=true;
if pUseWhiteList then
begin
lValidPeer:=(fWhiteList.IndexOf(lPeerIP+':'+inttostr(lPeerPort))>=0)or(fWhiteList.IndexOf(lPeerIP+':*')>=0);
end;
if (lValidPeer)and(pUseBlackList) then
lValidPeer:=(fBlackList.IndexOf(lPeerIP+':'+inttostr(lPeerPort))<0)and(fBlackList.IndexOf(lPeerIP+':*')<0);
if lValidPeer then
begin
PAnsiChar(fRxData)[lSize]:=#0;
PAnsiChar(fRxData)[lSize+1]:=#0;
if assigned(pOnDataAvailable) then
pOnDataAvailable(self,fRxData,lSize,lPeerIP,lPeerPort);
end;
end;
end;
function TUDP.Add2WhiteList(aIPPort:string):boolean;
begin
result:=false;
DeleteFromBlackList(aIPPort);
if fWhiteList.IndexOf(aIPPort)<0 then
begin
fWhiteList.Add(aIPPort);
result:=true;
end;
end;
function TUDP.Add2BlackList(aIPPort:string):boolean;
begin
result:=false;
DeleteFromWhiteList(aIPPort);
if fBlackList.IndexOf(aIPPort)<0 then
begin
fBlackList.Add(aIPPort);
result:=true;
end;
end;
procedure TUDP.DeleteFromWhiteList(aIPPort:string);
var
lIndex:integer;
begin
lIndex:=fWhiteList.IndexOf(aIPPort);
if lIndex>=0 then
fWhiteList.Delete(lIndex);
end;
procedure TUDP.DeleteFromBlackList(aIPPort:string);
var
lIndex:integer;
begin
lIndex:=fBlackList.IndexOf(aIPPort);
if lIndex>=0 then
fBlackList.Delete(lIndex);
end;
procedure TUDP.ClearWhiteList;
begin
fWhiteList.Clear;
end;
procedure TUDP.ClearBlackList;
begin
fBlackList.Clear;
end;
end.
Il 26/05/2011 06:48, Éric Fleming Bonilha ha scritto:
> Hi
>
> I´m wondering how to use ICS properly to send and receive Multicast data.
> Where can I find example for multicast and ICS?
>
> I´m in doubt about the IGMP protocol, do I need to implement anything on
> application layer or does IGMP protocol is implemented on underlying stack
> automatically?
>
> How my application will create a multicast group on network and/or join a
> group?
>
> Thank you very much!
> Eric
> --
> To unsubscribe or change your settings for TWSocket mailing list
> please goto http://lists.elists.org/cgi-bin/mailman/listinfo/twsocket
> Visit our website at http://www.overbyte.be
--
Ing. Emanuele Bizzarri
Software Development Department
e-works s.r.l.
41011 - Campogalliano - Modena - Italy
tel. +39 059 2929081 int. 23
fax +39 059 2925035
e-mail: e.bizza...@e-works.it - http://www.e-works.it
---------------------------------------------------------------------
La presente comunicazione, che potrebbe contenere informazioni riservate
e/o protette da segreto professionale, è indirizzata esclusivamente ai
destinatari della medesima qui indicati. Le opinioni, le conclusioni e
le altre informazioni qui contenute, che non siano relative alla nostra
attività caratteristica, devono essere considerate come non inviate né
avvalorate da noi. Tutti i pareri e le informazioni qui contenuti sono
soggetti ai termini ed alle condizioni previsti dagli accordi che
regolano il nostro rapporto con il cliente. Nel caso in cui abbiate
ricevuto per errore la presente comunicazione, vogliate cortesemente
darcene immediata notizia, rispondendo a questo stesso indirizzo di
e-mail, e poi procedere alla cancellazione di questo messaggio dal
Vostro sistema. E' strettamente proibito e potrebbe essere fonte di
violazione di legge qualsiasi uso, comunicazione, copia o diffusione dei
contenuti di questa comunicazione da parte di chi la abbia ricevuta per
errore o in violazione degli scopi della presente.
---------------------------------------------------------------------
This communication, that may contain confidential and/or legally
privileged information, is intended solely for the use of the intended
addressees. Opinions, conclusions and other information contained in
this message, that do not relate to the official business of this firm,
shall be considered as not given or endorsed by it. Every opinion or
advice contained in this communication is subject to the terms and
conditions provided by the agreement governing the engagement with such
a client. If you have received this communication in error, please
notify us immediately by responding to this email and then delete it
from your system. Any use, disclosure, copying or distribution of the
contents of this communication by a not-intended recipient or in
violation of the purposes of this communication is strictly prohibited
and may be unlawful.
--
To unsubscribe or change your settings for TWSocket mailing list
please goto http://lists.elists.org/cgi-bin/mailman/listinfo/twsocket
Visit our website at http://www.overbyte.be
