NetHTTPClient передача файла и OnReceiveData

Maximus · 23 февраля, 2017

Доброго времени суток всем.

Хочу замерять скорость загрузки файла на сервер, но OnReceiveData отказывается вызываться. Код простенький

var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create('Файл', fmOpenRead);

  NetHttpClient.Put('Ссылка', Stream);
end;

При скачивании файла с сервера на компьютер через Get, коллбек OnReceiveData работает корректно, а вот с Put почему-то нет. Он вызывается только раз, перед окончанием загрузки и вызовом OnRequestCompleted.

Он вообще должен вызываться или это нормальное поведение? По идее, если верить документации - должен: http://docwiki.embarcadero.com/Libraries/Berlin/en/System.Net.HttpClientComponent.TNetHTTPClient.Put

Кто-нибудь пробовал у себя, работает этот коллбек при передачи файла, а то может быть я что-то не так делаю?

Изменено 23 февраля, 2017 пользователем Maximus

Евгений Корепов · 25 февраля, 2017

В 23.02.2017 в 17:41, Maximus сказал:
Доброго времени суток всем.

Хочу замерять скорость загрузки файла на сервер, но OnReceiveData отказывается вызываться. Код простенький
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create('Файл', fmOpenRead);

  NetHttpClient.Put('Ссылка', Stream);
end;
При скачивании файла с сервера на компьютер через Get, коллбек OnReceiveData работает корректно, а вот с Put почему-то нет. Он вызывается только раз, перед окончанием загрузки и вызовом OnRequestCompleted.

Он вообще должен вызываться или это нормальное поведение? По идее, если верить документации - должен: http://docwiki.embarcadero.com/Libraries/Berlin/en/System.Net.HttpClientComponent.TNetHTTPClient.Put

Кто-нибудь пробовал у себя, работает этот коллбек при передачи файла, а то может быть я что-то не так делаю?

Скорее всего глюки, посмотрите исходники, возможно найдете ошибку. Компонент NetHTTPClient "новый" и по традиции наполнен багами. Вот к примеру OnValidateServerCertificate разработчики сломали в XE8, а починили только в Берлине. Куки тоже были сломаны сознательно (скопипастили кусок кода не в то место, тремя строками ниже чем нужно), и чинились два апдейта, если не ошибаюсь. Еще одна традиция - исправление только одного бага в одном компоненте за один апдейт, так что проще будет исправить код самому.

Maximus · 25 февраля, 2017

6 часов назад, Евгений Корепов сказал:

Скорее всего глюки, посмотрите исходники, возможно найдете ошибку. Компонент NetHTTPClient "новый" и по традиции наполнен багами. Вот к примеру OnValidateServerCertificate разработчики сломали в XE8, а починили только в Берлине. Куки тоже были сломаны сознательно (скопипастили кусок кода не в то место, тремя строками ниже чем нужно), и чинились два апдейта, если не ошибаюсь. Еще одна традиция - исправление только одного бага в одном компоненте за один апдейт, так что проще будет исправить код самому.

Да вот смотрю на то что они понаписали и думаю, то ли они вообще не предусмотрели вызов этого коллбека при отдаче файла, то ли забыли...

Вот эта функция вызывается вне зависимости от того куда мы загружаем файл: к себе или на сервер.

Спойлер


unit System.Net.HttpClient;

procedure THTTPClient.ExecuteHTTPInternal(const ARequest: IHTTPRequest; const AContentStream: TStream; const AResponse: IHTTPResponse);
var
  LRequest: THTTPRequest;
  LResponse: THTTPResponse;
  State: THTTPState;
  LExecResult: TExecutionResult;
  LClientCertificateList: TCertificateList;
  OrigSourceStreamPosition: Int64;
  OrigContentStreamPosition: Int64;
  OrigContentStreamSize: Int64;
  Status: Integer;
  LCookieHeader: string;
