fClient := THTTPClient.Create;
fClient.AllowCookies := True;
fClient.HandleRedirects := True;
fClient.Accept := 'application/json';
fClient.ContentType := 'application/json';
fClient.AcceptEncoding := '*/*';
fClient.AcceptCharSet := 'utf-8';
...
LAsyncResult := fClient.BeginPost(LUrl, LRequest); // LAsyncResult: IAsyncResult;

LAsyncResult.AsyncWaitEvent.WaitFor( fCallTimeOut ); // !!! error

LResponse := THTTPClient.EndAsyncHTTP( LAsyncResult );
// далее - работа с респонсом

Embarcadero® RAD Studio 10.4 Version 27.0.40680.4203

Xiaomi Redme Note 4x, Pixel Experience, Android 10

Как скачивать с сжатый трафик через GZip по средством NetHTTPClient я знаю. А как отправить данные на сервер в жатом GZip ввиде с помощью NetHTTPClient?

Delphi XE8, отправляю обычный Get-запрос, используя THTTPClient

try
  	http:= THTTPClient.Create;
  	with http do begin
		AllowCookies:= true;
		Accept:= 'text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,image/apng,*/*;q=0.8';
		AcceptLanguage:= 'ru-RU,ru;q=0.9,en-US;q=0.8,en;q=0.7,de;q=0.6';
		UserAgent:= 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/69.0.3497.100 Safari/537.36 OPR/56.0.3051.36';
  	end;
  	Stream:= TStringStream.Create('', TEncoding.UTF8);
  	http.Get('https://mysite.net', Stream);
  	Memo.Text:= Stream.DataString;
except on e:exception do
	Memo.Lines.Add(e.Message);
end;

В итоге получаю ошибку

No mapping for the Unicode character exists in the target multi-byte code page

Смотрел в Fiddler'е, страница в UTF-8, Content-Type: text/html; charset=UTF-8

А самое странное то, что в фиддлере этот запрос из программы отмечается как отменённый... Вообще не понимаю, в чём дело, может кто сталкивался?

Так вот, вроде Берлин обещал работать с заправленными архивами zip. Поискал в доках, нашел только это упоминание про работу с разархивированием запароленных. тут

