322 lines
9.3 KiB
ObjectPascal
322 lines
9.3 KiB
ObjectPascal
unit uROIndyUDPServer;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ RemObjects SDK Library - Indy Components }
|
|
{ }
|
|
{ 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,
|
|
IdUDPServer, IdSocketHandle, IdGlobal,
|
|
uROServer, uROClasses, uROClientIntf;
|
|
|
|
|
|
type
|
|
|
|
|
|
TROIndyUDPServer = class;
|
|
|
|
TROIndyUDPTransport = class(TInterfacedObject, IROTransport, IROTCPTransport)
|
|
private
|
|
FBinding: TIdSocketHandle;
|
|
FServer: TROIndyUDPServer;
|
|
protected
|
|
function GetTransportObject : TObject;
|
|
function GetClientAddress : string;
|
|
public
|
|
property Binding: TIdSocketHandle read FBinding;
|
|
property Server: TROIndyUDPServer read FServer;
|
|
|
|
constructor Create(aServer: TROIndyUDPServer;aBinding: TIdSocketHandle);
|
|
end;
|
|
|
|
TROIndyUDPTransportclass = class of TROIndyUDPTransport;
|
|
|
|
TXPIdUDPServer = class(TIdUDPServer)
|
|
private
|
|
function GetActive: boolean; reintroduce;
|
|
public
|
|
procedure IndySetActive(Value : boolean);
|
|
published
|
|
property Active : boolean read GetActive;
|
|
end;
|
|
|
|
TROIndyUDPServer = class(TROServer, IROTransport)
|
|
private
|
|
FUDPSvr: TIdUDPServer;
|
|
FIDSize: Integer;
|
|
|
|
function GetIndyUDPServer: TXPIdUDPServer;
|
|
function GetPort: integer;
|
|
procedure SetPort(const Value: integer);
|
|
protected
|
|
function GetMessageID(aStream: TStream): String;
|
|
function FormatDispStream(aStream: TStream): TMemoryStream;
|
|
|
|
{ TROServer }
|
|
procedure IntSetActive(const Value: boolean);override;
|
|
function IntGetActive : boolean;override;
|
|
|
|
{ IROTransport }
|
|
function GetTransportObject : TObject;
|
|
|
|
{$IFDEF RemObjects_INDY10}
|
|
procedure InternalUDPRead(Sender: TObject; AData: TIdBytes; ABinding: TIdSocketHandle); virtual;
|
|
{$ELSE}
|
|
procedure InternalUDPRead(Sender: TObject;AData: TStream;ABinding: TIdSocketHandle); virtual;
|
|
{$ENDIF}
|
|
function CreateUDPServer: TXPIdUDPServer;virtual;
|
|
|
|
function GetTransportClass: TROIndyUDPTransportClass;virtual;
|
|
public
|
|
constructor Create(AOwner: TComponent);override;
|
|
destructor Destroy;override;
|
|
published
|
|
property IndyUDPServer: TXPIdUDPServer read GetIndyUDPServer;
|
|
property Port : integer read GetPort write SetPort;
|
|
end;
|
|
|
|
implementation
|
|
|
|
{ TROIndyUDPServer }
|
|
|
|
constructor TROIndyUDPServer.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FUDPSvr := CreateUDPServer;
|
|
{$IFDEF DELPHI6UP}
|
|
FUDPSvr.SetSubComponent(TRUE);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TROIndyUDPServer.CreateUDPServer: TXPIdUDPServer;
|
|
begin
|
|
result := TXPIdUDPServer.Create(Self);
|
|
result.OnUDPRead := InternalUDPRead;
|
|
result.Name := 'InternalIndyServer';
|
|
result.DefaultPort := 8090;
|
|
// In case the result of NewGuidAsString change's in the future
|
|
FIDSize := Length(NewGuidAsString);
|
|
end;
|
|
|
|
destructor TROIndyUDPServer.Destroy;
|
|
begin
|
|
inherited;
|
|
end;
|
|
|
|
function TROIndyUDPServer.GetIndyUDPServer: TXPIdUDPServer;
|
|
begin
|
|
result := TXPIdUDPServer(FUDPSvr);
|
|
end;
|
|
function TROIndyUDPServer.GetPort: integer;
|
|
begin
|
|
Result := IndyUDPServer.DefaultPort;
|
|
end;
|
|
|
|
procedure TROIndyUDPServer.SetPort(const Value: integer);
|
|
begin
|
|
IndyUDPServer.DefaultPort := Value;
|
|
end;
|
|
|
|
function TROIndyUDPServer.GetTransportClass: TROIndyUDPTransportClass;
|
|
begin
|
|
result := TROIndyUDPTransport;
|
|
end;
|
|
|
|
function TROIndyUDPServer.GetTransportObject: TObject;
|
|
begin
|
|
result := Self;
|
|
end;
|
|
|
|
{$IFDEF RemObjects_INDY10}
|
|
procedure TROIndyUDPServer.InternalUDPRead(Sender: TObject; AData: TIdBytes; ABinding: TIdSocketHandle);
|
|
{$ELSE}
|
|
procedure TROIndyUDPServer.InternalUDPRead(Sender: TObject; AData: TStream; ABinding: TIdSocketHandle);
|
|
{$ENDIF}
|
|
var lResp: TStringStream;
|
|
lReq: TMemoryStream;
|
|
lRespS: String;
|
|
lTransport: IROTCPTransport;
|
|
lMesgID: String;
|
|
lStream: TStream;
|
|
begin
|
|
lResp := TStringStream.Create('');
|
|
lReq := nil;
|
|
try
|
|
{$IFDEF RemObjects_INDY10}
|
|
lStream := TMemoryStream.Create();
|
|
WriteTIdBytesToStream(lStream, AData);
|
|
lStream.Position := 0;
|
|
try
|
|
{$ELSE}
|
|
lStream := AData;
|
|
{$ENDIF}
|
|
|
|
lMesgID := GetMessageID(lStream);
|
|
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);
|
|
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;
|
|
|
|
{$IFDEF RemObjects_INDY10}
|
|
finally
|
|
FreeAndNil(lStream);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
finally
|
|
if Assigned(lReq) then
|
|
lReq.Free;
|
|
lResp.Free;
|
|
end;
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------
|
|
Procedure: TROIndyUDPServer.GetMessageID
|
|
Author: Nico
|
|
Date: 19-apr-2003
|
|
Arguments: aStream: TStream
|
|
Result: String
|
|
Extracts the included ID from the stream.
|
|
Returns a empty string if the method is not able to extract the ID.
|
|
-----------------------------------------------------------------------------}
|
|
function TROIndyUDPServer.GetMessageID(aStream: TStream): String;
|
|
var lPos: Integer;
|
|
begin
|
|
result := '';
|
|
if not(Assigned(aStream)) then
|
|
exit;
|
|
if aStream.Size < FIDSize then
|
|
Exit;
|
|
|
|
lPos := aStream.Position;
|
|
try
|
|
aStream.Position := 0;
|
|
SetLength(result,FIDSize);
|
|
aStream.ReadBuffer(result[1],FIDSize);
|
|
finally
|
|
aStream.Position := lPos;
|
|
end;
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------
|
|
Procedure: TROIndyUDPServer.FormatDispStream
|
|
Author: Nico
|
|
Date: 19-apr-2003
|
|
Arguments: aStream: TStream
|
|
Result: TStream
|
|
Constructs the given aStream back to a dispatchable RO stream.
|
|
This involves the removing of included ID, that is assumed to be present
|
|
in the given stream.If the method is not able to counstruct a dispatchable
|
|
stream the result will be nil.
|
|
-----------------------------------------------------------------------------}
|
|
function TROIndyUDPServer.FormatDispStream(aStream: TStream): TMemoryStream;
|
|
var lBuf: String;
|
|
lPos: Integer;
|
|
begin
|
|
result := nil;
|
|
if not(Assigned(aStream)) then
|
|
Exit;
|
|
if aStream.Size < FIDSize then
|
|
Exit;
|
|
|
|
lPos := aStream.Position;
|
|
// Initializa the result stream
|
|
result := TMemoryStream.Create;
|
|
try
|
|
try
|
|
TMemoryStream(result).SetSize(aStream.Size-FIDSize);
|
|
|
|
SetLength(lBuf,aStream.Size-FIDSize);
|
|
// Set the given stream pos on 1 byte after the prefixed ID
|
|
aStream.Position := FIDSize;
|
|
// Copy the contens without ID to the local buffer.
|
|
aStream.Read(lBuf[1],aStream.Size-FIDSize);
|
|
// Copy the contents of the buffer into the result stream
|
|
result.Position := 0;
|
|
result.Write(lBuf[1],aStream.Size-FIDSize);
|
|
result.Position := 0;
|
|
except
|
|
// Dont return the result stream
|
|
result.Free;
|
|
result := nil;
|
|
raise;
|
|
end;
|
|
finally
|
|
aStream.Position := lPos;
|
|
end;
|
|
end;
|
|
|
|
//------------------------------------------------------------------------------
|
|
{ TXPIdUDPServer }
|
|
//------------------------------------------------------------------------------
|
|
|
|
function TXPIdUDPServer.GetActive: boolean;
|
|
begin
|
|
result := Inherited Active;
|
|
end;
|
|
|
|
procedure TXPIdUDPServer.IndySetActive(Value: boolean);
|
|
begin
|
|
inherited Active := Value;
|
|
end;
|
|
|
|
function TROIndyUDPServer.IntGetActive: boolean;
|
|
begin
|
|
result := FUDPSvr.Active;
|
|
end;
|
|
|
|
procedure TROIndyUDPServer.IntSetActive(const Value: boolean);
|
|
begin
|
|
IndyUDPServer.IndySetActive(Value);
|
|
end;
|
|
|
|
//------------------------------------------------------------------------------
|
|
{ TROIndyUDPTransport }
|
|
//------------------------------------------------------------------------------
|
|
|
|
constructor TROIndyUDPTransport.Create(aServer: TROIndyUDPServer;aBinding: TIdSocketHandle);
|
|
begin
|
|
FBinding := aBinding;
|
|
FServer := aServer;
|
|
end;
|
|
|
|
function TROIndyUDPTransport.GetClientAddress: string;
|
|
begin
|
|
result := FBinding.PeerIP;
|
|
end;
|
|
|
|
|
|
function TROIndyUDPTransport.GetTransportObject: TObject;
|
|
begin
|
|
result := Self;
|
|
end;
|
|
|
|
initialization
|
|
RegisterServerClass(TROIndyUDPServer);
|
|
finalization
|
|
UnregisterServerClass(TROIndyUDPServer);
|
|
end.
|