Added OnSendData callback in TMVCRESTClient

danieleteti · Apr 23, 2024 · 2a7a840 · 2a7a840
1 parent d7bbd34
commit 2a7a840
Show file tree

Hide file tree

Showing 2 changed files with 32 additions and 2 deletions.
diff --git a/sources/MVCFramework.RESTClient.Intf.pas b/sources/MVCFramework.RESTClient.Intf.pas
@@ -1,4 +1,4 @@
-// ***************************************************************************
+// ***************************************************************************
 //
 // Delphi MVC Framework
 //
@@ -53,6 +53,7 @@ interface
   TBeforeRequestProc = reference to procedure (aRequest: IHTTPRequest);
   TRequestCompletedProc = reference to procedure (aResponse: IHTTPResponse; var aHandled: Boolean);
   TResponseCompletedProc = reference to procedure(aResponse: IMVCRESTResponse);
+  TSendDataProc = reference to procedure(AContentLength, AWriteCount: Int64; var AAbort: Boolean);
 
   IMVCRESTClient = interface
     ['{592BC90F-B825-4B3B-84A7-6CA3927BAD69}']
@@ -103,6 +104,11 @@ interface
     /// </summary>
     function SetResponseCompletedProc(aResponseCompletedProc: TResponseCompletedProc): IMVCRESTClient;
 
+    /// <summary>
+    /// Executes while sending data
+    /// </summary>
+    function SetSendDataProc(aSendDataProc: TSendDataProc): IMVCRESTClient;
+
     ///<summary>
     /// Set the client certificate for the request</summary>
     /// </summary>

diff --git a/sources/MVCFramework.RESTClient.pas b/sources/MVCFramework.RESTClient.pas
@@ -1,4 +1,4 @@
-// ***************************************************************************
+// ***************************************************************************
 //
 // Delphi MVC Framework
 //
@@ -99,6 +99,7 @@   TMVCRESTClient = class(TInterfacedObject, IMVCRESTClient)
     fBeforeRequestProc: TBeforeRequestProc;
     fRequestCompletedProc: TRequestCompletedProc;
     fResponseCompletedProc: TResponseCompletedProc;
+    fSendDataProc: TSendDataProc;
     [Weak] fClientCertificate: TStream;
     fClientCertPassword: string;
     fClientCertPath: string;
@@ -109,6 +110,7 @@   TMVCRESTClient = class(TInterfacedObject, IMVCRESTClient)
     procedure DoBeforeRequest(aRequest: IHTTPRequest);
     procedure DoRequestCompleted(aResponse: IHTTPResponse; var aHandled: Boolean);
     procedure DoResponseCompleted(aMVCRESTResponse: IMVCRESTResponse);
+    procedure DoOnSendDataEvent(const Sender: TObject; AContentLength, AWriteCount: Int64; var AAbort: Boolean);
     function GetBodyFormData: TMultipartFormData;
     function ObjectIsList(aObject: TObject): Boolean;
     function SerializeObject(aObject: TObject): string;
@@ -185,6 +187,11 @@   TMVCRESTClient = class(TInterfacedObject, IMVCRESTClient)
     /// </summary>
     function SetResponseCompletedProc(aResponseCompletedProc: TResponseCompletedProc): IMVCRESTClient;
 
+    /// <summary>
+    /// Executes while sending data
+    /// </summary>
+    function SetSendDataProc(aSendDataProc: TSendDataProc): IMVCRESTClient;
+
     ///<summary>
     /// Set the client certificate for the request</summary>
     /// </summary>
@@ -951,6 +958,7 @@ constructor TMVCRESTClient.Create;
   fHTTPClient.OnValidateServerCertificate := DoValidateServerCertificate;
   fHTTPClient.HandleRedirects := True;
   fHTTPClient.MaxRedirects := TMVCRESTClientConsts.DEFAULT_MAX_REDIRECTS;
+  fHTTPClient.OnSendData := DoOnSendDataEvent;
 {$IF defined(TOKYOORBETTER)}
   fHTTPClient.SecureProtocols := CHTTPDefSecureProtocols;
 {$ENDIF}
@@ -959,6 +967,7 @@ constructor TMVCRESTClient.Create;
   fBeforeRequestProc := nil;
   fRequestCompletedProc := nil;
   fResponseCompletedProc := nil;
+  fSendDataProc := nil;
   fParameters := TList<TMVCRESTParam>.Create;
   fRawBody := TMemoryStream.Create;
   fBodyFormData := nil;
@@ -1511,6 +1520,15 @@ function TMVCRESTClient.ObjectIsList(aObject: TObject): Boolean;
   Result := fRttiContext.GetType(aObject.ClassType).GetMethod('GetEnumerator') <> nil;
 end;
 
+procedure TMVCRESTClient.DoOnSendDataEvent(const Sender: TObject; AContentLength,
+  AWriteCount: Int64; var AAbort: Boolean);
+begin
+  if Assigned(fSendDataProc) then
+  begin
+    fSendDataProc(AContentLength, AWriteCount, AAbort);
+  end;
+end;
+
 function TMVCRESTClient.Options: IMVCRESTResponse;
 begin
   Result := ExecuteRequest(TMVCHTTPMethodType.httpOPTIONS);
@@ -1878,6 +1896,12 @@ function TMVCRESTClient.SetResponseCompletedProc(aResponseCompletedProc: TRespon
   fResponseCompletedProc := aResponseCompletedProc;
 end;
 
+function TMVCRESTClient.SetSendDataProc(
+  aSendDataProc: TSendDataProc): IMVCRESTClient;
+begin
+  fSendDataProc := aSendDataProc;
+end;
+
 function TMVCRESTClient.SetValidateServerCertificateProc(
   aValidateCertificateProc: TValidateServerCertificateProc): IMVCRESTClient;
 begin