How to make an HTTP request in a separate thread with timeout?

I haven't programmed in Delphi for a while and frankly didn't think I'll ever have to but... Here I a开发者_JAVA技巧m, desperately trying to find some information on the matter and it's so scarce nowadays, I can't find anything. So maybe you guys could help me out.

Currently my application uses Synapse library to make HTTP calls, but it doesn't allow for setting a timeout. Usually, that's not a big problem, but now I absolutely must to have a timeout to handle any connectivity issues nicely.

What I'm looking for, is a library (synchronous or not) that will allow making HTTP requests absolutely transparent for the user with no visible or hidden delays. I can't immediately kill a thread right now, and with possibility of many frequent requests to the server that is not responding, it's no good.

EDIT: Thanks everybody for your answers!

---

You will always have to take delays and timeouts into account when doing network communication. The closest you can get IMHO is to put network communication in a thread. Then you can check if the thread finishes in the desired time and if not just let it finish, but ignore the result (there's no safe way to abort a thread). This has an additional advantage: you can now just use synchronous network calls which are a lot easier to read.

---

In synapse, the timeout is available from the TSynaClient object, which THttpSend decends from. So all you have to do to adjust for timeout (assuming your using the standard functions) is to copy the function your using, add a new parameter and set the Timeout to what you need. For example:

function HttpGetTextTimeout(const URL: string; 
                            const Response: TStrings;
                            const Timeout:integer): Boolean;
var
  HTTP: THTTPSend;
begin
  HTTP := THTTPSend.Create;
  try
    HTTP.Timeout := Timeout;
    Result := HTTP.HTTPMethod('GET', URL);
    if Result then
      Response.LoadFromStream(HTTP.Document);
  finally
    HTTP.Free;
  end;
end;

Synapse defaults to a timeout of 5000 and does timeout if you wait long enough. Since its tightly contained, synapse runs perfectly fine in threads.

---

[Known to work on D2010 only]

You can use MSXML to send client requests (add msxml and ole2 to your uses clause). The trick is to use IServerXMLHTTPRequest rather than IXMLHTTPRequest, as the former allows timeouts to be specified. The code below shows the Execute() method of a thread:

procedure TClientSendThread.Execute;
const
  LResolveTimeoutMilliseconds = 2000;
  LConnectTimeoutMilliseconds = 5000;
  LSendTimeoutMilliseconds = 5000;
  LReceiveTimeoutMilliseconds = 10000;
var
  LHTTPServer: IServerXMLHTTPRequest;
  LDataStream: TMemoryStream;
  LData: OleVariant;
begin
  {Needed because this is inside a thread.}
  CoInitialize(nil);
  LDataStream := TMemoryStream.Create;
  try
    {Populate ....LDataStream...}
    LData := MemoryStreamToOleVariant(LDataStream);

    LHTTPServer := CreateOleObject('MSXML2.ServerXMLHTTP.3.0') as IServerXMLHTTPRequest;
    LHTTPServer.setTimeouts(
      LResolveTimeoutMilliseconds,
      LConnectTimeoutMilliseconds,
      LSendTimeoutMilliseconds,
      LReceiveTimeoutMilliseconds
      );
    LHTTPServer.open('POST', URL, False, 0, 0);
    LHTTPServer.send(LData);
    FAnswer := LHTTPServer.responseText;
  finally
    FreeAndNil(LDataStream);
    CoUninitialize;
  end;
end;

I recently discovered an extremely annoying behavior of this MSXML technique in which GET requests will not be re-sent if the URL remains unchanged for subsequent sendings; in other words, the client is caching GET requests. This does not happen with POST.

Obviously, once the timeouts occur, the Execute method completes and the thread is cleaned up.

---

Synapse can be configured to raise an Exception when network errors occur.

RaiseExcept

Check http://synapse.ararat.cz/doc/help/blcksock.TBlockSocket.html#RaiseExcept:

If True, winsock errors raises exception. Otherwise is setted LastError value only and you must check it from your program! Default value is False.