Jump to content
pavlos

Httpclient asynchronous callback and Httpclient.endAsyncHttp

Recommended Posts

Hi everyone,

 

I am new to Delphi and object pascal in general but I am coming from a web application background with Javascript.

At work i want to implement a small unit that i will be using for any interactions with resources over the network

I decided to go for HttpClient.

 

One of the tasks i had to do first was find out how i can perform requests asynchronously.

 

Due to the fact of docwiki.Embacardero has been down for 2 weeks now i scraped the web and had a look at the unit files in

System.Net.HttpClient, System.Classes and System.types .

 

I found two nice stackoverflow articles that help me give some direction:

https://stackoverflow.com/questions/69298844/how-to-use-asynchronous-tnethttpclient

https://stackoverflow.com/questions/54846698/delphi-fmx-httpclient-asynchronous-post-works-in-windows-fails-in-android

 

Finally  I managed to asynchronously make a get request

uses 
   System.Net.HttpClient, System.Net.URLCLient, 
   System.Classes, System.Types;

types
   asyncResponse = System.Types.IAsyncResult;

var
   client: System.Net.HttpClient.THttpClient;
   asyncCallback: System.Classes.TAsyncCallback;

begin
client := THttpClient.Create;

asyncCallback := procedure(const response: asyncResponse) begin
                 // do something with response
                 writeln(response.contentAsString);
                 end;

client.BeginGet(asyncCallback, 'path/to/resource');
end.

 

However the second stackoverflow article above uses another approach:

 

 HTTPResult:= HTTPClient.BeginPost(DoEndPost,edtURL.Text,Params);

procedure TMainForm.DoEndPost(const AsyncResult: IAsyncResult);
begin
  try
    HTTPResponse := THTTPClient.EndAsyncHTTP(AsyncResult);
    TThread.Synchronize(nil,
      procedure
      begin
          // handle result
         lblStatusCode.Text := HTTPResponse.StatusCode.ToString;
         mmoResult.Text     := HTTPResponse.ContentAsString(TEncoding.UTF8);
      end);
  finally
  end;
end;

 

So on the above code snippet there are 2 things that make me wonder if I am not doing something right.

( I would have looked for suggestions in docwiki but unfortunately i cant)

 

Now  i know that he is using method pointer callbacks and not anonymous functions so that might be the difference.

The lines that bother me are:

 

HTTPResponse := THTTPClient.EndAsyncHTTP(AsyncResult);

 

Should i be also invoking this method within my callback?

 

And the second thing that is bothering me is the fact that he is using threads.

Should i also be synchronizing threads?

 

For anyone who has made it this far, Thank you very much for taking the time.

 

Sincerely,

Pavlos

 

 

Share this post


Link to post

I was struggling with this also and managed to achieve this code that seems to work well:

 

procedure TUExtractForm.LoadURLAsync(const AURL: string);
const
   CONST_TIMEOUT = 100000;
var
  HTTPClient: TNetHTTPClient;
  HTTPRequest: TNetHTTPRequest;
begin
  HTTPClient := TNetHTTPClient.Create(nil);
  try
    HTTPClient.ConnectionTimeout := CONST_TIMEOUT; // 5 second timeout
    HTTPClient.ResponseTimeout := CONST_TIMEOUT; // 5 second timeout
    HTTPRequest := TNetHTTPRequest.Create(HTTPClient);
    HTTPRequest.Client := HTTPClient;
    HTTPRequest.OnRequestCompleted := HTTPRequestCompleted;
    HTTPRequest.OnRequestError := HTTPRequestError;

    TTask.Run(
      procedure
      var
        StartTime: TDateTime;
        WaitResult: Integer;
        RequestCompleted: Boolean;
      begin
        RequestCompleted := False;
        try
          StartTime := Now;
          TThread.CreateAnonymousThread(
            procedure
            begin
              try
                HTTPRequest.Get(AURL);
              finally
                RequestCompleted := True;
              end;
            end).Start;

          while not RequestCompleted do
          begin
            WaitResult := MillisecondsBetween(Now, StartTime);
            if WaitResult > CONST_TIMEOUT then // 5 second timeout
            begin
              TThread.Queue(nil, procedure
                begin
                  ShowMessage('HTTP request timed out');
                end);
              HTTPRequest.Cancel;
              Break;
            end;

            TThread.Sleep(100);
          end;
        except
          on E: Exception do
          begin
            TThread.Queue(nil, procedure
              begin
                ShowMessageFmt('Error: %s', [E.Message]);
              end);
          end;
        end;
      end);
  except
    on E: Exception do
    begin
      ShowMessageFmt('Error: %s', [E.Message]);
      HTTPClient.Free;
    end;
  end;
