|
@@ -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;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TFPHTTPClientAsyncPoolWaitForAllThread = class(TFPHTTPClientAsyncPoolCustomWaitForAllThread)
|
|
|
+ private
|
|
|
+ fOnAllDone: TNotifyEvent;
|
|
|
+ protected
|
|
|
+ procedure DoOnAllDone; override;
|
|
|
+ procedure OwnerDestroyed; override;
|
|
|
public
|
|
|
- constructor Create(aPool: TFPCustomHTTPClientAsyncPool; aOnAllDone: TFPHTTPClientPoolSimpleCallback;
|
|
|
- const aSynchronizeOnAllDone: Boolean;
|
|
|
- const aOwner: TComponent; const aTimeoutMS: Integer);
|
|
|
+ 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;
|