Componentes.Terceros.RemObjects/internal/5.0.24.615/1/RemObjects SDK for Delphi/Source/uROBroadcastChannel.pas

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.