end;

 

procedure TUExtractForm.HTTPRequestCompleted(const Sender: TObject; const AResponse: IHTTPResponse);
var
  Content: string;
begin
  if AResponse.StatusCode = 200 then
  begin
    Content := AResponse.ContentAsString;
    TThread.Queue(nil, procedure begin
      URLMemo.Text := Content;
    end);
  end;
  TNetHTTPRequest(Sender).Client.Free;
end;

procedure TUExtractForm.HTTPRequestError(const Sender: TObject; const AError: string);
begin
  TThread.Queue(nil, procedure begin
    ShowMessageFmt('Error: %s', [AError]);
  end);
  TNetHTTPRequest(Sender).Client.Free;
end;

 

 

I hope this helps someone.

Now I am struggling to find a solution that works with POST, which is even more complicated...

Share this post


Link to post

If you want to use asynchronous mode for HTTP requests you should use TNetHTTPClient instead of THTTPClient. TNetHTTPClient is a wrapper that implements all the gory details in the background and leaves easy to use API for the developer.  https://docwiki.embarcadero.com/Libraries/Sydney/en/System.Net.HttpClientComponent.TNetHTTPClient 

 

As far as synchronizing events is concerned, in THTTPClient they will run in the context of the background thread, so you need to synchronize them with main thread if you need to access the UI. TNetHTTPClient has property SynchronizeEvents and depending on its value events will run synchronized with the main thread or not. Default value is True, so events will run in the context of the main thread. If you drop TNetHTTPclient on the form you can use it in asynchronous mode with just few lines:

 