begin
  LResponse := AResponse as THTTPResponse;
  LRequest := ARequest as THTTPRequest;
  OrigSourceStreamPosition := 0;
  if LRequest.FSourceStream <> nil then
    OrigSourceStreamPosition := LRequest.FSourceStream.Position;

  if AContentStream <> nil then
  begin
    OrigContentStreamPosition := AContentStream.Position;
    OrigContentStreamSize := AContentStream.Size;
  end
  else
  begin
    OrigContentStreamPosition := 0;
    OrigContentStreamSize := 0;
  end;

  State := Default(THTTPState);
  LClientCertificateList := TCertificateList.Create;
  try
    while True do
    begin
      LRequest.DoPrepare;

      // Add Cookies
      if FCookieManager <> nil then
      begin
        LCookieHeader := FCookieManager.CookieHeaders(LRequest.FURL);
        if LCookieHeader <> '' then
          LRequest.AddHeader('Cookie', LCookieHeader);  // do not localize
      end;

      if not SetServerCredential(LRequest, LResponse, State) then
        Break;
      if not SetProxyCredential(LRequest, LResponse, State) then
        Break;
      State.Status := InternalState.Other;

      if LRequest.FSourceStream <> nil then
        LRequest.FSourceStream.Position := OrigSourceStreamPosition;

      if LResponse <> nil then
      begin
        LResponse.FStream.Size := OrigContentStreamSize;
        LResponse.FStream.Position := OrigContentStreamPosition;
      end;

      LExecResult := DoExecuteRequest(LRequest, LResponse, AContentStream);
      case LExecResult of
        TExecutionResult.Success:
          begin
            if not SameText(LRequest.FMethodString, sHTTPMethodHead) then
              LResponse.DoReadData(LResponse.FStream);
            Status := LResponse.GetStatusCode;
            case Status of
              200:
                begin
                  Break;
                end;
              401:
                begin
                  State.Status := InternalState.ServerAuthRequired;
                end;
              407:
                begin
                  State.Status := InternalState.ProxyAuthRequired;
                end;
              else
                begin
                  case Status of
                    301..304, 307:
                      if FHandleRedirects and (LRequest.FMethodString <> sHTTPMethodHead) then
                      begin
                        Inc(State.Redirections);
                        if State.Redirections > FMaxRedirects then
                          raise ENetHTTPRequestException.CreateResFmt(@SNetHttpMaxRedirections, [FMaxRedirects]);
                      end
                      else
                        Break;
                  else
                  end;
                  State.Status := InternalState.Other;
                  if DoProcessStatus(LRequest, LResponse) then
                    Break;
                end;
            end;
          end;
        TExecutionResult.ServerCertificateInvalid:
          begin
            DoValidateServerCertificate(LRequest);
          end;
        TExecutionResult.ClientCertificateNeeded:
          begin
            DoNeedClientCertificate(LRequest, LClientCertificateList);
          end
        else
          raise ENetHTTPClientException.CreateRes(@SNetHttpClientUnknownError);
      end;
      // Every loop we do, update Cookies.
      if AllowCookies then
        UpdateCookiesFromResponse(LResponse);
    end;
    // When we finish the request, update cookies.
    if AllowCookies then
      UpdateCookiesFromResponse(LResponse);
    if LRequest.FSourceStream <> nil then
      LRequest.FSourceStream.Seek(0, TSeekOrigin.soEnd);
    LResponse.FStream.Position := OrigContentStreamPosition;
  finally
    LClientCertificateList.Free;
  end;
end;

Разница начинается на этой сроке

LExecResult := DoExecuteRequest(LRequest, LResponse, AContentStream);

При загрузке на ПК эта функция

Спойлер


unit System.Net.HttpClient.Win;

function TWinHTTPClient.DoExecuteRequest(const ARequest: THTTPRequest; var AResponse: THTTPResponse;
  const AContentStream: TStream): TWinHTTPClient.TExecutionResult;
var
  Res: Boolean;
  Buffer: TArray<System.Byte>;
  ToRead: Int64;
  BytesWritten: Cardinal;
  LRequest: TWinHTTPRequest;
  DataLength: Cardinal;
  OptionValue: DWORD;
  LastError: Cardinal;
  LHeader: TNetHeader;
