mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-13 06:10:43 +02:00
both callback interfaces: classic events and function references
This commit is contained in:
Ondrej Pokorny
Michael Van Canneyt
parent
dab6c48b47
commit
56cb11e3ef
@ -27,14 +27,14 @@ uses
|
||||
type
|
||||
TFPHTTPClientPoolMethodResult = (mrSuccess, mrAbortedByClient, mrAbortedWithException);
|
||||
|
||||
TFPHTTPClientAsyncPoolRequest = class;
|
||||
TFPHTTPClientAbstractAsyncPoolRequest = class;
|
||||
|
||||
TFPHTTPClientPoolResult = class(TPersistent)
|
||||
private
|
||||
fExceptionClass: TClass;
|
||||
fExceptionMessage: string;
|
||||
|
||||
fRequest: TFPHTTPClientAsyncPoolRequest;
|
||||
fRequest: TFPHTTPClientAbstractAsyncPoolRequest;
|
||||
fMethodResult: TFPHTTPClientPoolMethodResult;
|
||||
fResponseHeaders: TStringList;
|
||||
fResponseStatusCode: Integer;
|
||||
@ -51,7 +51,7 @@ type
|
||||
protected
|
||||
procedure AssignTo(Dest: TPersistent); override;
|
||||
public
|
||||
property Request: TFPHTTPClientAsyncPoolRequest read fRequest;
|
||||
property Request: TFPHTTPClientAbstractAsyncPoolRequest read fRequest;
|
||||
property MethodResult: TFPHTTPClientPoolMethodResult read fMethodResult write fMethodResult;
|
||||
property ResponseStatusCode: Integer read fResponseStatusCode write fResponseStatusCode;
|
||||
property ResponseStatusText: string read fResponseStatusText write fResponseStatusText;
|
||||
@ -69,7 +69,7 @@ type
|
||||
property ExceptionClass: TClass read fExceptionClass write fExceptionClass;
|
||||
property ExceptionMessage: string read fExceptionMessage write fExceptionMessage;
|
||||
public
|
||||
constructor Create(const aRequest: TFPHTTPClientAsyncPoolRequest);
|
||||
constructor Create(const aRequest: TFPHTTPClientAbstractAsyncPoolRequest);
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
@ -78,25 +78,26 @@ type
|
||||
TFPHTTPClientPoolProgressDirection = (pdDataSent, pdDataReceived);
|
||||
|
||||
{$IFDEF use_functionreferences}
|
||||
TFPHTTPClientPoolInit = reference to procedure(const aRequest: TFPHTTPClientAsyncPoolRequest; const aClient: TFPHTTPClient);
|
||||
TFPHTTPClientPoolFinish = reference to procedure(const aResult: TFPHTTPClientPoolResult);
|
||||
TFPHTTPClientPoolProgress = reference to procedure(
|
||||
TFPHTTPClientAsyncPoolRequestRef = class;
|
||||
TFPHTTPClientPoolInitRef = reference to procedure(const aRequest: TFPHTTPClientAsyncPoolRequestRef; const aClient: TFPHTTPClient);
|
||||
TFPHTTPClientPoolFinishRef = reference to procedure(const aResult: TFPHTTPClientPoolResult);
|
||||
TFPHTTPClientPoolProgressRef = reference to procedure(
|
||||
Sender: TFPHTTPClientAsyncPoolRequestThread;
|
||||
const aDirection: TFPHTTPClientPoolProgressDirection;
|
||||
const aPosition, aContentLength: Int64; var ioStop: Boolean);
|
||||
TFPHTTPClientPoolSimpleCallback = reference to procedure;
|
||||
{$ELSE}
|
||||
TFPHTTPClientPoolSimpleCallbackRef = reference to procedure;
|
||||
{$ENDIF}
|
||||
TFPHTTPClientAsyncPoolRequest = class;
|
||||
TFPHTTPClientPoolInit = procedure(const aRequest: TFPHTTPClientAsyncPoolRequest; const aClient: TFPHTTPClient) of object;
|
||||
TFPHTTPClientPoolFinish = procedure(const aResult: TFPHTTPClientPoolResult) of object;
|
||||
TFPHTTPClientPoolProgress = procedure(
|
||||
Sender: TFPHTTPClientAsyncPoolRequestThread;
|
||||
const aDirection: TFPHTTPClientPoolProgressDirection;
|
||||
const aPosition, aContentLength: Int64; var ioStop: Boolean) of object;
|
||||
TFPHTTPClientPoolSimpleCallback = procedure of object;
|
||||
{$ENDIF}
|
||||
|
||||
TFPCustomHTTPClientAsyncPool = class;
|
||||
TFPHTTPClientAsyncPoolRequest = class(TPersistent)
|
||||
|
||||
TFPHTTPClientAbstractAsyncPoolRequest = class(TPersistent)
|
||||
public
|
||||
// if Owner gets destroyed, the request will be aborted (=rsAbortedByClient)
|
||||
// especially needed in an LCL application where e.g. the form can get closed while the request is still running
|
||||
@ -114,16 +115,10 @@ type
|
||||
AllowedResponseCodes: array of Integer;
|
||||
|
||||
// EVENTS
|
||||
// setup custom client properties
|
||||
OnInit: TFPHTTPClientPoolInit;
|
||||
// should OnInit be synchronized with the main thread?
|
||||
SynchronizeOnInit: Boolean;
|
||||
// read out the result
|
||||
OnFinish: TFPHTTPClientPoolFinish;
|
||||
// should OnFinish be synchronized with the main thread?
|
||||
SynchronizeOnFinish: Boolean;
|
||||
// progress callback
|
||||
OnProgress: TFPHTTPClientPoolProgress;
|
||||
|
||||
// TIMEOUTS in ms
|
||||
// timeout to find a free client in the pool. Default=0 (infinite)
|
||||
@ -136,6 +131,14 @@ type
|
||||
function GetHost: string;
|
||||
function GetURLDataString: string;
|
||||
procedure SetURLDataString(const aURLDataString: string);
|
||||
|
||||
protected
|
||||
procedure OwnerDestroyed; virtual;
|
||||
|
||||
procedure DoOnInit(const aClient: TFPHTTPClient); virtual; abstract;
|
||||
procedure DoOnFinish(const aResult: TFPHTTPClientPoolResult); virtual; abstract;
|
||||
procedure DoOnProgress(Sender: TFPHTTPClientAsyncPoolRequestThread; const aDirection: TFPHTTPClientPoolProgressDirection;
|
||||
const aPosition, aContentLength: Int64; var ioStop: Boolean); virtual; abstract;
|
||||
public
|
||||
constructor Create;
|
||||
public
|
||||
@ -143,6 +146,44 @@ type
|
||||
property Host: string read GetHost;
|
||||
end;
|
||||
|
||||
TFPHTTPClientAsyncPoolRequest = class(TFPHTTPClientAbstractAsyncPoolRequest)
|
||||
protected
|
||||
procedure OwnerDestroyed; override;
|
||||
|
||||
procedure DoOnInit(const aClient: TFPHTTPClient); override;
|
||||
procedure DoOnFinish(const aResult: TFPHTTPClientPoolResult); override;
|
||||
procedure DoOnProgress(Sender: TFPHTTPClientAsyncPoolRequestThread; const aDirection: TFPHTTPClientPoolProgressDirection;
|
||||
const aPosition, aContentLength: Int64; var ioStop: Boolean); override;
|
||||
public
|
||||
// EVENTS
|
||||
// setup custom client properties
|
||||
OnInit: TFPHTTPClientPoolInit;
|
||||
// read out the result
|
||||
OnFinish: TFPHTTPClientPoolFinish;
|
||||
// progress callback
|
||||
OnProgress: TFPHTTPClientPoolProgress;
|
||||
end;
|
||||
|
||||
{$IFDEF use_functionreferences}
|
||||
TFPHTTPClientAsyncPoolRequestRef = class(TFPHTTPClientAbstractAsyncPoolRequest)
|
||||
protected
|
||||
procedure OwnerDestroyed; override;
|
||||
|
||||
procedure DoOnInit(const aClient: TFPHTTPClient); override;
|
||||
procedure DoOnFinish(const aResult: TFPHTTPClientPoolResult); override;
|
||||
procedure DoOnProgress(Sender: TFPHTTPClientAsyncPoolRequestThread; const aDirection: TFPHTTPClientPoolProgressDirection;
|
||||
const aPosition, aContentLength: Int64; var ioStop: Boolean); override;
|
||||
public
|
||||
// EVENTS
|
||||
// setup custom client properties
|
||||
OnInit: TFPHTTPClientPoolInitRef;
|
||||
// read out the result
|
||||
OnFinish: TFPHTTPClientPoolFinishRef;
|
||||
// progress callback
|
||||
OnProgress: TFPHTTPClientPoolProgressRef;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
TFPHTTPClientAsyncPoolThread = class(TThread)
|
||||
strict private
|
||||
fPool: TFPCustomHTTPClientAsyncPool;
|
||||
@ -164,17 +205,15 @@ type
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
TFPHTTPClientAsyncPoolWaitForAllThread = class(TFPHTTPClientAsyncPoolThread)
|
||||
TFPHTTPClientAsyncPoolCustomWaitForAllThread = class(TFPHTTPClientAsyncPoolThread)
|
||||
private
|
||||
fTimeoutMS: Integer;
|
||||
fOwner: TComponent;
|
||||
fOnAllDone: TFPHTTPClientPoolSimpleCallback;
|
||||
fSynchronizeOnAllDone: Boolean;
|
||||
|
||||
procedure ExecOnAllDone;
|
||||
protected
|
||||
|
||||
procedure DoOnAllDone; virtual;
|
||||
procedure DoOnAllDone; virtual; abstract;
|
||||
|
||||
procedure Execute; override;
|
||||
|
||||
@ -183,15 +222,35 @@ type
|
||||
public
|
||||
// access only through LockProperties
|
||||
function GetOwner: TComponent; override;
|
||||
public
|
||||
constructor Create(aPool: TFPCustomHTTPClientAsyncPool; aOnAllDone: TFPHTTPClientPoolSimpleCallback;
|
||||
const aSynchronizeOnAllDone: Boolean;
|
||||
const aOwner: TComponent; const aTimeoutMS: Integer);
|
||||
end;
|
||||
|
||||
TFPHTTPClientAsyncPoolWaitForAllThread = class(TFPHTTPClientAsyncPoolCustomWaitForAllThread)
|
||||
private
|
||||
fOnAllDone: TNotifyEvent;
|
||||
protected
|
||||
procedure DoOnAllDone; override;
|
||||
procedure OwnerDestroyed; override;
|
||||
public
|
||||
constructor Create(aPool: TFPCustomHTTPClientAsyncPool; aOnAllDone: TNotifyEvent;
|
||||
const aSynchronizeOnAllDone: Boolean; const aOwner: TComponent; const aTimeoutMS: Integer);
|
||||
end;
|
||||
|
||||
{$IFDEF use_functionreferences}
|
||||
TFPHTTPClientAsyncPoolWaitForAllThreadRef = class(TFPHTTPClientAsyncPoolCustomWaitForAllThread)
|
||||
private
|
||||
fOnAllDone: TFPHTTPClientPoolSimpleCallbackRef;
|
||||
protected
|
||||
procedure DoOnAllDone; override;
|
||||
procedure OwnerDestroyed; override;
|
||||
public
|
||||
constructor Create(aPool: TFPCustomHTTPClientAsyncPool; aOnAllDone: TFPHTTPClientPoolSimpleCallbackRef;
|
||||
const aSynchronizeOnAllDone: Boolean; const aOwner: TComponent; const aTimeoutMS: Integer);
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
TFPHTTPClientAsyncPoolRequestThread = class(TFPHTTPClientAsyncPoolThread)
|
||||
private
|
||||
fRequest: TFPHTTPClientAsyncPoolRequest;
|
||||
fRequest: TFPHTTPClientAbstractAsyncPoolRequest;
|
||||
|
||||
fClient: TFPHTTPClient;
|
||||
fResult: TFPHTTPClientPoolResult;
|
||||
@ -229,11 +288,11 @@ type
|
||||
|
||||
public
|
||||
constructor Create(aPool: TFPCustomHTTPClientAsyncPool;
|
||||
aRequest: TFPHTTPClientAsyncPoolRequest; aClient: TFPHTTPClient); virtual;
|
||||
aRequest: TFPHTTPClientAbstractAsyncPoolRequest; aClient: TFPHTTPClient); virtual;
|
||||
destructor Destroy; override;
|
||||
public
|
||||
// access only through LockProperties
|
||||
property Request: TFPHTTPClientAsyncPoolRequest read fRequest;
|
||||
property Request: TFPHTTPClientAbstractAsyncPoolRequest read fRequest;
|
||||
function GetOwner: TComponent; override;
|
||||
end;
|
||||
|
||||
@ -242,7 +301,7 @@ type
|
||||
Pool: TFPCustomHTTPClientAsyncPool;
|
||||
Clients: TFPCustomHTTPClients;
|
||||
BreakUTC: TDateTime;
|
||||
Request: TFPHTTPClientAsyncPoolRequest;
|
||||
Request: TFPHTTPClientAbstractAsyncPoolRequest;
|
||||
public
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
@ -264,28 +323,32 @@ type
|
||||
|
||||
private
|
||||
fDoOnAbortedFinishSynchronizedCS: TCriticalSection;
|
||||
fDoOnAbortedFinishSynchronizedRequest: TFPHTTPClientAsyncPoolRequest;
|
||||
procedure ExecOnAbortedFinish(var ioRequest: TFPHTTPClientAsyncPoolRequest);
|
||||
fDoOnAbortedFinishSynchronizedRequest: TFPHTTPClientAbstractAsyncPoolRequest;
|
||||
procedure ExecOnAbortedFinish(var ioRequest: TFPHTTPClientAbstractAsyncPoolRequest);
|
||||
procedure DoOnAbortedFinishSynchronized;
|
||||
protected
|
||||
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
||||
|
||||
function CreatePool: TFPCustomHTTPClientPool; virtual;
|
||||
function CreateRequestThread(aRequest: TFPHTTPClientAsyncPoolRequest; aClient: TFPHTTPClient): TFPHTTPClientAsyncPoolRequestThread; virtual;
|
||||
function CreateWaitForAllRequestsThread(const aOnAllDone: TFPHTTPClientPoolSimpleCallback; const aSynchronizeOnAllDone: Boolean;
|
||||
const aOwner: TComponent; const aTimeoutMS: Integer): TFPHTTPClientAsyncPoolWaitForAllThread; virtual;
|
||||
function CreateRequestThread(aRequest: TFPHTTPClientAbstractAsyncPoolRequest; aClient: TFPHTTPClient): TFPHTTPClientAsyncPoolRequestThread; virtual;
|
||||
function CreateWaitForAllRequestsThread(const aOnAllDone: TNotifyEvent;
|
||||
const aSynchronizeOnAllDone: Boolean; const aOwner: TComponent; const aTimeoutMS: Integer): TFPHTTPClientAsyncPoolCustomWaitForAllThread; virtual;
|
||||
{$IFDEF use_functionreferences}
|
||||
function CreateWaitForAllRequestsThreadRef(const aOnAllDoneRef: TFPHTTPClientPoolSimpleCallbackRef;
|
||||
const aSynchronizeOnAllDone: Boolean; const aOwner: TComponent; const aTimeoutMS: Integer): TFPHTTPClientAsyncPoolCustomWaitForAllThread; virtual;
|
||||
{$ENDIF}
|
||||
procedure WaitForThreadsToFinish; virtual;
|
||||
|
||||
// support for MaxClientsPerServer (add requests that wait for a client to a queue)
|
||||
procedure AddToQueue(const aClients: TFPCustomHTTPClients; const aBreakUTC: TDateTime; const aRequest: TFPHTTPClientAsyncPoolRequest);
|
||||
procedure AddToQueue(const aClients: TFPCustomHTTPClients; const aBreakUTC: TDateTime; const aRequest: TFPHTTPClientAbstractAsyncPoolRequest);
|
||||
procedure ReleaseClient(const aURL: string; const aClient: TFPHTTPClient);
|
||||
procedure DoOnAbortedFinish(var ioRequest: TFPHTTPClientAsyncPoolRequest); virtual;
|
||||
procedure DoOnAbortedFinish(var ioRequest: TFPHTTPClientAbstractAsyncPoolRequest);
|
||||
|
||||
procedure LockWorkingThreads(out outWorkingThreads, outWaitingQueue: TList);
|
||||
procedure UnlockWorkingThreads;
|
||||
public
|
||||
// send an asynchronous HTTP request
|
||||
procedure AsyncMethod(aRequest: TFPHTTPClientAsyncPoolRequest); overload;
|
||||
procedure AsyncMethod(aRequest: TFPHTTPClientAbstractAsyncPoolRequest); overload;
|
||||
|
||||
// stop all requests with Blocker
|
||||
procedure StopRequests(const aBlocker: TObject);
|
||||
@ -297,8 +360,12 @@ type
|
||||
|
||||
// wait until all requests are finished
|
||||
// all new requests will be blocked in between
|
||||
procedure WaitForAllRequests(const aOnAllDone: TFPHTTPClientPoolSimpleCallback; const aSynchronizeOnAllDone: Boolean;
|
||||
procedure WaitForAllRequests(const aOnAllDone: TNotifyEvent; const aSynchronizeOnAllDone: Boolean;
|
||||
const aOwner: TComponent; const aTimeoutMS: Integer);
|
||||
{$IFDEF use_functionreferences}
|
||||
procedure WaitForAllRequests(const aOnAllDoneRef: TFPHTTPClientPoolSimpleCallbackRef; const aSynchronizeOnAllDone: Boolean;
|
||||
const aOwner: TComponent; const aTimeoutMS: Integer);
|
||||
{$ENDIF}
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
@ -312,13 +379,71 @@ type
|
||||
|
||||
implementation
|
||||
|
||||
{$IFDEF use_functionreferences}
|
||||
{ TFPHTTPClientAsyncPoolRequestRef }
|
||||
|
||||
procedure TFPHTTPClientAsyncPoolRequestRef.DoOnFinish(const aResult: TFPHTTPClientPoolResult);
|
||||
begin
|
||||
if Assigned(OnFinish) then
|
||||
OnFinish(aResult);
|
||||
end;
|
||||
|
||||
procedure TFPHTTPClientAsyncPoolRequestRef.DoOnInit(const aClient: TFPHTTPClient);
|
||||
begin
|
||||
if Assigned(OnInit) then
|
||||
OnInit(Self, aClient);
|
||||
end;
|
||||
|
||||
procedure TFPHTTPClientAsyncPoolRequestRef.DoOnProgress(Sender: TFPHTTPClientAsyncPoolRequestThread;
|
||||
const aDirection: TFPHTTPClientPoolProgressDirection; const aPosition, aContentLength: Int64; var ioStop: Boolean);
|
||||
begin
|
||||
if Assigned(OnProgress) then
|
||||
OnProgress(Sender, aDirection, aPosition, aContentLength, ioStop);
|
||||
end;
|
||||
|
||||
procedure TFPHTTPClientAsyncPoolRequestRef.OwnerDestroyed;
|
||||
begin
|
||||
OnInit := nil;
|
||||
OnFinish := nil;
|
||||
OnProgress := nil;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{ TFPHTTPClientAsyncPoolRequest }
|
||||
|
||||
procedure TFPHTTPClientAsyncPoolRequest.DoOnFinish(const aResult: TFPHTTPClientPoolResult);
|
||||
begin
|
||||
if Assigned(OnFinish) then
|
||||
OnFinish(aResult);
|
||||
end;
|
||||
|
||||
procedure TFPHTTPClientAsyncPoolRequest.DoOnInit(const aClient: TFPHTTPClient);
|
||||
begin
|
||||
if Assigned(OnInit) then
|
||||
OnInit(Self, aClient);
|
||||
end;
|
||||
|
||||
procedure TFPHTTPClientAsyncPoolRequest.DoOnProgress(Sender: TFPHTTPClientAsyncPoolRequestThread;
|
||||
const aDirection: TFPHTTPClientPoolProgressDirection; const aPosition, aContentLength: Int64; var ioStop: Boolean);
|
||||
begin
|
||||
if Assigned(OnProgress) then
|
||||
OnProgress(Sender, aDirection, aPosition, aContentLength, ioStop);
|
||||
end;
|
||||
|
||||
procedure TFPHTTPClientAsyncPoolRequest.OwnerDestroyed;
|
||||
begin
|
||||
OnInit := nil;
|
||||
OnFinish := nil;
|
||||
OnProgress := nil;
|
||||
end;
|
||||
|
||||
{ TFPHTTPClientAsyncPoolRequestQueueItem }
|
||||
|
||||
destructor TFPHTTPClientAsyncPoolRequestQueueItem.Destroy;
|
||||
begin
|
||||
if Assigned(Request) then
|
||||
begin
|
||||
Pool.DoOnAbortedFinish(Request);
|
||||
Pool.DoOnAbortedFinish(TFPHTTPClientAbstractAsyncPoolRequest(Request));
|
||||
Request.Free;
|
||||
end;
|
||||
inherited Destroy;
|
||||
@ -327,7 +452,7 @@ end;
|
||||
{ TFPHTTPClientAsyncPoolWaitForAllThread }
|
||||
|
||||
constructor TFPHTTPClientAsyncPoolWaitForAllThread.Create(aPool: TFPCustomHTTPClientAsyncPool;
|
||||
aOnAllDone: TFPHTTPClientPoolSimpleCallback; const aSynchronizeOnAllDone: Boolean; const aOwner: TComponent; const aTimeoutMS: Integer);
|
||||
aOnAllDone: TNotifyEvent; const aSynchronizeOnAllDone: Boolean; const aOwner: TComponent; const aTimeoutMS: Integer);
|
||||
begin
|
||||
fOnAllDone := aOnAllDone;
|
||||
fSynchronizeOnAllDone := aSynchronizeOnAllDone;
|
||||
@ -338,23 +463,56 @@ begin
|
||||
end;
|
||||
|
||||
procedure TFPHTTPClientAsyncPoolWaitForAllThread.DoOnAllDone;
|
||||
begin
|
||||
if Assigned(fOnAllDone) then
|
||||
fOnAllDone(Self);
|
||||
end;
|
||||
|
||||
procedure TFPHTTPClientAsyncPoolWaitForAllThread.OwnerDestroyed;
|
||||
begin
|
||||
fOnAllDone := nil;
|
||||
inherited OwnerDestroyed;
|
||||
end;
|
||||
|
||||
{$IFDEF use_functionreferences}
|
||||
{ TFPHTTPClientAsyncPoolWaitForAllThreadRef }
|
||||
|
||||
constructor TFPHTTPClientAsyncPoolWaitForAllThreadRef.Create(aPool: TFPCustomHTTPClientAsyncPool;
|
||||
aOnAllDone: TFPHTTPClientPoolSimpleCallbackRef; const aSynchronizeOnAllDone: Boolean; const aOwner: TComponent;
|
||||
const aTimeoutMS: Integer);
|
||||
begin
|
||||
fOnAllDone := aOnAllDone;
|
||||
fSynchronizeOnAllDone := aSynchronizeOnAllDone;
|
||||
fTimeoutMS := aTimeoutMS;
|
||||
fOwner := aOwner;
|
||||
|
||||
inherited Create(aPool);
|
||||
end;
|
||||
|
||||
procedure TFPHTTPClientAsyncPoolWaitForAllThreadRef.DoOnAllDone;
|
||||
begin
|
||||
if Assigned(fOnAllDone) then
|
||||
fOnAllDone();
|
||||
end;
|
||||
|
||||
procedure TFPHTTPClientAsyncPoolWaitForAllThread.ExecOnAllDone;
|
||||
procedure TFPHTTPClientAsyncPoolWaitForAllThreadRef.OwnerDestroyed;
|
||||
begin
|
||||
if not Assigned(fOnAllDone) then
|
||||
Exit;
|
||||
fOnAllDone := nil;
|
||||
inherited OwnerDestroyed;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{ TFPHTTPClientAsyncPoolCustomWaitForAllThread }
|
||||
|
||||
procedure TFPHTTPClientAsyncPoolCustomWaitForAllThread.ExecOnAllDone;
|
||||
begin
|
||||
if fSynchronizeOnAllDone then
|
||||
Synchronize(@DoOnAllDone)
|
||||
else
|
||||
DoOnAllDone;
|
||||
end;
|
||||
|
||||
procedure TFPHTTPClientAsyncPoolWaitForAllThread.Execute;
|
||||
procedure TFPHTTPClientAsyncPoolCustomWaitForAllThread.Execute;
|
||||
var
|
||||
xBreak: TDateTime;
|
||||
begin
|
||||
@ -374,17 +532,15 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFPHTTPClientAsyncPoolWaitForAllThread.GetOwner: TComponent;
|
||||
function TFPHTTPClientAsyncPoolCustomWaitForAllThread.GetOwner: TComponent;
|
||||
begin
|
||||
Result := fOwner;
|
||||
end;
|
||||
|
||||
procedure TFPHTTPClientAsyncPoolWaitForAllThread.OwnerDestroyed;
|
||||
procedure TFPHTTPClientAsyncPoolCustomWaitForAllThread.OwnerDestroyed;
|
||||
begin
|
||||
inherited OwnerDestroyed;
|
||||
|
||||
fOwner := nil;
|
||||
fOnAllDone := nil;
|
||||
inherited OwnerDestroyed;
|
||||
end;
|
||||
|
||||
{ TFPHTTPClientAsyncPoolThread }
|
||||
@ -421,16 +577,16 @@ begin
|
||||
fCSProperties.Leave;
|
||||
end;
|
||||
|
||||
{ TFPHTTPClientAsyncPoolRequest }
|
||||
{ TFPHTTPClientAbstractAsyncPoolRequest }
|
||||
|
||||
constructor TFPHTTPClientAsyncPoolRequest.Create;
|
||||
constructor TFPHTTPClientAbstractAsyncPoolRequest.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
ConnectTimeout := 3000;
|
||||
end;
|
||||
|
||||
function TFPHTTPClientAsyncPoolRequest.GetHost: string;
|
||||
function TFPHTTPClientAbstractAsyncPoolRequest.GetHost: string;
|
||||
var
|
||||
xURI: TURI;
|
||||
begin
|
||||
@ -438,19 +594,24 @@ begin
|
||||
Result := xURI.Host;
|
||||
end;
|
||||
|
||||
function TFPHTTPClientAsyncPoolRequest.GetURLDataString: string;
|
||||
function TFPHTTPClientAbstractAsyncPoolRequest.GetURLDataString: string;
|
||||
begin
|
||||
Result := TEncoding.SystemEncoding.GetAnsiString(URLData);
|
||||
end;
|
||||
|
||||
procedure TFPHTTPClientAsyncPoolRequest.SetURLDataString(const aURLDataString: string);
|
||||
procedure TFPHTTPClientAbstractAsyncPoolRequest.OwnerDestroyed;
|
||||
begin
|
||||
Owner := nil;
|
||||
end;
|
||||
|
||||
procedure TFPHTTPClientAbstractAsyncPoolRequest.SetURLDataString(const aURLDataString: string);
|
||||
begin
|
||||
URLData := TEncoding.SystemEncoding.GetAnsiBytes(aURLDataString);
|
||||
end;
|
||||
|
||||
{ TFPHTTPClientPoolResult }
|
||||
|
||||
constructor TFPHTTPClientPoolResult.Create(const aRequest: TFPHTTPClientAsyncPoolRequest);
|
||||
constructor TFPHTTPClientPoolResult.Create(const aRequest: TFPHTTPClientAbstractAsyncPoolRequest);
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
@ -567,7 +728,7 @@ end;
|
||||
|
||||
{ TFPCustomHTTPClientAsyncPool }
|
||||
|
||||
procedure TFPCustomHTTPClientAsyncPool.AsyncMethod(aRequest: TFPHTTPClientAsyncPoolRequest);
|
||||
procedure TFPCustomHTTPClientAsyncPool.AsyncMethod(aRequest: TFPHTTPClientAbstractAsyncPoolRequest);
|
||||
var
|
||||
xClients: TFPCustomHTTPClients;
|
||||
xBreakUTC: TDateTime;
|
||||
@ -620,15 +781,24 @@ begin
|
||||
Result := TFPCustomHTTPClientPool.Create(Self);
|
||||
end;
|
||||
|
||||
function TFPCustomHTTPClientAsyncPool.CreateRequestThread(aRequest: TFPHTTPClientAsyncPoolRequest;
|
||||
function TFPCustomHTTPClientAsyncPool.CreateRequestThread(aRequest: TFPHTTPClientAbstractAsyncPoolRequest;
|
||||
aClient: TFPHTTPClient): TFPHTTPClientAsyncPoolRequestThread;
|
||||
begin
|
||||
Result := TFPHTTPClientAsyncPoolRequestThread.Create(Self, aRequest, aClient);
|
||||
end;
|
||||
|
||||
function TFPCustomHTTPClientAsyncPool.CreateWaitForAllRequestsThread(const aOnAllDone: TFPHTTPClientPoolSimpleCallback;
|
||||
{$IFDEF use_functionreferences}
|
||||
function TFPCustomHTTPClientAsyncPool.CreateWaitForAllRequestsThreadRef(
|
||||
const aOnAllDoneRef: TFPHTTPClientPoolSimpleCallbackRef; const aSynchronizeOnAllDone: Boolean;
|
||||
const aOwner: TComponent; const aTimeoutMS: Integer): TFPHTTPClientAsyncPoolCustomWaitForAllThread;
|
||||
begin
|
||||
Result := TFPHTTPClientAsyncPoolWaitForAllThreadRef.Create(Self, aOnAllDoneRef, aSynchronizeOnAllDone, aOwner, aTimeoutMS);
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
function TFPCustomHTTPClientAsyncPool.CreateWaitForAllRequestsThread(const aOnAllDone: TNotifyEvent;
|
||||
const aSynchronizeOnAllDone: Boolean; const aOwner: TComponent;
|
||||
const aTimeoutMS: Integer): TFPHTTPClientAsyncPoolWaitForAllThread;
|
||||
const aTimeoutMS: Integer): TFPHTTPClientAsyncPoolCustomWaitForAllThread;
|
||||
begin
|
||||
Result := TFPHTTPClientAsyncPoolWaitForAllThread.Create(Self, aOnAllDone, aSynchronizeOnAllDone, aOwner, aTimeoutMS);
|
||||
end;
|
||||
@ -644,7 +814,7 @@ begin
|
||||
end;
|
||||
|
||||
procedure TFPCustomHTTPClientAsyncPool.AddToQueue(const aClients: TFPCustomHTTPClients; const aBreakUTC: TDateTime;
|
||||
const aRequest: TFPHTTPClientAsyncPoolRequest);
|
||||
const aRequest: TFPHTTPClientAbstractAsyncPoolRequest);
|
||||
var
|
||||
xNewItem: TFPHTTPClientAsyncPoolRequestQueueItem;
|
||||
xThreads, xQueue: TList;
|
||||
@ -667,7 +837,7 @@ var
|
||||
xURI: TURI;
|
||||
xClients: TFPCustomHTTPClients;
|
||||
xItem: TFPHTTPClientAsyncPoolRequestQueueItem;
|
||||
xRequest: TFPHTTPClientAsyncPoolRequest;
|
||||
xRequest: TFPHTTPClientAbstractAsyncPoolRequest;
|
||||
I: Integer;
|
||||
xThreads, xQueue: TList;
|
||||
begin
|
||||
@ -745,24 +915,17 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TFPCustomHTTPClientAsyncPool.DoOnAbortedFinish(var ioRequest: TFPHTTPClientAsyncPoolRequest);
|
||||
procedure TFPCustomHTTPClientAsyncPool.DoOnAbortedFinish(var ioRequest: TFPHTTPClientAbstractAsyncPoolRequest);
|
||||
var
|
||||
xResult: TFPHTTPClientPoolResult;
|
||||
begin
|
||||
if Assigned(ioRequest.OnFinish) then
|
||||
begin
|
||||
xResult := TFPHTTPClientPoolResult.Create(ioRequest);
|
||||
try
|
||||
xResult.MethodResult := mrAbortedByClient;
|
||||
ioRequest.OnFinish(xResult);
|
||||
ioRequest := nil; // ioRequest gets destroyed in xResult.Free
|
||||
finally
|
||||
xResult.Free;
|
||||
end;
|
||||
end else
|
||||
begin
|
||||
ioRequest.Free;
|
||||
ioRequest := nil;
|
||||
xResult := TFPHTTPClientPoolResult.Create(ioRequest);
|
||||
try
|
||||
xResult.MethodResult := mrAbortedByClient;
|
||||
ioRequest.DoOnFinish(xResult);
|
||||
ioRequest := nil; // ioRequest gets destroyed in xResult.Free
|
||||
finally
|
||||
xResult.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -771,7 +934,7 @@ begin
|
||||
DoOnAbortedFinish(fDoOnAbortedFinishSynchronizedRequest);
|
||||
end;
|
||||
|
||||
procedure TFPCustomHTTPClientAsyncPool.ExecOnAbortedFinish(var ioRequest: TFPHTTPClientAsyncPoolRequest);
|
||||
procedure TFPCustomHTTPClientAsyncPool.ExecOnAbortedFinish(var ioRequest: TFPHTTPClientAbstractAsyncPoolRequest);
|
||||
begin
|
||||
// always synchronize - even if OnFinish is nil, so that ioRequest gets destroyed in the main thread
|
||||
// if somebody had the idea to do something with the LCL in a custom request destructor
|
||||
@ -924,13 +1087,35 @@ begin
|
||||
fWorkingThreads.UnlockList;
|
||||
end;
|
||||
|
||||
procedure TFPCustomHTTPClientAsyncPool.WaitForAllRequests(const aOnAllDone: TFPHTTPClientPoolSimpleCallback;
|
||||
{$IFDEF use_functionreferences}
|
||||
procedure TFPCustomHTTPClientAsyncPool.WaitForAllRequests(const aOnAllDoneRef: TFPHTTPClientPoolSimpleCallbackRef;
|
||||
const aSynchronizeOnAllDone: Boolean; const aOwner: TComponent; const aTimeoutMS: Integer);
|
||||
begin
|
||||
if ActiveAsyncMethodCount=0 then
|
||||
begin
|
||||
if Assigned(aOnAllDoneRef) then
|
||||
aOnAllDoneRef();
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if Assigned(aOwner) then
|
||||
begin
|
||||
FreeNotification(aOwner);
|
||||
// We do not remove the notification with RemoveFreeNotification().
|
||||
// It would be unsafe if more requests are sent with the same owner.
|
||||
// That is fine - it will be removed automatically when the owner is destroyed.
|
||||
end;
|
||||
CreateWaitForAllRequestsThreadRef(aOnAllDoneRef, aSynchronizeOnAllDone, aOwner, aTimeoutMS);
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
procedure TFPCustomHTTPClientAsyncPool.WaitForAllRequests(const aOnAllDone: TNotifyEvent;
|
||||
const aSynchronizeOnAllDone: Boolean; const aOwner: TComponent; const aTimeoutMS: Integer);
|
||||
begin
|
||||
if ActiveAsyncMethodCount=0 then
|
||||
begin
|
||||
if Assigned(aOnAllDone) then
|
||||
aOnAllDone();
|
||||
aOnAllDone(Self);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
@ -952,7 +1137,7 @@ end;
|
||||
{ TFPHTTPClientAsyncPoolRequestThread }
|
||||
|
||||
constructor TFPHTTPClientAsyncPoolRequestThread.Create(aPool: TFPCustomHTTPClientAsyncPool;
|
||||
aRequest: TFPHTTPClientAsyncPoolRequest; aClient: TFPHTTPClient);
|
||||
aRequest: TFPHTTPClientAbstractAsyncPoolRequest; aClient: TFPHTTPClient);
|
||||
begin
|
||||
fRequest := aRequest;
|
||||
fResult := TFPHTTPClientPoolResult.Create(fRequest);
|
||||
@ -990,8 +1175,7 @@ begin
|
||||
LockProperties;
|
||||
try
|
||||
xStop := False;
|
||||
if Assigned(Request.OnProgress) then
|
||||
ExecOnProgress(aDirection, aCurrentPos, aContentLength, xStop);
|
||||
ExecOnProgress(aDirection, aCurrentPos, aContentLength, xStop);
|
||||
|
||||
if xStop or Terminated then
|
||||
(Sender as TFPCustomHTTPClient).Terminate;
|
||||
@ -1009,18 +1193,14 @@ procedure TFPHTTPClientAsyncPoolRequestThread.OwnerDestroyed;
|
||||
begin
|
||||
inherited;
|
||||
|
||||
fRequest.Owner := nil;
|
||||
fRequest.OnFinish := nil;
|
||||
fRequest.OnProgress := nil;
|
||||
fRequest.OnInit := nil;
|
||||
fRequest.OwnerDestroyed;
|
||||
end;
|
||||
|
||||
procedure TFPHTTPClientAsyncPoolRequestThread.DoOnInit;
|
||||
begin
|
||||
LockProperties;
|
||||
try
|
||||
if Assigned(Request.OnInit) then
|
||||
Request.OnInit(Request, fClient);
|
||||
Request.DoOnInit(fClient);
|
||||
finally
|
||||
UnlockProperties;
|
||||
end;
|
||||
@ -1031,8 +1211,7 @@ procedure TFPHTTPClientAsyncPoolRequestThread.DoOnProgress(const aDirection: TFP
|
||||
begin
|
||||
LockProperties;
|
||||
try
|
||||
if Assigned(Request.OnProgress) then
|
||||
Request.OnProgress(Self, aDirection, aCurrentPos, aContentLength, ioStop);
|
||||
Request.DoOnProgress(Self, aDirection, aCurrentPos, aContentLength, ioStop);
|
||||
finally
|
||||
UnlockProperties;
|
||||
end;
|
||||
@ -1133,8 +1312,7 @@ procedure TFPHTTPClientAsyncPoolRequestThread.DoOnFinish;
|
||||
begin
|
||||
LockProperties;
|
||||
try
|
||||
if Assigned(Request.OnFinish) then
|
||||
Request.OnFinish(fResult);
|
||||
Request.DoOnFinish(fResult);
|
||||
// always destroy fResult so that the Request's destructor is synchronised if DoOnFinish is synchronised
|
||||
fResult.Free;
|
||||
fResult := nil;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user