david
2824855ea7
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10 - Recompilación en Delphi10 de todos los paquetes de DA para generar las DCU's en Lib\D10 git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@9 b6239004-a887-0f4b-9937-50029ccdca16
153 lines
4.4 KiB
ObjectPascal
153 lines
4.4 KiB
ObjectPascal
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.
|
|
|