pavlos 0 Posted March 4, 2022 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
Peter Bezemek 0 Posted April 16, 2023 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
Dalija Prasnikar 1396 Posted April 16, 2023 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); 1 Share this post Link to post
Dalija Prasnikar 1396 Posted April 16, 2023 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
Peter Bezemek 0 Posted April 16, 2023 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
Peter Bezemek 0 Posted April 16, 2023 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
Dalija Prasnikar 1396 Posted April 16, 2023 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
Peter Bezemek 0 Posted April 16, 2023 (edited) 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 April 16, 2023 by Peter Bezemek Share this post Link to post
Dalija Prasnikar 1396 Posted April 16, 2023 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
Peter Bezemek 0 Posted April 17, 2023 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