Multiple address broadcast control

Unit MulticastSocket;

{* Multiple Site Broadcast Control * This file is extracted from U_UDPSock.pas * November 17 to 2001, November 18, 2001 * About NB30 Unit, mainly for * "Get all MAC addresses of local computers" * Procedure LocalMac (SLMAC: TStringList); * So I was commented on * Don't affect the use}

Interface

Uses Windows, Messages, Sysutils, Classes, Graphics, Controls, Forms, Dialogs, Winsock; //, NB30;

Const minBuffersize = 2048; defaultBuffersize = 16384; maxbuffersize = 63488; // 62 * 1024 MULTICAST_TTL = ip_default_multicast_ttl; max_multicast_ttl = 128;

TYPE 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; // Pointer of Array

(* Pastat = ^ Tastat; Tastat = Record Adapter: tadapterstatus; name_buf: tnamebuffer; end; *)

TudponRecv = Procedure (Buffer: Pointer; Len: Inteder; fromip: string; fromport: u_short) of object;

// data receiving thread TUDPRecvThd = class (TThread) private fSocks: TSocket; fBufSize: integer; fOnRecv: TUDPOnRecv; protected procedure Execute; override; public constructor Create (var Socks: TSocket; OnRecv: TUDPOnRecv; BufSize: integer); end;

TYPE TMULTICASTSOCKET = Class (Tcomponent) private {private declarations} Factived: boolean; {is activated}

Fsock: tsocket; {socket} FRECVTHD: TUDPRECVTHD; {Receive thread} fmcreq: TIP_MREQ; {Record the add-in group address, use} fsendbufsize: integer; {Send buffer size} FRECVBUFSIZE: Integer; {Receive buffer size } Flocalip: string; {Local IP address} faddrto: tsockaddr; {Send IP address} fcanread: boolean; {can read data} fcanWrite: boolean; {can send data} fttl: integer; {Time to Live, survival time, That is, the number of gateways can be across the gateway} fgroupaddress: string; {group address} fgroupport: integer; {group port} //fRecvState: boolean; {receiving thread is started} fonRecv: tudponRecv; {Response event} {Group address} Procedure setGroupAddress (addr: String); {set of ports} procedure SetGroupPort (port: integer); {reading} procedure SetCanRead (CanRead: Boolean); {written} procedure SetCanWrite (CanWrite: Boolean); {send buffer size} procedure SetSendBufSize (SendBufSize : integer; {Receive buffer size} Procedure setRecvbufsize (Recvbufsize: integer); {local IP address} Procedure setLocalip (addr: string); {is activated} Procedure setActived (Const VA Lue: boolean; {Time to Live, Survival time, you can span the number of gateways} Procedure Settl (Const value: integer);

{Changing Response Event limit} // procedure setonRecv (const value: boolean); Procedure SetonRecv (Const Value: TudponRecv);

{LOCAL IP SET VALID?} {Parameter is '', get the default IP} Function Localipvalid (Var localip: string): Boolean

{Set Socket may receive data} function EnabledListen: Boolean; {Set Socket not receive data} procedure DisabledListen; {Set Socket may transmit data} function EnabledSend: Boolean; protected {Protected declarations} public {Public declarations} function Close: Boolean; function Send (Buffer: Pointer; LEN: Integer; Flag: Integer = 0): Boolean; Function AddTOGROUP: Integer; Procedure StartReceive

{Obtain the IP address of the local computer all} procedure LocalIPs (slIPs: TStringList); {obtain the MAC address of the local computer all} // procedure LocalMAC (slMac: TStringList); function Connect: Boolean; function DisConnect: Boolean; published {Published declarations } property LocalAddress: String read fLocalIP write SetLocalIP nodefault; property CanRead: Boolean read fCanRead write SetCanRead default true; property CanWrite: Boolean read fCanWrite write SetCanWrite default true; property TTL: integer read fTTL write SetTTL default MULTICAST_TTL; property SendBufSize: integer read fSendBufSize write SetSendBufSize default DEFAULTBUFFERSIZE; property RecvBufSize: integer read fRecvBufSize write SetRecvBufSize default DEFAULTBUFFERSIZE; property groupAddress: String read fGroupAddress write SetGroupAddress nodefault; property GroupPort: integer read fGroupPort write SetGroupPort default 6000; property Actived: Boolean read fActived write SetActived default False;

Property OnDataArrive: TudponRecv Read FonRecv Write SetonRecv NodeFault

Constructor Create (Aowner: Tcomponent); OVERRIDE; DESTRUCTOR DESTROY; OVERRIDE;

PROCEDURE register;

IMPLEMentation

Var WSData: TWSADATA;

Procedure Register; Begin RegisterComponents ('Fast ", [TMULTISTSOCKET];

{TMULTICASTSOCKET}

Function TMULTICASTSOCKET.ADDTOGROUROUP: Integer; sockaddrlocal: tsockaddr; ppe: pprotoent; begin result: = - 1;

PPE: = getProtobyname ('udp'); // Create Socket Fsock: = Socket (AF_INET, SOCK_DGRAM, PPE.P_PROTO); if fsock = invalid_socket.

nReuseAddr: = 1; if SetSockOpt (fSock, SOL_SOCKET, SO_REUSEADDR, @nReuseAddr, SizeOf (integer)) = SOCKET_ERROR then begin CloseSocket (fSock); Exit; end; // Set Local Address and bind FillChar (SockAddrLocal, SizeOf (SockAddrLocal) , 0); SockAddrLocal.sin_family: = AF_INET; // transmission 0 //SockAddrLocal.sin_port: = htons (0); SockAddrLocal.sin_port: = htons (fGroupPort); SockAddrLocal.sin_addr.S_addr: = inet_Addr (PChar (fLocalIP )); If bind (fsock, sockaddrlocal, sizeof (sockaddrlocal)) = socket_error dam clossoSocket; End;

IF fcanwrite dam.

IF fcanread dam1 enabledlisten dam

RESULT: = 0;

function TMulticastSocket.Close: Boolean; begin // MulticastReceiver // Exception will be :( I do not know // receive data release thread if fRecvThd <> nil then begin fRecvThd.Suspend; fRecvThd.Free; fRecvThd:? = nil; END;

DisabledListen; // Close Socket CloseSocket (FSOCK); RESULT: = True;

constructor TMulticastSocket.Create (AOwner: TComponent); begin {set default properties here, I do not know how to write in Default no effect} LocalIPValid (fLocalIP); fCanRead: = True; fCanWrite: = True; fSendBufSize: = DEFAULTBUFFERSIZE; fRecvBufSize : = Defaultbuffersize; fgupaddress: = '225.0.0.1'; fGroupport: = 6000; fttl: = multicast_ttl; inherited create (aowner);

DESTRUCTOR TMULTICASTSOCKET.DESTROY; inherited destroy;

Procedure TmulticastSocket.SetGroupAddress (Addr: string); var nmcaddr: cardinal; begin if actived = true kiln

// Multicast address valid nMCAddr:? = Ntohl (inet_addr (PChar (addr))); // 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 <= $ EFFFFF) and (nmcaddr> = $ E0000100)) The EXIT; FGroupAddress: = Addr; End; Function TmulticastSocket.send (Buffer: Pointer; Len: Integer; Flag: Integer = 0): boolean; Begin Result: = false; if not canwrite dam; if sendto (fsock, buffer ^, len, flag {msg_dontroute}, faddrto, sizeof (faddrto) <> socket_error thrue;

procedure TMulticastSocket.StartReceive; begin if fRecvThd <> nil then // receiving thread has been started Exit; // start receiving thread if Assigned (fOnRecv) then fRecvThd: = TUDPRecvThd.Create (fSock, fOnRecv, fSendBufSize); end;

Procedure TMULTICASTSOCKET.SETCANREAD (CanRead: boolean); begin // if Actived = true dam // EXIT; if fcanread = canread kilne

IF canread the beginning of not enabledlisten dam; end else disabledlisten

FcanRead: = canread;

Procedure TMULTICASTSOCKET.SETCANWRITE (CANWRITE: BOOLEAN); Begin if Actived = True.

FcanWrite: = canwrite;

Procedure TmulticastSocket.SetGroupport (port: integer); begin if actived = true kil1;

FGroupPort: = port;

Procedure TmultiCastsocket.setrvbufsize (Recvbufsize: Integer); begin if actived = true kil1;

// buffer size valid? If not (recvbufsize <= maxbuffersize) and (recvbufsize> = minbuffers)).

procedure TMulticastSocket.SetSendBufSize (SendBufSize: integer); begin if Actived = True then Exit; // Buffer Size Valid if not ((SendBufSize <= MAXBUFFERSIZE) and (SendBufSize> = MINBUFFERSIZE)) then Exit; fSendBufSize:? = SendBufSize; end ;

function TMulticastSocket.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;

if localip = '' Then Begin localip: = SLLOCALIPS [0]; // default interface result: = true; end else for i: = 0 to sllocalips.count-1 do if trim (SLLocalips [i]) = TRIM (localip ..........................................

Procedure TmulticastSocket.SetLocalip (AddR: string); begin if actived = true kil1;

// Local IP set valid? If not localipvalid (add) THEN EXIT; flocalip: = addr;

procedure TMulticastSocket.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 ^ [i] <> nil) THEN SALOCAL.SIN_ADDR: = (PINAD ^ [i] ^) // local Host Else Break; End;

(* Procedure TMULTICASTSOCKET.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 [i]; netbios (@ncb);

Fillchar (NCB, SIZEOF (TNCB), 0); ncb.ncb_command: = chr (ncbastat); ncb.ncb_lana_num: = lanaenum.lana [i]; 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 TmultiCastSocket.setAractived (const value: boolean); begin if value = factive DIT; if Value THEN CONNECT ELSE DISCONNECT; END;

Function TMULTICASTSOCKET.CONNECT: Boolean; Begin Result: = (addtogroup = 0); if NOT RESULT THEN EXIT; IF CANREAD AND ASSIGNED (FONRECV) THEN StartReceive; Factive; = Result;

Function TMULTICASTSOCKET.DISCONNECT: Boolean; Begin Result: = Close; if Result the factive: = false;

procedure TMulticastSocket.SetOnRecv (const Value: TUDPOnRecv); begin if Actived and Assigned (fOnRecv) then // event is already running Exit; fOnRecv: = Value; if Actived then // has been activated but did not set the event StartReceive; end; procedure TMULTICASTSOCKET.SETTTTL (Const Value: Integer); Begin if ActiveD or (Value> max_multicast_ttl) or (Value <0) THEN EXIT; fttl: = value;

Function TMULTICASTSOCKET.ENABLISTEN: BOOLEAN; var McReq: TIP_MREQ; Begin Result: = FALSE

{Receive data buffer size} if setsockopt (fsock, sol_socket, so_rcvbuf, @frecvbufsize, sizeof) = socket_error dam clossoSocket; End;

{Add multicast group} MCReq.imr_multiaddr.S_addr: = Inet_Addr (PChar (fGroupAddress)); MCReq.imr_interface.S_addr: = Inet_Addr (PChar (fLocalIP)); if SetSockOpt (fSock, IPPROTO_IP, IP_ADD_MEMBERSHIP, @MCReq, SizeOf (Tip_mreq)) = Socket_ERROR THEN Begin CloseSocket (FSOCK); EXIT; END; FMCREQ: = McReq;

IF Active and Assigned (FonRecv) Then StartReceive;

RESULT: = true;

Function TMULTICASTSOCKET.ENABEDSEND: BOOLEAN; VAR SOCKADDRLOCAL, SOCKADDRREMOTE: TSOCKADDR; Begin Result: = FALSE

FillChar (SockAddrLocal, SizeOf (SockAddrLocal), 0); SockAddrLocal.sin_family: = AF_INET; SockAddrLocal.sin_port: = htons (fGroupPort); SockAddrLocal.sin_addr.S_addr: = Inet_Addr (PChar (fLocalIP));

Transmit data buffer size {} if SetSockOpt (fSock, SOL_SOCKET, SO_SNDBUF, @fSendBufSize, SizeOf (integer)) = SOCKET_ERROR then begin CloseSocket (fSock); Exit; end; {IP multicast output interface} if SetSockOpt (fSock, IPPROTO_IP, IP_MULTICAST_IF, @ (SockAddrLocal.sin_addr), SizeOf (in_Addr)) = SOCKET_ERROR then begin CloseSocket (fSock); Exit; end; {set Time To Livw} if SetSockOpt (fSock, IPPROTO_IP, IP_MULTICAST_TTL, @fTTL, SizeOf (integer)) = SOCKET_ERROR then begin CloseSocket (fSock); Exit; end; {transmitted to the destination set in fAddrTo} FillChar (SockAddrRemote, SizeOf (SockAddrRemote), 0); SockAddrRemote.sin_family: = AF_INET; SockAddrRemote.sin_port: = htons (fGroupPort ); Sockaddrremote.sin_addr.s_addr: = inet_addr (pchar (fgroupaddress)); faddrto: = SockAddrremote

RESULT: = true;

Procedure TmulticastSocket.disabledListen; Begin Setsockopt (fsock, ipproto_ip, ip_drop_membership, @fmcreq, sizeof (fmcreq));

{Tudprecvthd}

constructor TUDPRecvThd.Create (var Socks: TSocket; OnRecv: TUDPOnRecv; BufSize: integer); begin fSocks: = Socks; fOnRecv: = OnRecv; fBufSize: = BufSize; FreeOnTerminate: = True; inherited Create (False); end;

procedure TUDPRecvThd.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 (fsocks, readfds); select (0, @readfds, nil, nil, nil); if fd_isset (fsocks, readfds) THEN BEGIN NRECVED: = Recvfrom (fsocks, buf, fbufsize, 0, sockfrom) , nAddrLen); if Assigned (fOnRecv) then fOnRecv (@buf, nRecved, string (inet_Ntoa (SockFrom.sin_addr)), Cardinal (ntohs (SockFrom.sin_port))); end; end; end; initialization if WSAStartup (MakeWord ( 2, 0), WSDATA) <> 0 Then Raise Exception.create ('Cannot Use The Socket Service!');

Finalization wsacleanup;

End.