const
  BUFFERSIZE = 64 * 1024;  // Usual TCP Window Size
begin
  Result := TWinHTTPClient.TExecutionResult.Success;
  LRequest := TWinHTTPRequest(ARequest);

  if LRequest.FHeaders = nil then
     LRequest.FHeaders := LRequest.GetHeaders
  else
  begin
    for LHeader in LRequest.FHeaders do
      if LRequest.GetHeaderValue(LHeader.Name) = '' then
        LRequest.AddHeader(LHeader.Name, LHeader.Value);
  end;

  DataLength := 0;
  if LRequest.FSourceStream <> nil then
    DataLength := LRequest.FSourceStream.Size - LRequest.FSourceStream.Position;

  //Set callback context to LRequest
//  WinHttpSetOption(LRequest.FWRequest, WINHTTP_OPTION_CONTEXT_VALUE, @LRequest, SizeOf(Pointer));

  //Disable automatic redirects
  OptionValue := WINHTTP_DISABLE_REDIRECTS;
  WinHttpSetOption(LRequest.FWRequest, WINHTTP_OPTION_DISABLE_FEATURE, @OptionValue, sizeof(OptionValue));

  //Disable automatic addition of cookie headers to requests, it's done by framework
  OptionValue := WINHTTP_DISABLE_COOKIES;
  WinHttpSetOption(LRequest.FWRequest, WINHTTP_OPTION_DISABLE_FEATURE, @OptionValue, sizeof(OptionValue));

  // Send Request
  Res := WinHttpSendRequest(LRequest.FWRequest, WINHTTP_NO_ADDITIONAL_HEADERS, 0, WINHTTP_NO_REQUEST_DATA, 0, DataLength, 0);
  if not Res then
  begin
    LastError := GetLastError;
    case LastError of
      ERROR_WINHTTP_SECURE_FAILURE:
        Exit(TWinHTTPClient.TExecutionResult.ServerCertificateInvalid);
      ERROR_WINHTTP_CLIENT_AUTH_CERT_NEEDED:
        Exit(TWinHTTPClient.TExecutionResult.ClientCertificateNeeded);
      else
        raise ENetHTTPClientException.CreateResFmt(@SNetHttpClientSendError, [GetLastError, SysErrorMessage(GetLastError, FWinHttpHandle)]);
    end;
  end;

  // Send data
  if DataLength > 0 then
  begin
    SetLength(Buffer, BUFFERSIZE);
    while LRequest.FSourceStream.Position < LRequest.FSourceStream.Size do
    begin
      ToRead := LRequest.FSourceStream.Size - LRequest.FSourceStream.Position;
      if ToRead > BUFFERSIZE then
        ToRead := BUFFERSIZE;
      LRequest.FSourceStream.ReadBuffer(Buffer, ToRead);
      // Write data to the server.
      if not WinHttpWriteData(LRequest.FWRequest, Buffer[0], ToRead, @BytesWritten) then
        raise ENetHTTPClientException.CreateResFmt(@SNetHttpClientSendError, [GetLastError, SysErrorMessage(GetLastError, FWinHttpHandle)]);
      if BytesWritten < ToRead then
        LRequest.FSourceStream.Position := LRequest.FSourceStream.Position - (ToRead - BytesWritten);
    end;
  end;

  // Wait to receive response
  Res := WinHttpReceiveResponse(LRequest.FWRequest, nil);
  if not Res then
  begin
    LastError := GetLastError;
    case LastError of
      ERROR_WINHTTP_SECURE_FAILURE:
          Exit(TWinHTTPClient.TExecutionResult.ServerCertificateInvalid);
      ERROR_WINHTTP_CLIENT_AUTH_CERT_NEEDED:
          Exit(TWinHTTPClient.TExecutionResult.ClientCertificateNeeded);
      else
        raise ENetHTTPClientException.CreateResFmt(@SNetHttpClientReceiveError, [GetLastError, SysErrorMessage(GetLastError, FWinHttpHandle)]);
    end;
  end;
  SetLength(TWinHTTPResponse(AResponse).FHeaders, 0); // Reset response headers
  LRequest.FResponseLink := TWinHTTPResponse(AResponse);