Client.Asynchronous := True;
Client.OnRequestCompleted := HTTPRequestRequestCompleted;
Client.Get(’http://....’);

 

However, asynchronous mode is hard to debug and control, and I would suggest using simpler approach using background threads or tasks.

 

TTask.Run(
    procedure
    var
      Client: THTTPClient;
      Response: IHTTPResponse;
    begin
      Client := THTTPClient.Create;
      try
        Response := Client.Get('...');
      finally
        Client.Free;
      end;
      // process response in background thread
      ...

     // or pass it to the main thread   
      TThread.Queue(nil,
        procedure
        begin
          Memo.Lines.Add(Response.ContentAsString);
        end);
    end);

 

 

 

 

  • Like 1

Share this post


Link to post
2 hours ago, Peter Bezemek said:

I hope this helps someone.

I am not sure about that.

 

THTTPClient has built in support for timeout. What are you trying to accomplish with your timeout implementation? Your code is needlessly complicated. 

 

 

Share this post


Link to post

I am trying to prevent the thread from terminating before I get a response from the server or before it times out. Perhaps there is another way to do it, but this one works as it is and I want to use it.

Share this post


Link to post
procedure TUExtractForm.LoadURLAsyncPOST(const AURL, AText: string);
const
   CONST_TIMEOUT = 1000;
var
  HTTPClient: TNetHTTPClient;
  HTTPRequest: TNetHTTPRequest;
  Params: TStringList;
  ParamsStream: TBytesStream;
begin
  HTTPClient := TNetHTTPClient.Create(nil);
  try
    HTTPClient.ConnectionTimeout := CONST_TIMEOUT; // Timeout
    HTTPClient.ResponseTimeout := CONST_TIMEOUT; // Timeout
    HTTPRequest := TNetHTTPRequest.Create(HTTPClient);
    HTTPRequest.Client := HTTPClient;
    HTTPRequest.OnRequestCompleted := HTTPRequestCompleted;
    HTTPRequest.OnRequestError := HTTPRequestError;
    HTTPRequest.CustomHeaders['Content-Type'] := 'application/x-www-form-urlencoded';

    Params := TStringList.Create;
    Params.Add('input=' + TNetEncoding.URL.Encode(AText));
    ParamsStream := TBytesStream.Create(TEncoding.UTF8.GetBytes(Params.Text));

    TTask.Run(
      procedure
      var
        StartTime: TDateTime;
        WaitResult: Integer;
        RequestCompleted: Boolean;
      begin
        RequestCompleted := False;
        try
          StartTime := Now;
          TThread.CreateAnonymousThread(
            procedure
            begin
              try
                HTTPRequest.Post(AURL, ParamsStream);
              finally
                RequestCompleted := True;
                ParamsStream.Free;
                Params.Free;
              end;
            end).Start;

          while not RequestCompleted do
          begin
            WaitResult := MillisecondsBetween(Now, StartTime);
            if WaitResult > CONST_TIMEOUT then // Timeout
            begin
              TThread.Queue(nil, procedure
                begin
                  ShowMessage('HTTP request timed out');
                end);
              HTTPRequest.Cancel;
              Break;
            end;

            TThread.Sleep(100);
          end;
        except
          on E: Exception do
          begin
            TThread.Queue(nil, procedure
              begin
                ShowMessageFmt('Error: %s', [E.Message]);
              end);
          end;
        end;
      end);
  except
    on E: Exception do
    begin
      ShowMessageFmt('Error: %s', [E.Message]);
      HTTPClient.Free;
    end;
  end;
end;



procedure TUExtractForm.HTTPRequestCompleted(const Sender: TObject; const AResponse: IHTTPResponse);
var
  Content: string;
begin
  if AResponse.StatusCode = 200 then
  begin
    Content := AResponse.ContentAsString;
    TThread.Queue(nil, procedure begin
      // replace #$A with new line
      Content := StringReplace(Content, #$A, sLineBreak, [rfReplaceAll]);
      URLMemo.Text := Content;
    end);
  end;
  TNetHTTPRequest(Sender).Client.Free;
  TNetHTTPRequest(Sender).Client := nil;
end;


procedure TUExtractForm.HTTPRequestError(const Sender: TObject; const AError: string);
begin
  TThread.Queue(nil, procedure begin
    ShowMessageFmt('Error: %s', [AError]);
  end);
  TNetHTTPRequest(Sender).Client.Free;
  TNetHTTPRequest(Sender).Client:=nil;
end;

This is a similar code that works with POST. I am using Params.Add('input=' + TNetEncoding.URL.Encode(AText)); you can also use text= instead of input= and I store the response in URLMemo, which you can change to whatever you need.

The code is very similar to the previous one I posted, but at first it did not work for me because of Modsecurity issues on my server, then it was processed as GET instead of POST (again an issue with the server) and finally it required the addition of HTTPRequest.CustomHeaders['Content-Type'] := 'application/x-www-form-urlencoded'; before it started working as I expected.

Share this post


Link to post
1 hour ago, Peter Bezemek said:

I am trying to prevent the thread from terminating before I get a response from the server or before it times out.

TTask.Run already runs in background thread and that thread will not finish before HTTP client completes its work or times out. You don't need to run another thread inside task and you don't need to run a loop simulating timeout.

Share this post


Link to post

Unfortunately, practical experience told me it DOES finish before the HTTP client completes its work, that is why I added it. Perhaps there was some other error in my code and I interpreted what I saw a wrong way (and I was really in a hurry to get this out of the way). Feel free to simplify my code and I will test it for my case and report with the result.

Edited by Peter Bezemek

Share this post


Link to post

Following code would do the job

procedure TUExtractForm.LoadURLAsyncPOST(const AURL, AText: string);
const
  CONST_TIMEOUT = 1000;
begin
  TTask.Run(
    procedure
    var
      HttpClient: TNetHTTPClient;
      HTTPRequest: TNetHTTPRequest;
      ParamsStream: TBytesStream;
    begin
      ParamsStream := nil;
      try
        HttpClient := TNetHTTPClient.Create(nil);
        try
          HttpClient.ConnectionTimeout := CONST_TIMEOUT; // Timeout
          HttpClient.ResponseTimeout := CONST_TIMEOUT;   // Timeout
          HTTPRequest := TNetHTTPRequest.Create(HttpClient);
          HTTPRequest.Client := HttpClient;
          HTTPRequest.OnRequestCompleted := HTTPRequestCompleted;
          HTTPRequest.OnRequestError := HTTPRequestError;
          HTTPRequest.CustomHeaders['Content-Type'] := 'application/x-www-form-urlencoded';

          ParamsStream := TBytesStream.Create(TEncoding.UTF8.GetBytes('input=' + TNetEncoding.URL.Encode(AText)));
          HTTPRequest.Post(AURL, ParamsStream);
        finally
          HttpClient.Free;
          ParamsStream.Free;
        end;
      except
        on E: Exception do
          begin
            TThread.Queue(nil,
              procedure
              begin
                ShowMessageFmt('Error: %s', [E.Message]);
              end);
          end;
      end;
    end);
end;

procedure TUExtractForm.HTTPRequestCompleted(const Sender: TObject; const AResponse: IHTTPResponse);
var
  Content: string;
begin
  if AResponse.StatusCode = 200 then
    begin
      Content := AResponse.ContentAsString;
      // replace #$A with new line
      Content := StringReplace(Content, #$A, sLineBreak, [rfReplaceAll]);
      URLMemo.Text := Content;
    end;
end;

procedure TUExtractForm.HTTPRequestError(const Sender: TObject; const AError: string);
begin
  ShowMessageFmt('Error: %s', [AError]);
end;

 

However, your timeout setting is very low - one second, and this can cause issues if the server does not respond timely. I would just use default settings.

 

Share this post


Link to post

I have tested it and indeed it works, thanks!

 

As to the timeout, I actually used the value of 1000 to force the timeout and see if it works. My script sometimes takes up to 60 seconds to get back with a response, so I will increase the value accordingly.

Interestingly enough, the timeout now takes a few seconds more than the actual timeout value, but that is not a big issue.

 

I have modified the code for GET in the same way:

 

procedure TUExtractForm.LoadURLAsync(const AURL: string);
const
  CONST_TIMEOUT = 30000;
begin
  TTask.Run(
    procedure
    var
      HttpClient: TNetHTTPClient;
      HTTPRequest: TNetHTTPRequest;
    begin
      try
        HttpClient := TNetHTTPClient.Create(nil);
        try
          HttpClient.ConnectionTimeout := CONST_TIMEOUT; // Timeout
          HttpClient.ResponseTimeout := CONST_TIMEOUT;   // Timeout
          HTTPRequest := TNetHTTPRequest.Create(HttpClient);
          HTTPRequest.Client := HttpClient;
          HTTPRequest.OnRequestCompleted := HTTPRequestCompleted;
          HTTPRequest.OnRequestError := HTTPRequestError;

          HTTPRequest.Get(AURL);
        finally
          HttpClient.Free;
        end;
      except
        on E: Exception do
          begin
            TThread.Queue(nil,
              procedure
              begin
                ShowMessageFmt('Error: %s', [E.Message]);
              end);
          end;
      end;
    end);
end;

 

Share this post


Link to post

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×