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
332 lines
10 KiB
ObjectPascal
332 lines
10 KiB
ObjectPascal
unit uROAsync;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ RemObjects SDK Library - Core Library }
|
|
{ }
|
|
{ compiler: Delphi 5 and up, Kylix 2 and up }
|
|
{ platform: Win32, Linux }
|
|
{ }
|
|
{ (c)opyright RemObjects Software. all rights reserved. }
|
|
{ }
|
|
{ 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, SyncObjs, SysUtils,
|
|
uROClientIntf, uROClasses, uROThread, uROTypes, uROClient;
|
|
|
|
type
|
|
IROAsyncInterface = interface
|
|
['{E858979E-78C4-4AE1-A708-9E6766FDD9B4}']
|
|
function GetBusy:Boolean;
|
|
function GetMessageID:string;
|
|
procedure SetMessageID(aMessageID:string);
|
|
function GetAnswerReceived:Boolean;
|
|
function GetAnswerReceivedEvent:TROEvent;
|
|
property Busy:Boolean read GetBusy;
|
|
property MessageID:string read GetMessageID write SetMessageID;
|
|
property AnswerReceived:Boolean read GetAnswerReceived;
|
|
property AnswerReceivedEvent:TROEvent read GetAnswerReceivedEvent;
|
|
end;
|
|
|
|
IROAsyncTransportChannel = interface
|
|
['{206811E7-ABE9-41E6-893C-33DA14E44FF6}']
|
|
function InvokeRequest(aRequest:TStream; iGetResponse:boolean=true):string;
|
|
procedure RetrieveResponse(const iMessageID:string; aResponse:TStream);
|
|
function CheckStatus(const iMessageID:string):boolean;
|
|
end;
|
|
|
|
IROActiveAsyncTransportChannel = interface(IROAsyncTransportChannel)
|
|
['{3FC70749-3F4C-4D6A-AB30-01E0E03A25F4}']
|
|
function InvokeRequest(aRequest:TStream; aGetResponse:boolean=true; aEvent: TROEvent=nil):string;
|
|
end;
|
|
|
|
IROTransportChannelEx = interface
|
|
['{96C85DD3-6372-49DF-B259-04BCD5C0E369}']
|
|
procedure BeforeDispatch(aMessage: IROMessage);
|
|
end;
|
|
|
|
EROAsyncException = class(EROException);
|
|
EROAsyncNoAnswerYet = class(EROAsyncException);
|
|
EROAsyncNoMoreAnswers = class(EROAsyncException);
|
|
|
|
TROAsyncProxy = class;
|
|
|
|
TROAsyncProxyThread = class(TROThread)
|
|
private
|
|
fOwner:TROAsyncProxy;
|
|
fGetResponse:boolean;
|
|
fRequest:TStream;
|
|
protected
|
|
procedure Execute; override;
|
|
public
|
|
constructor Create(iOwner:TROAsyncProxy; const iName:string; iRequest:TStream; iGetResponse:boolean);
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
TROAsyncProxy = class(TInterfacedObject, IUnknown, IROAsyncInterface)
|
|
private
|
|
fCriticalSection:TCriticalSection;
|
|
fMessage:IROMessage;
|
|
fTransportChannel:IROTransportChannel;
|
|
fAsyncTransportChannel:IROAsyncTransportChannel;
|
|
fActiveAsyncTransportChannel:IROActiveAsyncTransportChannel;
|
|
fBeforeDispatch: IROTransportChannelEx;
|
|
fBusy:Boolean;
|
|
fAnswerReceived:Boolean;
|
|
fAnswerReceivedEvent: TROEvent;
|
|
fMethodName:string;
|
|
fMessageID:string;
|
|
fResponse:TStream;
|
|
|
|
protected
|
|
procedure __AssertProxyNotBusy(const iMethodName:string);
|
|
procedure __DispatchAsyncRequest(const iMethodName:string; iRequest:TStream; iGetResponse:boolean=true); overload;
|
|
procedure __DispatchAsyncRequest(const iMethodName:string; iRequest:IROMessage; iGetResponse:boolean=true); overload;
|
|
function __RetrieveAsyncResponse(const iMethodName:string):TStream;
|
|
property __Message:IROMessage read fMessage;
|
|
property __TransportChannel:IROTransportChannel read fTransportChannel;
|
|
|
|
function __GetInterfaceName:string; virtual; abstract;
|
|
|
|
function GetBusy:Boolean;
|
|
function GetMessageID:string;
|
|
procedure SetMessageID(aMessageID:string);
|
|
function GetAnswerReceived:Boolean;
|
|
function GetAnswerReceivedEvent:TROEvent;
|
|
property __InterfaceName:string read __GetInterfaceName;
|
|
|
|
property __CriticalSection: TCriticalSection read fCriticalSection;
|
|
|
|
public
|
|
constructor Create(const aMessage : IROMessage; const aTransportChannel : IROTransportChannel); virtual;
|
|
destructor Destroy; override;
|
|
property Busy:Boolean read fBusy;
|
|
property AnswerReceived:Boolean read fAnswerReceived;
|
|
property MessageID:string read GetMessageID write SetMessageID;
|
|
end;
|
|
|
|
const
|
|
REQUEST_MESSAGE_PREFIX = 'ROSDK REQUEST';
|
|
RESPONSE_MESSAGE_PREFIX = 'ROSDK RESPONSE';
|
|
|
|
implementation
|
|
|
|
{ TROAsyncProxy }
|
|
|
|
constructor TROAsyncProxy.Create(const aMessage: IROMessage; const aTransportChannel: IROTransportChannel);
|
|
begin
|
|
fMessage := aMessage;
|
|
fTransportChannel := aTransportChannel;
|
|
Supports(fTransportChannel, IROAsyncTransportChannel, fAsyncTransportChannel);
|
|
Supports(fTransportChannel, IROActiveAsyncTransportChannel, fActiveAsyncTransportChannel);
|
|
Supports(fTransportChannel, IROTransportChannelEx, fBeforeDispatch);
|
|
|
|
fCriticalSection := TCriticalSection.Create();
|
|
fAnswerReceivedEvent := TROEvent.Create(nil,false,false,'');
|
|
end;
|
|
|
|
destructor TROAsyncProxy.Destroy;
|
|
begin
|
|
//Todo: important: we MUST wait for and free the worker thread here!!!
|
|
FreeAndNil(fResponse);
|
|
FreeAndNil(fCriticalSection);
|
|
FreeAndNil(fAnswerReceivedEvent);
|
|
inherited;
|
|
end;
|
|
|
|
function TROAsyncProxy.GetAnswerReceived: Boolean;
|
|
begin
|
|
fCriticalSection.Enter();
|
|
try
|
|
if Assigned(fAsyncTransportChannel) then begin
|
|
result := fAsyncTransportChannel.CheckStatus(fMessageID);
|
|
end
|
|
else begin
|
|
Result := fAnswerReceived;
|
|
end;
|
|
finally
|
|
fCriticalSection.Leave();
|
|
end;
|
|
end;
|
|
|
|
function TROAsyncProxy.GetAnswerReceivedEvent: TROEvent;
|
|
begin
|
|
if assigned(fAsyncTransportChannel) and not assigned(fActiveAsyncTransportChannel) then
|
|
raise EROAsyncException.Create('TransportChannel does not support to receive responses without explicit polling.');
|
|
result := fAnswerReceivedEvent;
|
|
end;
|
|
|
|
function TROAsyncProxy.GetBusy: Boolean;
|
|
begin
|
|
fCriticalSection.Enter();
|
|
try
|
|
Result := fBusy;
|
|
finally
|
|
fCriticalSection.Leave();
|
|
end;
|
|
end;
|
|
|
|
function TROAsyncProxy.GetMessageID: string;
|
|
begin
|
|
result := fMessageID;
|
|
end;
|
|
|
|
procedure TROAsyncProxy.SetMessageID(aMessageID: string);
|
|
begin
|
|
fMessageID := aMessageID;
|
|
end;
|
|
|
|
procedure TROAsyncProxy.__AssertProxyNotBusy(const iMethodName: string);
|
|
begin
|
|
if (Busy) then
|
|
raise EROChannelBusy.CreateFmt('There''s already an async request to %s in progress.',[fMethodName]);
|
|
end;
|
|
|
|
procedure TROAsyncProxy.__DispatchAsyncRequest(const iMethodName:string; iRequest:TStream; iGetResponse:boolean=true);
|
|
begin
|
|
fCriticalSection.Enter();
|
|
try
|
|
|
|
fAnswerReceivedEvent.ResetEvent();
|
|
__AssertProxyNotBusy(iMethodName);
|
|
|
|
if iGetResponse then begin
|
|
fMethodName := iMethodName;
|
|
end;
|
|
fAnswerReceived := False;
|
|
|
|
if Assigned(fActiveAsyncTransportChannel) then begin
|
|
fMessageID := fActiveAsyncTransportChannel.InvokeRequest(iRequest, iGetResponse, fAnswerReceivedEvent)
|
|
end
|
|
else if Assigned(fAsyncTransportChannel) then begin
|
|
fMessageID := fAsyncTransportChannel.InvokeRequest(iRequest, iGetResponse);
|
|
end
|
|
else begin
|
|
fBusy := true;
|
|
TROAsyncProxyThread.Create(Self,Format('TROAsyncProxyThread for %s calling %s',[ClassName,iMethodName]),iRequest,iGetResponse);
|
|
end;
|
|
|
|
finally
|
|
fCriticalSection.Leave();
|
|
end;
|
|
end;
|
|
|
|
procedure TROAsyncProxy.__DispatchAsyncRequest(const iMethodName: string;
|
|
iRequest: IROMessage; iGetResponse: boolean);
|
|
var
|
|
lRequest: TStream;
|
|
begin
|
|
if fBeforeDispatch <> nil then
|
|
fBeforeDispatch.BeforeDispatch(iRequest);
|
|
lRequest := TMemoryStream.Create;
|
|
|
|
iRequest.WriteToStream(lRequest);
|
|
|
|
__DispatchAsyncRequest(iMethodName, lRequest, iGetResponse);
|
|
end;
|
|
|
|
function TROAsyncProxy.__RetrieveAsyncResponse(const iMethodName: string): TStream;
|
|
begin
|
|
result := nil;
|
|
|
|
fCriticalSection.Enter();
|
|
try
|
|
|
|
{ Only check the Methodname if we actually preserved one before. depending on
|
|
the call history, that might have gotten lost. }
|
|
if (fMethodName <> '') and (fMethodName <> iMethodName) then
|
|
raise EROAsyncException.CreateFmt('Call to Retrieve_%s does not match previous call to Invoke_%s.',[iMethodName,fMethodName]);
|
|
|
|
if Assigned(fAsyncTransportChannel) then begin
|
|
fResponse := TMemoryStream.Create();
|
|
try
|
|
fAsyncTransportChannel.RetrieveResponse(fMessageID,fResponse);
|
|
except
|
|
FreeAndNil(fResponse);
|
|
raise;
|
|
end;
|
|
end
|
|
else begin
|
|
//fResponse was created by thread.
|
|
if not fAnswerReceived then
|
|
raise EROAsyncNoAnswerYet.CreateFmt('Answer for %s has not been received yet.',[iMethodName]);
|
|
end;
|
|
|
|
Assert(Assigned(fResponse));
|
|
|
|
Result := fResponse;
|
|
fResponse := nil;
|
|
|
|
fBusy := False;
|
|
fAnswerReceived := False;
|
|
fMethodName := '';
|
|
|
|
finally
|
|
fCriticalSection.Leave();
|
|
end;
|
|
end;
|
|
|
|
{ TROAsyncProxyThread }
|
|
|
|
constructor TROAsyncProxyThread.Create(iOwner:TROAsyncProxy; const iName: string; iRequest:TStream; iGetResponse:boolean);
|
|
begin
|
|
inherited Create(True,iName);
|
|
FreeOnTerminate := true;
|
|
fOwner := iOwner;
|
|
fGetResponse := iGetResponse;
|
|
fRequest := iRequest;
|
|
Resume();
|
|
end;
|
|
|
|
destructor TROAsyncProxyThread.Destroy;
|
|
begin
|
|
FreeAndNil(fRequest);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TROAsyncProxyThread.Execute;
|
|
var
|
|
lResponse:TStream;
|
|
begin
|
|
inherited;
|
|
try
|
|
|
|
lResponse := TMemoryStream.Create();
|
|
try
|
|
fOwner.__TransportChannel.Dispatch(fRequest, lResponse);
|
|
|
|
fOwner.fCriticalSection.Enter();
|
|
try
|
|
if fGetResponse then begin
|
|
fOwner.fResponse := lResponse;
|
|
lResponse := nil;
|
|
fOwner.fAnswerReceived := True;
|
|
fOwner.fAnswerReceivedEvent.SetEvent();
|
|
end
|
|
else begin
|
|
fOwner.fBusy := False;
|
|
end;
|
|
finally
|
|
fOwner.fCriticalSection.Leave();
|
|
end;
|
|
|
|
|
|
finally
|
|
FreeAndNil(lResponse);
|
|
end;
|
|
|
|
except
|
|
on E: Exception do begin
|
|
fOwner.fBusy := False;
|
|
//ToDo: marshal exception to main thread.
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end.
|