end;

не входит в блок кода, помеченный // Send data. TWinHTTPClient.DoExecuteRequest выполняется полностью и продолжается выполнение процедуры THTTPClient.ExecuteHTTPInternal, в которой выполнение доходит до строки

if not SameText(LRequest.FMethodString, sHTTPMethodHead) then
              LResponse.DoReadData(LResponse.FStream);

откуда вызывается функция

Спойлер


unit System.Net.HttpClient.Win;

procedure TWinHTTPResponse.DoReadData(const AStream: TStream);
var
  LSize: Cardinal;
  LDownloaded: Cardinal;
  LBuffer: TBytes;
  LExpected, LReaded: Int64;
  LStatusCode: Integer;
  Abort: Boolean;
begin
  LReaded := 0;
  LExpected := GetContentLength;
  if LExpected = 0 then
    LExpected := -1;
  LStatusCode := GetStatusCode;
  Abort := False;
  FRequestLink.DoReceiveDataProgress(LStatusCode, LExpected, LReaded, Abort);
  if not Abort then
    repeat
      // Get the size of readed data in LSize
      if not WinHttpQueryDataAvailable(FWRequest, @LSize) then
        raise ENetHTTPResponseException.CreateResFmt(@SNetHttpRequestReadDataError, [GetLastError, SysErrorMessage(GetLastError, FWinHttpHandle)]);

      if LSize = 0 then
        Break;

      SetLength(LBuffer, LSize + 1);

      if not WinHttpReadData(FWRequest, LBuffer[0], LSize, @LDownloaded) then
        raise ENetHTTPResponseException.CreateResFmt(@SNetHttpRequestReadDataError, [GetLastError, SysErrorMessage(GetLastError, FWinHttpHandle)]);

      // This condition should never be reached since WinHttpQueryDataAvailable
      // reported that there are bits to read.
      if LDownloaded = 0 then
        Break;

      AStream.WriteBuffer(LBuffer, LDownloaded);
      LReaded := LReaded + LDownloaded;
      FRequestLink.DoReceiveDataProgress(LStatusCode, LExpected, LReaded, Abort);
    until (LSize = 0) or Abort;
end;

где и начинается загрузка файла на ПК. Отсюда уже и происходит вызов нашего коллбека в цикле, пока файл не загрузится.

FRequestLink.DoReceiveDataProgress(LStatusCode, LExpected, LReaded, Abort);

С передачей на сервер всё обстоит не так. После того как мы попали в функции TWinHTTPClient.DoExecuteRequest в блок кода, помеченный // Send data, мы там и остаёмся в цикле, пока файл не будет загружен, там разумеется нет никакого вызова коллбека, и только после того как файл будет загружен и мы выйдем из TWinHTTPClient.DoExecuteRequest, то так же попадаем в TWinHTTPResponse.DoReadData и там вызывается FRequestLink.DoReceiveDataProgress(LStatusCode, LExpected, LReaded, Abort); который перед циклом и который вызывается в итоге после окончания загрузки файла на сервер. Дальше мы входим в цикл, но он досрочно завершается вместе с процедурой на строке

if LSize = 0 then
        Break;

Самое забавное, что в цикле при передаче на сервер, даже флага Abort нет, значит прервать никак передачу нельзя, ну разве что объект уничтожать прямо во время работы.

Maximus · 25 февраля, 2017

В общем, я бы исправил так: добавил локальную переменную

Abort: Boolean;

в TWinHTTPClient.DoExecuteRequest, до цикла передачи данных вызвал бы коллбек с объёмом файла, так же как происходит при загрузке файла на ПК - первый коллбек вызывается с нулевым объёмом переданных данных.

LRequest.DoReceiveDataProgress(0, DataLength, 0, Abort);

В цикл добавил бы проверку на прекращение загрузки

