Как сделать HTTP-запрос в отдельном потоке с таймаутом?

Question

Я давно не программировал в Delphi и, честно говоря, не думал, что мне когда-нибудь придется, но ... Здесь я отчаянно пытаюсь найти какую-то информацию по этому вопросу, и в настоящее время ее так мало, что я ничего не могу найти. Так что, возможно, вы, ребята, могли бы помочь мне.

В настоящее время мое приложение использует библиотеку Synapse для выполнения HTTP-вызовов, но не позволяет устанавливать тайм-аут. Как правило, это не большая проблема, но теперь мне абсолютно необходимо иметь тайм-аут, чтобы хорошо справиться с любыми проблемами с подключением.

То, что я ищу, - это библиотека (синхронная или нет), которая позволит сделать HTTP-запросы абсолютно прозрачными для пользователя без видимых или скрытых задержек. Я не могу немедленно прекратить поток прямо сейчас, и с возможностью многих частых запросов к серверу, который не отвечает, это бесполезно.

РЕДАКТИРОВАТЬ: Спасибо всем за ваши ответы!

Answer 1

Вам всегда нужно будет учитывать задержки и тайм-ауты при работе в сети. ИМХО самое близкое, что вы можете получить, это поместить сетевое взаимодействие в поток. Затем вы можете проверить, завершается ли поток в нужное время, и если не просто дать ему завершиться, но проигнорировать результат (нет безопасного способа прервать поток). Это дает дополнительное преимущество: теперь вы можете просто использовать синхронные сетевые вызовы, которые намного легче читать.

Answer 2

В синапсе время ожидания доступно из объекта TSynaClient , от которого THttpSend зависит. Поэтому все, что вам нужно сделать, чтобы настроить время ожидания (при условии, что вы используете стандартные функции), это скопировать используемую вами функцию, добавить новый параметр и установить для параметра Timeout то, что вам нужно. Например:

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 используется тайм-аут 5000, а в случае ожидания достаточно долго. Так как синапс тесно связан с потоками, он отлично работает.

Answer 3

[Известно, что работает только на D2010]

Вы можете использовать MSXML для отправки клиентских запросов (добавьте msxml и ole2 в ваше предложение uses). Хитрость заключается в том, чтобы использовать IServerXMLHTTPRequest, а не IXMLHTTPRequest, поскольку первый позволяет указывать тайм-ауты. Код ниже показывает Execute() метод потока:

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;

Недавно я обнаружил чрезвычайно раздражающее поведение этой техники MSXML, при которой GET запросы не будут повторно отправляться, если URL-адрес остается неизменным для последующих отправок; другими словами, клиент кэширует GET запросов. Это не происходит с POST.

Очевидно, что после истечения времени ожидания метод Execute завершается и поток очищается.

Answer 4

Synapse может быть настроен на создание исключения при возникновении сетевых ошибок.

RaiseExcept

Чек http://synapse.ararat.cz/doc/help/blcksock.TBlockSocket.html#RaiseExcept:

Если True, ошибки winsock возникают исключение. В противном случае устанавливается Только значение LastError, и вы должны проверьте это из вашей программы! По умолчанию значение False.