Но не слова про создание запароленных архивов. Есть ли инфа по этому поводу? Поисковые сервера не помогли(((

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;

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

      if LResponse <> nil then
      begin
        LResponse.FStream.Position := OrigContentStreamPosition;
        LResponse.FStream.Size := OrigContentStreamSize;
      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;

      if AllowCookies then  
        UpdateCookiesFromResponse(LResponse); // Вот эта, критически важная процедура, при Status=200 никогда не выполняется
    end;
 // После выхода из цикла попадаем сюда
    if LRequest.FSourceStream <> nil then
      LRequest.FSourceStream.Seek(0, TSeekOrigin.soEnd);
    LResponse.FStream.Position := OrigContentStreamPosition;
  finally
    LClientCertificateList.Free;
  end;
end;

Т.е. разработчики исключили выполнение UpdateCookiesFromResponse(LResponse), которая помещает куки из ответа в HTTPClient.

А вот код из XE8 который нормально работает с Cookies:

function THTTPClient.ExecuteHTTPInternal(const ARequest: IHTTPRequest; const AContentStream: TStream): IHTTPResponse;
var
  LRequest: THTTPRequest;
  LResponse: THTTPResponse;
  State: THTTPState;
  LExecResult: TExecutionResult;
  LClientCertificateList: TCertificateList;
  OrigSourceStreamPosition: Int64;
  OrigContentStreamPosition: Int64;
  OrigContentStreamSize: Int64;
  Status: Integer;
  LCookieHeader: string;
begin
  Result := nil;
  LResponse := nil;
  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;

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

      if LResponse <> nil then
      begin
        LResponse.FStream.Position := OrigContentStreamPosition;
        LResponse.FStream.Size := OrigContentStreamSize;
      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;

    end;
    if LRequest.FSourceStream <> nil then
      LRequest.FSourceStream.Seek(0, TSeekOrigin.soEnd);
    if AllowCookies then
      UpdateCookiesFromResponse(LResponse);  // Здесь все верно, процедура за пределами цикла и выполняется всегда когда нужно.
  finally
    LClientCertificateList.Free;
    Result := IHTTPResponse(LResponse);
  end;
end;

А теперь вопрос: ну как так то? В продукте за 54 тысячи рублей сильно обидно исправлять такие косяки. Такое ощущение что разраб подрабатывал на стороне в проектах на php и забыл переключится на другой язык, там break прерывает работу аналога case и код работал бы правильно.

Сохранять пытаюсь так :

  cookies := aResponse.cookies.AsJSON(false);

В cookies получаю 

{\"Capacity\":4,\"Count\":3,\"List\":[{\"Name\":\"csrftoken\",\"Value\":\"Jljq2Sx5n9lXek4u4rri9L1zGBIExSzT\",\"Expires\":\"2019-01-06T18:41:36.854\",\"Domain\":\".i.instagram.com\",\"Path\":\"/\",\"Secure\":true,\"HttpOnly\":false},{\"Name\":\"rur\",\"Value\":\"PRN\",\"Expires\":\"1899-12-30T00:00:00.000\",\"Domain\":\".i.instagram.com\",\"Path\":\"/\",\"Secure\":false,\"HttpOnly\":false},{\"Name\":\"mid\",\"Value\":\"WlIjkQABAAF-JTqtAx_AdVdFxepj\",\"Expires\":\"2038-01-02T18:41:36.854\",\"Domain\":\".i.instagram.com\",\"Path\":\"/\",\"Secure\":false,\"HttpOnly\":false},{\"Name\":\"\",\"Value\":\"\",\"Expires\":\"1899-12-30T00:00:00.000\",\"Domain\":\"\",\"Path\":\"\",\"Secure\":false,\"HttpOnly\":false}],\"OnNotify\":null}

Но как потом загрузить это обратно?

Помогите с кодом отправки файла.

PS. Инди компоненты не интересуют, не хочется их инспользовать

//aUrl = http://www.cbr.ru/scripts/XML_daily.asp

function GetXML(aURL: string): String;
var
  Http: THTTPClient;
  Ss: TStringStream;
begin
  Result:='';
  Http:=THTTPClient.Create;
  try
    Ss:=TStringStream.Create('', TEncoding.UTF8);
    Http.Get(aURL,ss);
    Result:=Ss.DataString; // тут ошибка
  except    
  end;
  Http.Free;
end;

Хочу замерять скорость загрузки файла на сервер, но 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

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

Ну а дальше приложение не запускается, хотя:

 - Настройки безопасности настроены на установку из любых мест
 - Встроенный архиватор разархивирует в папку и "из-под" него приложение запускается (до настроек безопасности просто выдавало ошибку "неизвестный автор" и "у вас настроено только на аппстор или известных авторов").
 - Разумеется при деплое приложения работают. Если их просто скопировать на флешку и потом закопировать обратно - тоже работают.

Следовательно проблема при разархивировании программно. Что-то нужно добавить. Есть понимание что именно? 

Сам нетривиальный код:

var z: TZipFile;
begin
  try
    {$IFDEF MSWINDOWS}
     RenameFile(ParamStr(0),ExtractFileName(ParamStr(0)) + '.old');
     Application.ProcessMessages;
    {$ENDIF}
    SetLength(Result, 1);
    Result[0] := '';
    z := TZipFile.Create;
    z.Open(ZipFile, zmRead);
    z.ExtractAll(ExtractTo);
    Result := z.FileNames;
  finally
    z.Close;
    z.Free;
  end;
end;

В архив кладу:

 - .app взятый с мака (а по другому никак)
 - .entitlements
 - .DS_Store 

В надобности последнего я сильно сомневаюсь.

type
  TResponser = record
    Response: string;
    Code: integer;
  end;
...

procedure TFrmLogin.OnAuthEvent(const Sender: TObject;
  AnAuthTarget: TAuthTargetType; const ARealm, AURL: string; var AUserName,
  APassword: string; var AbortAuth: Boolean;
  var Persistence: TAuthPersistenceType);
var
  MyCredential: TCredentialsStorage.TCredential;
begin
  MyCredential := TNetHTTPClient(Sender).CredentialsStorage.FindAccurateCredential(AnAuthTarget, '');
  AUserName := MyCredential.UserName;
  APassword := MyCredential.Password;
end;

procedure TFrmLogin.OnValidateServerCertificate(
  const Sender: TObject; const ARequest: TURLRequest;
  const Certificate: TCertificate; var Accepted: Boolean);
begin
  Accepted:=true;
end;


function TFormLogin.LoginToServer(login,pass:String):TResponser;
var
  aResponse: IHTTPResponse;
  aResponser: TResponser;
  sStream: TStringStream;
  aHttpClient: TNetHTTPClient;
begin
  try
    aHTTPClient := TNetHTTPClient.Create(nil);
    aHTTPClient.OnAuthEvent:=OnAuthEvent;
    aHTTPClient.OnValidateServerCertificate:=OnValidateServerCertificate;
    aHTTPClient.CredentialsStorage.AddCredential
      (TCredentialsStorage.TCredential.Create(TAuthTargetType.Server,'',
      sURL, login, pass));
    aHTTPClient.AllowCookies  :=true;
    aHTTPClient.AcceptLanguage:='ru-RU;q=0.8,en-US;q=0.5,en;q=0.3';
    aHTTPClient.ContentType   :='text/json';
    aHTTPClient.AcceptCharset :='utf-8';
    aHTTPClient.Accept        :='text/json,text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';

    try
      sStream := TStringStream.Create();
      try
        aResponse := aHttpClient.Get(sURL, sStream); 
        aResponser.Response:=sStream.DataString;
        aResponser.Code:=aResponse.StatusCode; // тут получаю код 200
        Result:=aResponser;
      except end;
    finally
      sStream.Free;
    end;
  finally
    aHttpClient.Free;
  end;
end;

После get cразу получаю код 200 (от ответного кода я решаю авторизован я или нет). Однако на сервер реально приходит 2 запроса: первый без basic authorization (и на него дается в ответ код 401), второй с basic authorization (на него уже в ответ код 200).

Почему проходит два запроса, когда в программе я вижу только один? 

https://accounts.google.com/AddSession?hl=ru&continue=https://www.google.com/%3Fgws_rd%3Dssl

https://accounts.google.com/Logout?hl=ru&continue=https://www.google.com/%3Fgws_rd%3Dssl&timeStmp=1463418874

Возникает исключение:

Цитата

Exception class ENetHTTPException with message 'Error querying headers: (87) Параметр задан неверно'. Process HttpAsyncDownloadDemo.exe (8924)

В инди такой проблемы нет, она отдаёт контент HTML страницы, как и положено.

Потестить можно через C:\Users\Public\Documents\Embarcadero\Studio\18.0\Samples\Object Pascal\RTL\HttpAsyncDownload

Это очередной баг?

(использую Delphi 10.1 Berlin)

function TFormMain.GetResponse(aURL: string): String;
var 
  Ss: TStringStream; 
begin 
  with NetHTTPClient1 do 
  begin 
    AllowCookies:=true; 
    try 
      Ss:=TStringStream.Create('', TEncoding.UTF8); 
      Get(aURL,ss); 
      Result:=Ss.DataString; 
    finally FreeAndNil(Ss); end; 
  end; 
end;
 
procedure TFormMain.NetHTTPClient1ValidateServerCertificate(
  const Sender: TObject; const ARequest: TURLRequest;
  const [Ref] Certificate: TCertificate; var Accepted: Boolean);
begin
  Accepted:=true;
end;


procedure TFormMain.BtnSendClick(Sender: TObject);
var
  Response:String;
const
  aURL='https://ya.ru';
begin
  TTask.Run(procedure
    begin
    try
      Response:=GetResponse(aURL); // отправляю Get запрос
      TThread.Synchronize(nil, procedure
      begin
        Memo.Lines.Add(Response);
      end);
    finally end;
  end);
end;

Получаю access violation в System.Net.HTTPClient в строке 1965 

if (Result.Value.Chars[0] = '"') and (Result.Value[High(Result.Value)] = '"') then

видимо из-за того что Result.Value пустой. 
А если попробовать открыть https://mail.ru такого не происходит и страница нормально скачивается.
 
В чем проблема?

Как это реализовать? Можно ли установить пароль при создании файла в TZipFile?

Если нет, то какие есть способы шифрования файлов? (Желательно универсальные, для всех доступных ОС)

type
  TFrmMain = class(TForm)
   ...
    procedure OnAuthEvent(const Sender: TObject;
      AnAuthTarget: TAuthTargetType; const ARealm, AURL: string; var AUserName,
      APassword: string; var AbortAuth: Boolean;
      var Persistence: TAuthPersistenceType);
    procedure OnValidateServerCertificate(const Sender: TObject;
      const ARequest: TURLRequest; const [Ref] Certificate: TCertificate;
      var Accepted: Boolean);

function TFrmMain.GetResponse2(aURL: string): TResponser;
var
  Ss: TStringStream;
  NetHTTPClient2:TNetHTTPClient;
  Respon: IHTTPResponse;
begin
  try
    NetHTTPClient2:=TNetHTTPClient.Create(nil);
    NetHTTPClient2.OnAuthEvent:=OnAuthEvent;
    NetHTTPClient2.OnValidateServerCertificate:=OnValidateServerCertificat; // ошибка компиляции
    ...
    with NetHTTPClient2 do
    begin
       Ss:=TStringStream.Create('', TEncoding.UTF8);
       Respon:=Get(aURL,ss);
    end;

  finally
    NetHTTPClient2.Free;
  end;
end;


procedure TFrmMain.OnValidateServerCertificate(
  const Sender: TObject; const ARequest: TURLRequest;
  const [Ref] Certificate: TCertificate; var Accepted: Boolean);
begin
  Accepted:=true;
end;

Как правильно сделать?

При парсинге сайта (bash.im) и при использовании компонента TRegExpr и компиляции программы под Windows все работает нормально:

procedure TForm1.Button22Click(Sender: TObject);
var
  s: string;
  regexpr: TRegExpr;
  ss: TStringStream;
begin
  ss := TStringStream.Create('', TEncoding.GetEncoding(1251));
  try
    IdHTTP1.Get('http://bash.im/', ss);
    ss.Position := 0;
    s := ss.DataString;
  finally
    ss.Free;
  end;
 
  regexpr := TRegExpr.Create;
  try
    regexpr.Expression :=
      'class="date">(.*?)<.*?class="id">(.*?)<.*?class="text">(.*?)<';
 
    if regexpr.Exec(s) then
      repeat
        mmoLetters.Lines.Add(regexpr.Match[1]);
        mmoLetters.Lines.Add(regexpr.Match[2]);
        mmoLetters.Lines.Add(regexpr.Match[3]);
      until not regexpr.ExecNext;
  finally
    regexpr.Free
  end;
 
end;

Но при компиляции приложения под Android, выдает ошибку...

Использую RegularExpressions из состава Delphi 10 Seattle:

uses
  System.RegularExpressions
...
procedure TfrmMain.ParsingBashNew(URLToPars: string);
var
  Matches: TMatchCollection;
  RegExpr: TRegEx;
  i: Integer;
  RegularExpressString : string;
begin
  mmoNew.Lines.Clear;
 
  HTMLText := IdHTTP1.Get(URLToPars);
 
  RegularExpressString := 'class="date">(.*?)<.*?class="id">(.*?)<.*?class="text">(.*?)<';
 
  RegExpr := TRegEx.Create(RegularExpressString, [roIgnoreCase, roMultiLine]);
 
  Matches := RegExpr.Matches(HTMLText);
 
  if Matches.Count > 0 then
    begin
      mmoNew.BeginUpdate;
        for i := 0 to Matches.Count -1 do
          begin
            mmoNew.Lines.Add(Matches.Item[i].Groups[1].Value);
            mmoNew.Lines.Add(Matches.Item[i].Groups[2].Value);
            mmoNew.Lines.Add(Matches.Item[i].Groups[3].Value);
            mmoNew.Lines.Add('==============================');
          end;
      mmoNew.EndUpdate;
    end;
end;

То же самое регулярное выражение на работает. В чем может быть загвоздка? (если отбросить последнюю составляющую регулярки - '.*?class="text">(.*?)<'    - тоже все работает!)

При компиляции под Android - 2 ошибки (Delphi 10 Seattle):

[DCC Error] RegExpr.pas(105): E2003 Undeclared identifier: 'WideString'
[DCC Fatal Error] RegExpr.pas(634): F2613 Unit 'Windows' not found.

Как их обойти?

Раньше пользовался TRegExpr (http://regexpstudio.com/RU/TRegExpr/TRegExpr.html)

Попытался использовать его в Delphi 10 S для Android, посыпались ошибки компиляции RegExpr.pas (проблемы cо строковыми значениями).

Почитал статьи/форумы, узнал что есть встроенные регулярники System.RegularExpressions.pas, но якобы плохо работает с русским языком. Как на текущий момент?  Решена ли эта проблема?

procedure TvicDBv1.FindAnswer(const Question: string);
var
  I: Integer;
  aQ, aA, aT: String;
begin
  aT := LowerCase(Question);
  for I := 0 to fFile.Count - 1 do
  Begin
  ...... 
  End;
end;

Лично я думал что будет записано "роль, в которой винни-пух был на высоте". Но ехидная RAD X выдает следующее:

Что за чудеса?