while (LRequest.FSourceStream.Position < LRequest.FSourceStream.Size) and (not Abort) do

В конце цикла вызывал бы коллбек с объёмом файла и количеством переданных байт.

Первый параметр коллбека - StatusCode получить на данном этапе скорее всего нельзя, или я не понял как, поэтому передаю ноль.

LRequest.DoReceiveDataProgress(0, DataLength, LRequest.FSourceStream.Position, Abort);

Полный текст исправленной функции.

Спойлер


unit System.Net.HttpClient.Win;

...

function TWinHTTPClient.DoExecuteRequest(const ARequest: THTTPRequest; var AResponse: THTTPResponse;
  const AContentStream: TStream): TWinHTTPClient.TExecutionResult;
var
  Res: Boolean;
  Buffer: TArray<System.Byte>;
  ToRead: Int64;
  BytesWritten: Cardinal;
  LRequest: TWinHTTPRequest;
  DataLength: Cardinal;
  OptionValue: DWORD;
  LastError: Cardinal;
  LHeader: TNetHeader;
  Abort: Boolean;
const
  BUFFERSIZE = 64 * 1024;  // Usual TCP Window Size
begin
  Result := TWinHTTPClient.TExecutionResult.Success;
  LRequest := TWinHTTPRequest(ARequest);
  Abort := false;

  if LRequest.FHeaders = nil then
     LRequest.FHeaders := LRequest.GetHeaders
  else
  begin
    for LHeader in LRequest.FHeaders do
      if LRequest.GetHeaderValue(LHeader.Name) = '' then
        LRequest.AddHeader(LHeader.Name, LHeader.Value);
  end;

  DataLength := 0;
  if LRequest.FSourceStream <> nil then
    DataLength := LRequest.FSourceStream.Size - LRequest.FSourceStream.Position;

  //Set callback context to LRequest
//  WinHttpSetOption(LRequest.FWRequest, WINHTTP_OPTION_CONTEXT_VALUE, @LRequest, SizeOf(Pointer));

  //Disable automatic redirects
  OptionValue := WINHTTP_DISABLE_REDIRECTS;
  WinHttpSetOption(LRequest.FWRequest, WINHTTP_OPTION_DISABLE_FEATURE, @OptionValue, sizeof(OptionValue));

  //Disable automatic addition of cookie headers to requests, it's done by framework
  OptionValue := WINHTTP_DISABLE_COOKIES;
  WinHttpSetOption(LRequest.FWRequest, WINHTTP_OPTION_DISABLE_FEATURE, @OptionValue, sizeof(OptionValue));

  // Send Request
  Res := WinHttpSendRequest(LRequest.FWRequest, WINHTTP_NO_ADDITIONAL_HEADERS, 0, WINHTTP_NO_REQUEST_DATA, 0, DataLength, 0);
  if not Res then
  begin
    LastError := GetLastError;
    case LastError of
      ERROR_WINHTTP_SECURE_FAILURE:
        Exit(TWinHTTPClient.TExecutionResult.ServerCertificateInvalid);
      ERROR_WINHTTP_CLIENT_AUTH_CERT_NEEDED:
        Exit(TWinHTTPClient.TExecutionResult.ClientCertificateNeeded);
      else
        raise ENetHTTPClientException.CreateResFmt(@SNetHttpClientSendError, [GetLastError, SysErrorMessage(GetLastError, FWinHttpHandle)]);
    end;
  end;

  // Send data
  if DataLength > 0 then
  begin
    LRequest.DoReceiveDataProgress(0, DataLength, 0, Abort);
    SetLength(Buffer, BUFFERSIZE);
    while (LRequest.FSourceStream.Position < LRequest.FSourceStream.Size) and (not Abort) do
    begin
      ToRead := LRequest.FSourceStream.Size - LRequest.FSourceStream.Position;
      if ToRead > BUFFERSIZE then
        ToRead := BUFFERSIZE;
      LRequest.FSourceStream.ReadBuffer(Buffer, ToRead);
      // Write data to the server.
      if not WinHttpWriteData(LRequest.FWRequest, Buffer[0], ToRead, @BytesWritten) then
        raise ENetHTTPClientException.CreateResFmt(@SNetHttpClientSendError, [GetLastError, SysErrorMessage(GetLastError, FWinHttpHandle)]);
      if BytesWritten < ToRead then
        LRequest.FSourceStream.Position := LRequest.FSourceStream.Position - (ToRead - BytesWritten);
      LRequest.DoReceiveDataProgress(0, DataLength, LRequest.FSourceStream.Position, Abort);
    end;
  end;

  // Wait to receive response
  Res := WinHttpReceiveResponse(LRequest.FWRequest, nil);
  if not Res then
  begin
    LastError := GetLastError;
    case LastError of
      ERROR_WINHTTP_SECURE_FAILURE:
          Exit(TWinHTTPClient.TExecutionResult.ServerCertificateInvalid);
      ERROR_WINHTTP_CLIENT_AUTH_CERT_NEEDED:
          Exit(TWinHTTPClient.TExecutionResult.ClientCertificateNeeded);
      else
        raise ENetHTTPClientException.CreateResFmt(@SNetHttpClientReceiveError, [GetLastError, SysErrorMessage(GetLastError, FWinHttpHandle)]);
    end;
  end;
  SetLength(TWinHTTPResponse(AResponse).FHeaders, 0); // Reset response headers
  LRequest.FResponseLink := TWinHTTPResponse(AResponse);
