unit uROBroadcastServer; {----------------------------------------------------------------------------} { RemObjects SDK Library - Core Library } { } { compiler: Delphi 5 and up, Kylix 2 and up } { platform: Win32, Linux } { } { (c)opyright RemObjects Software. all rights reserved. } { } { Provided by Nico Schoemaker (nico.schoemaker@teamro.remobjects.com) } { } { Using this code requires a valid license of the RemObjects SDK } { which can be obtained at http://www.remobjects.com. } {----------------------------------------------------------------------------} {$I RemObjects.inc} interface uses Classes, Sysutils, IdSocketHandle, IdGlobal, uROIndyUDPServer; type TROBroadcastTransport = class(TROIndyUDPTransport) end; TROBroadcastServer = class(TROIndyUDPServer) private FOnRORequest: TNotifyEvent; FUIDCnt: Integer; FLastMessage: string; procedure SetOnRORequest(const Value: TNotifyEvent); protected {$IFDEF RemObjects_INDY10} procedure InternalUDPRead(Sender: TObject; AData: TIdBytes; ABinding: TIdSocketHandle); override; {$ELSE} procedure InternalUDPRead(Sender: TObject; AData: TStream; ABinding: TIdSocketHandle); override; {$ENDIF} function GetTransportClass: TROIndyUDPTransportClass; override; procedure Loaded; override; public constructor Create(AOwner: TComponent); override; published property OnRORequest: TNotifyEvent read FOnRORequest write SetOnRORequest; end; implementation { TROBroadcastServer } uses uROServer, uROClasses, uROClientIntf, uROServerIntf; constructor TROBroadcastServer.Create(AOwner: TComponent); begin inherited; // In case implementation of NewStrippedGuidAsString changes FUIDCnt := Length(NewGuidAsString); FLastMessage := ''; end; {$IFDEF RemObjects_INDY10} procedure TROBroadcastServer.InternalUDPRead(Sender: TObject; AData: TIdBytes; ABinding: TIdSocketHandle); {$ELSE} procedure TROBroadcastServer.InternalUDPRead(Sender: TObject; AData: TStream; ABinding: TIdSocketHandle); {$ENDIF} var lResp: TStringStream; lReq: TMemoryStream; lRespS: String; lTransport: IROTCPTransport; lMesgID: String; lRespOpt: TROResponseOptions; lStream: TStream; begin {$IFDEF RemObjects_INDY10} lStream := TMemoryStream.Create(); WriteTIdBytesToStream(lStream, AData); lStream.Position := 0; try {$ELSE} lStream := AData; {$ENDIF} lMesgID := GetMessageID(lStream); if FLastMessage <> lMesgID then begin FLastMessage := lMesgID; if Assigned(FOnRORequest) then FOnRORequest(Self); lResp := TStringStream.Create(''); lReq := nil; try lReq := FormatDispStream(lStream); if Assigned(lReq) then // lReq becomes nil if not a valid (RO) AData Stream begin lTransport := GetTransportClass.Create(Self,ABinding); DispatchMessage(lTransport, lReq, lResp,lRespOpt); if not(roNoResponse in lRespOpt) then begin lRespS := lMesgID+lResp.DataString; {$IFDEF RemObjects_INDY10} ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, ToBytes(lRespS)); {$ELSE} ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, lRespS[1], Length(lRespS)); {$ENDIF} end; end; finally if Assigned(lReq) then lReq.Free; lResp.Free; end; end; {$IFDEF RemObjects_INDY10} finally FreeAndNil(lStream); end; {$ENDIF} end; function TROBroadcastServer.GetTransportClass: TROIndyUDPTransportClass; begin result := TROBroadcastTransport end; procedure TROBroadcastServer.SetOnRORequest(const Value: TNotifyEvent); begin FOnRORequest := Value; end; procedure TROBroadcastServer.Loaded; begin inherited; IndyUDPServer.BroadcastEnabled := True; end; initialization RegisterServerClass(TROBroadcastServer); finalization UnregisterServerClass(TROBroadcastServer); end.