Componentes.Terceros.RemObjects/official/5.0.23.613/RemObjects SDK for Delphi/Source/uROBroadcastServer.pas

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.