end;

Евгений Корепов · 25 февраля, 2017

Заработало? Оформить бы исправления как хелпер к THTTPClient, было бы замечательно. Хотя вроде в Берлине теперь нельзя так сделать?

Maximus · 25 февраля, 2017

Да, работает. Мне легче было просто файл поправленный к проекту подложить.

Кстати, исходник со второго апдейта берлина, а то мало ли.

Maximus · 26 февраля, 2017

Правда после прерывания загрузки WinHttpReceiveResponse возвращает False и GetLastError возвращает код тайм аута, после чего выбрасывается соответствующее исключение, но возможно так оно и должно быть, сервер же не получил полный набор обещанных в WinHttpSendRequest байт.

Евгений Корепов · 30 марта, 2017

В Tokyo данный косяк решили сохранить, видимо он им дорог как память :-)

Вот кусок из System.Net.HttpClient.Win.pas

  // Send data
  if DataLength > 0 then
  begin
    SetLength(Buffer, BUFFERSIZE);
    while LRequest.FSourceStream.Position < LRequest.FSourceStream.Size do
    begin
      ToRead := LRequest.FSourceStream.Size - LRequest.FSourceStream.Position;
      if ToRead > BUFFERSIZE then
        ToRead := BUFFERSIZE;
      LRequest.FSourceStream.ReadBuffer(Buffer, ToRead);
      // Write data to the server.
      if not WinHttpWriteData(LRequest.FWRequest, Buffer[0], ToRead, @BytesWritten) then
        raise ENetHTTPClientException.CreateResFmt(@SNetHttpClientSendError, [GetLastError, SysErrorMessage(GetLastError, FWinHttpHandle)]);
      if BytesWritten < ToRead then
        LRequest.FSourceStream.Position := LRequest.FSourceStream.Position - (ToRead - BytesWritten);
    end;
  end;

Изменено 30 марта, 2017 пользователем Евгений Корепов

Войти

NetHTTPClient передача файла и OnReceiveData

Вопрос

Maximus

Ссылка на комментарий

7 ответов на этот вопрос

Рекомендуемые сообщения

Евгений Корепов

Ссылка на комментарий

Maximus

Ссылка на комментарий

Maximus

Ссылка на комментарий

Евгений Корепов

Ссылка на комментарий

Maximus

Ссылка на комментарий

Maximus

Ссылка на комментарий

Евгений Корепов

Ссылка на комментарий

Присоединяйтесь к обсуждению

Похожий контент

TNetHTTPClient и gzip

TNetHTTPClient и JSON-RPC

Последние посетители 0 пользователей онлайн

Сайт

FGX

Активность