Peter Bezemek

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;

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.

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.

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.

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...