Перейти к содержанию
Fire Monkey от А до Я

Maximus

Пользователи
 Профиль  Обзор контента

  • Постов

    84

  • Зарегистрирован

  • Посещение

  • Победитель дней

    9

 Тип контента 

Сообщения, опубликованные Maximus

    Подключение из приложения под Андроид к удаленной БД сайта MySQL в С++ Builder XE

    в MySQL

    Опубликовано

    36 минут назад, b_vlad25 сказал:

    Может библиотеки какие не подключил, вообще по сайтам ничего.

    Что значит ничего? Покажите ошибку. Доступ в сеть для программы ничего не блокирует, антивирус например?

    Параллельные вычисления, System.Threading

    в Потоки и распределенные вычисления

    Опубликовано

    Вкратце вот здесь можно почитать http://proghouse.ru/programming/36-delphi-xe7-ppl

    38 минут назад, Alex7wrt сказал:

    Мне нужно, чтобы после того, как все потоки закончили вычисления, вывелась информация на экран и они снова начали работать над своими процедурами. И так, пока я не остановлю.

    Например, если таск организован как бесконечный цикл, то после завершения каждого таска, в главном потоке увеличивать счётчик. Как только он станет равным количеству запущенных, можно будет обновлять информацию на экране и делать повторный запуск. Разумеется доступ к главному потоку должен быть синхронизирован. А если в таске конечная последовательность действий, то можно просто проверять статусы всех тасков.

    42 минуты назад, Alex7wrt сказал:

    Есть метод TTask.WaitForAll, который дожидается выполнения всех потоков TTask, но если после вызова этого метода вставить строку вывода на экран, а затем сразу же снова запустить потоки, то ничего не выводится, программа подвисает, но при этом загрузка процессора ни 100% как должна быть, а где-то 30%.

    Логично. WaitForAll приостанавливает поток в котором был вызван до тех пор, пока не будут завершены все таски.

    DealLock или что сделать чтобы его получить

    в Отладка

    Опубликовано

    Во-первых ни в коем случае нельзя обращаться к визуальным компонентам напрямую без синхронизации, да и вообще к любым разделяемым ресурсам. Во-вторых deadlock в FMX ничем не отличается от deadlock на VCL или на WinAPI, почитать можно здесь http://forum.vingrad.ru/topic-60076.html

    Конкретно в приведённом примере достаточно обернуть изменение метки в Synchronize 

        TThread.Synchronize(nil, procedure
      begin
        Form4.Label1.Text:=i.ToString;
      end);

    и после запуска потока вызывать MyThread.WaitFor; - получите deadlock.

    Запуск стороннего приложения со своими координатами.

    в Развертывание приложений

    Опубликовано

    Ну да, конкретно с калькулятором такой финт не прокатит, он явно запоминает свою позицию перед закрытием, а затем при запуске её восстановление происходит уже после применения заданных в CreateProcess параметров позиции. А вообще работает, например, если запустить своё же приложение, разумеется если в нём нет установки координат после запуска.

    Можно и MoveWindow или SetWindowPos использовать после запуска, только тогда придётся получить хендл окна.

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

    в RTL

    Опубликовано

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

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

    в RTL

    Опубликовано

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

    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;

     

     

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

    в RTL

    Опубликовано

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

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

    в RTL

    Опубликовано · Изменено пользователем 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

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

    Конфликт Hint и BorderStyle

    в Windows

    Опубликовано

    48 минут назад, Равиль Зарипов (ZuBy) сказал:

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

    Здорово, спасибо большое, а то надоело мучаться с отображением хинтов через создание CalloutPanel.

×
×
  • Создать...