unit uROBroadcastChannel; {----------------------------------------------------------------------------} { 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, ContNrs, SysUtils, uROIndyUDPChannel, uROClasses; type IROBroadcastNotification = interface ['{5C18A885-76D2-40D2-9529-CC81B00E7C99}'] procedure ResponseReceived(ServerIP, ResponseUID: string); end; TROBCResponseThread = class(TROUDPResponseThread) private protected procedure Execute; override; public end; TROResponseReceivedEvent = procedure(ServerIP, ResponseUID: string) of object; TROBroadcastChannel = class(TROIndyUDPChannel) private FNotifyList: TROInterfaceRegistry; FGetServerGUID: string; FOnBroadcastResponseReceived: TROResponseReceivedEvent; procedure SetOnBroadcastResponseReceived(const Value: TROResponseReceivedEvent); protected procedure NotifyListners(aServerIP, aResponseUID: string); procedure Loaded; override; procedure SendReq(aRequest: TStream; UID: string; AddToStorage: Boolean = true); override; function GetResponseThreadClass: TROUDPResponseThreadClass; override; procedure DoEndOfThread(Sender: TROUDPResponseThread); override; public procedure RegisterResponseListner(aListner: IROBroadcastNotification); procedure UnRegisterResponseListner(aListner: IROBroadcastNotification); function ReceiveResp(aTimeOut: Integer): Boolean; override; constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property OnBroadcastResponseReceived: TROResponseReceivedEvent read FOnBroadcastResponseReceived write SetOnBroadcastResponseReceived; end; implementation uses uROClient, uROStreamUtils, uROAsyncResponseStorage, idGlobal; constructor TROBroadcastChannel.Create(AOwner: TComponent); begin inherited; FGetServerGUID := ''; FNotifyList := TROInterfaceRegistry.Create(IROBroadcastNotification); end; destructor TROBroadcastChannel.Destroy; begin FNotifyList.Free; inherited; end; procedure TROBroadcastChannel.SendReq(aRequest: TStream; UID: string; AddToStorage: Boolean = true); var lReq: string; begin lReq := Strm_StreamToStr(aRequest); // Sends the Message identifier in front of the actual message IndyClient.Broadcast(UID + lReq, IndyClient.Port); if AddToStorage then AddRequestToStorage(aRequest, UID); end; procedure TROBroadcastChannel.Loaded; begin inherited; Self.IndyClient.BroadcastEnabled := True; end; function TROBroadcastChannel.GetResponseThreadClass: TROUDPResponseThreadClass; begin result := TROBCResponseThread; end; procedure TROBroadcastChannel.RegisterResponseListner(aListner: IROBroadcastNotification); begin if not (Assigned(aListner)) then Exit; FNotifyList.Register(aListner); end; procedure TROBroadcastChannel.UnRegisterResponseListner(aListner: IROBroadcastNotification); begin if not (Assigned(aListner)) then Exit; FNotifyList.Unregister(aListner); end; procedure TROBroadcastChannel.NotifyListners(aServerIP, aResponseUID: string); var i: Integer; begin for i := 0 to FNotifyList.Count - 1 do IROBroadcastNotification(FNotifyList[i]).ResponseReceived(aServerIP, aResponseUID); end; procedure TROBroadcastChannel.DoEndOfThread(Sender: TROUDPResponseThread); var lUID: string; lResItm: TROResponseItem; begin try lUID := Sender.RequestUID; if (Sender.ReceivedResponse) and ((Assigned(FOnBroadcastResponseReceived)) or (FNotifyList.Count > 0)) then begin while CheckStatus(lUID) do begin // Atention, the event handler is supposed to process the response // Processing the response will remove the response automaticly lResItm := ResponseStorage.GetRespByUID(lUID); if Assigned(lResItm) then {// to be sure} begin NotifyListners(lResItm.IP, lResItm.UID); if Assigned(FOnBroadcastResponseReceived) then FOnBroadcastResponseReceived(lResItm.IP, lResItm.UID); // Remove the response in case the user didn't process it. // If it is already gone , no harm is done ResponseStorage.RemoveResp(lResItm); end; end; end; finally RequestStorage.RemoveRespByUID(lUID); inherited; end; end; procedure TROBroadcastChannel.SetOnBroadcastResponseReceived(const Value: TROResponseReceivedEvent); begin FOnBroadcastResponseReceived := Value; end; {----------------------------------------------------------------------------- Procedure: TROBroadcastChannel.ReceiveResp Author: Nico Date: 23-apr-2003 Arguments: aTimeOut: Integer Result: Boolean Keeps reading from the socket until a read time out occurs -----------------------------------------------------------------------------} function TROBroadcastChannel.ReceiveResp(aTimeOut: Integer): Boolean; var lBuf: string; lID: string; lResItm: TROResponseItem; lResp: TStringStream; lIP: string; {$IFDEF RemObjects_INDY10} lPort: TIDPort; {$ELSE} lPort: Integer; {$ENDIF} begin FCriticalSection.Enter; try result := False; repeat lBuf := IndyClient.ReceiveString(lIP, lPort, aTimeOut); if lBuf <> '' then begin lID := StripID(lBuf); lResp := TStringStream.Create(lBuf); lResItm := TROResponseItem.Create(lResp, lID); lResItm.IP := lIP; lResItm.Port := lPort; ResponseStorage.AddResp(lResItm); result := True; end; until lBuf = ''; finally FCriticalSection.Leave; end; end; //------------------------------------------------------------------------------ { TROBCResponseThread } //------------------------------------------------------------------------------ procedure TROBCResponseThread.Execute; begin {$IFDEF RemObjects_SetThreadName} SetName(Name); {$ENDIF} Channel.ReceiveResp(Channel.AsyncTimeOut); FRespReceived := Channel.CheckStatus(RequestUID); if not FRespReceived then Synchronize(DoTimeOut) else Synchronize(DoEnd); end; initialization RegisterTransportChannelClass(TROBroadcastChannel); finalization UnRegisterTransportChannelClass(TROBroadcastChannel); end.