0

Подключаюсь к корпоративной сети через cisco, а дальше доменная ntlm авторизация на корп. https сайт. Так вот прокси прохожу (достаточно в IE один раз вести логин с паролем) и программа ходит на все сайты, кроме корпоративного, на нем валится ошибка 12045 (ERROR_INTERNET_INVALID_CA) или 12057. Как подсунуть сертификат из хранилища? Естественно не используя логин с паролем и его название. Помогите, пожалуйста, кто сталкивался с таким. Через http пробовал. Вот функция:

function WinInetRequest(AUrl, AParam, AMethod, AType_Access: String; APostData: boolean): AnsiString;

  function GetHostName(AUrl: string): string;
  var
    s: string;
  begin // Имя хоста
    if Pos('https://', AUrl) > 0 then
      s:= 'https://'
    else
      if Pos('http://', AUrl) > 0 then
        s:= 'http://'
      else
        s:= EmptyStr;
    if s <> EmptyStr then
      if Pos(s, AUrl) > 0 then
        Delete(AUrl, 1, Length(s));
    if Pos('/', AUrl) > 0 then
      SetLength(AUrl, Pos('/', AUrl) - 1);
    Result:= AUrl;
  end;

  function GetScriptName(AUrl, AHostname: string): string;
  begin // URL после имени хоста
    Result:= EmptyStr;
    Delete(AUrl, 1, Pos(AHostname, AUrl) + Length(AHostname));
    Result:= AUrl;
  end;

  procedure SetFlags(AUrl: string; out Flags_connection, Flags_Request: Cardinal);
  begin // Определяем https или http
    if Pos('https', AUrl) > 0 then
    begin
      Flags_connection:= INTERNET_DEFAULT_HTTPS_PORT;
      Flags_Request:= INTERNET_FLAG_RELOAD
                   or INTERNET_FLAG_IGNORE_CERT_CN_INVALID
                   or INTERNET_FLAG_IGNORE_CERT_DATE_INVALID
                   or SECURITY_FLAG_IGNORE_UNKNOWN_CA
                   or INTERNET_FLAG_NO_CACHE_WRITE
                   or INTERNET_FLAG_SECURE
                   or INTERNET_FLAG_PRAGMA_NOCACHE
                   or INTERNET_FLAG_KEEP_CONNECTION;
    end else
      begin
        Flags_connection:= INTERNET_DEFAULT_HTTP_PORT;
        Flags_Request:= INTERNET_FLAG_RELOAD or INTERNET_FLAG_IGNORE_CERT_CN_INVALID or INTERNET_FLAG_NO_CACHE_WRITE or INTERNET_FLAG_PRAGMA_NOCACHE or INTERNET_FLAG_KEEP_CONNECTION;
      end;
  end;

var
  hInet, hCon, hReq: HINTERNET;
  Status, Index, dwErrorCode, StatusSize: DWORD;
  bytes, b, pos: Cardinal;
  hostname, script: string;
  Flags_connection, Flags_Request : Cardinal;
  IsSended: Boolean;

label
  again;
begin
  Result:= EmptyAnsiStr;

  hostname:= GetHostName(AUrl); // имя хоста
  script:= GetScriptName(AUrl, hostname); // скрипт
  // установка доп. параметров
  if not APostData then // если передаем параметры через строку запроса, то
    if AParam <> EmptyStr then // дополняем скрипт
      if script[Length(script)] = '?' then
        script:= script + AParam
      else
        script:= script + '?' + AParam;

  // Type_Access
  if AType_Access = EmptyStr then
    AType_Access:= 'Content-Type: application/x-www-form-urlenDELPHId' + #13#10 +
                'Content-Length:' + IntToStr(length(AParam)) ;

  try
    // Устанавливаем флаги (http или https)
    SetFlags(AUrl, Flags_connection, Flags_Request);
    // Инициализируем WinInet
    hInet:= InternetOpen(PChar(Application.ExeName), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0); //
    if Assigned(hInet) then
    try
      // Открываем сессию (передаем имя сервера hostname в ф-ю InternetConnect под параметром lpszServerName)
      hCon:= InternetConnect(hInet, PChar(hostname), Flags_connection, nil, nil, INTERNET_SERVICE_HTTP, 0, 1);
      if Assigned(hCon) then
      try
        // Открываем запрос (передаем остаток URL (скрипт GetScriptName) в ф-ю HttpOpenRequest под параметром lpszObjectName)
        hReq:= HttpOpenRequest(hCon, PChar(UpperCase(AMethod)), PChar(script), HTTP_VERSION, nil, nil, Flags_Request, 1);
        if Assigned(hReq) then
        try // Отправляем запрос
          case APostData of
            False: IsSended:= HttpSendRequest(hReq, nil, 0, nil, 0);
            True: IsSended:= HttpSendRequest(hReq, PChar(AType_Access), Length(AType_Access), PChar(AParam), Length(AParam));
          end;
          if not IsSended then // отработка ошибки сертификата
          begin
                        // Окно авторизации
              {InternetErrorDlg(Application.Handle,
                               hReq,
                               ERROR_INTERNET_INVALID_CA,
                               FLAGS_ERROR_UI_FILTER_FOR_ERRORS
                            or FLAGS_ERROR_UI_FLAGS_GENERATE_DATA
                            or FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS,
                               hReq);}
              dwErrorCode:= GetLastError;
              if (dwErrorCode = 12045) then
              begin
                ShowMessage('Ошибка сертификата!');
                Status:= INTERNET_FLAG_SECURE
                     or  INTERNET_FLAG_IGNORE_CERT_CN_INVALID
                     or INTERNET_FLAG_IGNORE_CERT_DATE_INVALID
                     or SECURITY_FLAG_IGNORE_REVOCATION;
                StatusSize:= SizeOf(Status);
                InternetQueryOption(hReq, INTERNET_OPTION_SECURITY_FLAGS, @Status, StatusSize);
                Status:= Status or SECURITY_FLAG_IGNORE_UNKNOWN_CA;
                InternetSetOption(hReq, INTERNET_OPTION_SECURITY_FLAGS, @Status, SizeOf(Status));

                case APostData of
                  False: IsSended:= HttpSendRequest(hReq, nil, 0, nil, 0);
                  True: IsSended:= HTTPSendRequest(hReq, PChar(AType_Access), Length(AType_Access), PChar(AParam), Length(AParam));
                end;
              end;

          end;
          if IsSended then
          begin
            StatusSize:= SizeOf(Status);
            Index:= 0;
            HttpQueryInfo(hReq, HTTP_QUERY_STATUS_CODE or HTTP_QUERY_FLAG_NUMBER, @Status, StatusSize, Index);
            if Status <> HTTP_STATUS_OK then
              Result:= AnsiString('Код ответа сервера: ' + IntToStr(Status) + sLineBreak + SysErrorMessage(GetLastError));
            pos:= 1;
            b:= 1;
            while b > 0 do
            begin // Если количество данных 0 - генерируем исключение
              if not InternetQueryDataAvailable(hReq, bytes, 0, 0) then
                Result:= AnsiString('Сервер не вернул данные! (функция InternetQueryDataAvailable)' + sLineBreak + SysErrorMessage(GetLastError));
              SetLength(Result, Cardinal(Length(Result)) + bytes);
              // Получаем данные с сервера
              InternetReadFile(hReq, @Result[Pos], bytes, b);
              Inc(Pos, b);
            end;
          end else
            Result:= AnsiString('Ошибка ' + IntToStr(GetLastError) + '!');
        finally
          InternetCloseHandle(hReq); // закрываем запрос
        end else
          Result:= AnsiString('Ошибка формирования запроса (функция HttpOpenRequest)' + sLineBreak + SysErrorMessage(GetLastError));
      finally
        InternetCloseHandle(hCon); // закрываем сессию
      end else
        Result:= AnsiString('Ошибка открытия сессии (функция InternetConnect)' + sLineBreak + SysErrorMessage(GetLastError));
    finally
      InternetCloseHandle(hInet); // закрываем соединение
    end else
      Result:= AnsiString('Отсутствует подключение к сети (функция InternetOpen)' + sLineBreak + SysErrorMessage(GetLastError));
  except
    On E: Exception do
      Result:= AnsiString('Ошибка! ' + E.ClassName + ': ' + E.Message);
  end;
end;

Кстати, если перед sendRequest задать опции

dwFlags:= dwFlags
               or SECURITY_FLAG_IGNORE_UNKNOWN_CA
               or SECURITY_FLAG_IGNORE_CERT_CN_INVALID
               or SECURITY_FLAG_IGNORE_CERT_DATE_INVALID
               or SECURITY_FLAG_IGNORE_REVOCATION;
             // Set new flags
             if not(InternetSetOption(httpRequest, INTERNET_OPTION_SECURITY_FLAGS, @dwFlags, dwSize)) then

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

Дополнение

Проблему с сертификатом решил, использую ключи: SECURITY_FLAG_IGNORE_UNKNOWN_CA or SECURITY_FLAG_IGNORE_CERT_CN_INVALID or SECURITY_FLAG_IGNORE_CERT_DATE_INVALID or SECURITY_FLAG_IGNORE_REVOCATION

Когда захожу в первый раз через IE - просит ввести пароль, при отказе ввода выводит 401, то же самое, что и в программе на текущий момент. Если введу пароль - IE дальше использует куки и ходит на сайт без проблем пока не почищу их. Лог программы:

CONNECT site.ru:443 HTTP/1.0
User-Agent: C:\Dev\Testing.exe
Host: site.ru:443
Content-Length: 0
Connection: Keep-Alive
Pragma: no-cache

HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 08:58:58.805
Connection: close
EndTime: 08:59:16.562
ClientToServerBytes: 1946
ServerToClientBytes: 6185

------------------------------------------------------------------

GET http://site.ru/cert/root.crt HTTP/1.1
Proxy-Connection: Keep-Alive
Accept: */*
User-Agent: Microsoft-CryptoAPI/10.0
Host: site.ru


HTTP/1.1 502 Fiddler - Connection Failed
Date: Mon, 27 Jan 2020 05:59:20 GMT
Content-Type: text/html; charset=UTF-8
Connection: close
Timestamp: 08:59:20.404

------------------------------------------------------------------

Лог IE:

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************


HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:42:39.636
Connection: close
EndTime: 09:42:54.716
ClientToServerBytes: 205
ServerToClientBytes: 3183



------------------------------------------------------------------

GET http://site.ru/cert/root.crt HTTP/1.1
Proxy-Connection: Keep-Alive
Accept: */*
User-Agent: Microsoft-CryptoAPI/10.0
Host: site.ru


HTTP/1.1 502 Fiddler - Connection Failed
Date: Mon, 27 Jan 2020 06:43:00 GMT
Content-Type: text/html; charset=UTF-8
Connection: close
Timestamp: 09:43:00.722



------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************


HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:42:54.747
Connection: close
EndTime: 09:42:54.785
ClientToServerBytes: 205
ServerToClientBytes: 3183



------------------------------------------------------------------ сайт не защищен (Error Code: DLG_FLAGS_INVALID_CA, нажимаю "перейти на страницу (не рекомендуется))

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************


HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:44:14.163
Connection: close
EndTime: 09:44:29.231
ClientToServerBytes: 205
ServerToClientBytes: 3183



------------------------------------------------------------------

GET http://site.ru/cert/root.crt HTTP/1.1
Proxy-Connection: Keep-Alive
Accept: */*
User-Agent: Microsoft-CryptoAPI/10.0
Host: site.ru


HTTP/1.1 502 Fiddler - Connection Failed
Date: Mon, 27 Jan 2020 06:44:35 GMT
Content-Type: text/html; charset=UTF-8
Connection: close
Timestamp: 09:44:35.225



------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************


HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:44:29.294
Connection: close
EndTime: 09:44:29.362
ClientToServerBytes: 205
ServerToClientBytes: 3183



------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************


HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:44:29.384
Connection: close
EndTime: 09:45:20.611
ClientToServerBytes: 36558
ServerToClientBytes: 168803



------------------------------------------------------------------ - ввожу пароль

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************


HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:10.675
Connection: close
EndTime: 09:45:20.620
ClientToServerBytes: 24661
ServerToClientBytes: 284264



------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************


HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:10.674
Connection: close
EndTime: 09:45:20.628
ClientToServerBytes: 21760
ServerToClientBytes: 117787



------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************


HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:10.674
Connection: close
EndTime: 09:45:12.743
ClientToServerBytes: 10519
ServerToClientBytes: 17470



------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************


HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:10.674
Connection: close
EndTime: 09:45:14.875
ClientToServerBytes: 12684
ServerToClientBytes: 57032



------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************


HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:10.673
Connection: close
EndTime: 09:45:27.157
ClientToServerBytes: 19947
ServerToClientBytes: 462607



------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************


HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:10.673
Connection: close
EndTime: 09:45:12.729
ClientToServerBytes: 10348
ServerToClientBytes: 26830



------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************


HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:10.668
Connection: close
EndTime: 09:45:29.979
ClientToServerBytes: 27178
ServerToClientBytes: 645488



------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************


HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:10.673
Connection: close
EndTime: 09:45:14.866
ClientToServerBytes: 23141
ServerToClientBytes: 63723



------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************


HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:10.673
Connection: close
EndTime: 09:45:29.563
ClientToServerBytes: 17702
ServerToClientBytes: 1107864



------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************


HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:10.675
Connection: close
EndTime: 09:45:13.329
ClientToServerBytes: 5053
ServerToClientBytes: 43534



------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************


HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:10.675
Connection: close
EndTime: 09:45:14.880
ClientToServerBytes: 19979
ServerToClientBytes: 91116



------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************


HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:12.974
Connection: close
EndTime: 09:45:21.599
ClientToServerBytes: 15295
ServerToClientBytes: 198021



------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************


HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:12.987
Connection: close
EndTime: 09:45:20.589
ClientToServerBytes: 21600
ServerToClientBytes: 221667



------------------------------------------------------------------

CONNECT piwik.mts.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: piwik.mts.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************


HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:13.368
Connection: close
EndTime: 09:45:28.443
ClientToServerBytes: 201
ServerToClientBytes: 2048



------------------------------------------------------------------

GET http://site.ru/cert/win.crt HTTP/1.1
Proxy-Connection: Keep-Alive
Accept: */*
User-Agent: Microsoft-CryptoAPI/10.0
Host: site.ru


HTTP/1.1 502 Fiddler - Connection Failed
Date: Mon, 27 Jan 2020 06:45:34 GMT
Content-Type: text/html; charset=UTF-8
Connection: close
Timestamp: 09:45:34.440



------------------------------------------------------------------

CONNECT site.ru:443 HTTP/1.0
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
Content-Length: 0
Host: site.ru
Connection: Keep-Alive
Pragma: no-cache
Proxy-Authorization: Basic ****************


HTTP/1.0 200 Connection Established
FiddlerGateway: Direct
StartTime: 09:45:16.694
Connection: close
EndTime: 09:45:21.579
ClientToServerBytes: 20336
ServerToClientBytes: 179279

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

InternetSetOption(httpConnect,INTERNET_OPTION_USERNAME,PChar('login'),SizeOf('login'));
InternetSetOption(httpConnect,INTERNET_OPTION_PASSWORD,PChar('Pass'),SizeOf('Pass'));

перед очередным sendrequest не помогает. Пробовал указывать как httpConnect, так и httpRequest

10
  • Т.е. сертификат само-подписанный? У вас есть корпоративный корневой сертификат, которым подписывается сертификат для сайта?
    – zed
    24 янв 2020 в 13:03
  • Да, есть. В логах фидлера видел 2 сертификата, полагаю, что один от сайта, второй корневой
    – aford
    24 янв 2020 в 14:09
  • Если там действительно есть корневой сертификат, то импортируется он следующим образом: Установка корневого сертификата в браузере Google Chrome
    – zed
    24 янв 2020 в 14:19
  • zed, спасибо! Но у меня же через IE доступ есть, сертификат не устанавливаю, только в сообщении браузера "Ваше подключение не защищено" нажимаю Дополнительно - продолжить и разово ввожу логин с паролем
    – aford
    24 янв 2020 в 14:59
  • У вас тут 2 проблемы: первая - с сертификатом, вторая - с авторизацией. Проблему с сертификатом можно решить либо установкой корневого сертификата, либо использованием флагов SECURITY_FLAG_IGNORE_XXX. После решения проблемы с сертификатом, смотрите снифером чем отличаются запросы/ответы вашего кода от браузера. Возможно не хватает ещё каких-то флагов/настроек/прав доступа, а возможно ещё что-то. Соответственно, желательно приложить в вопрос и логи снифера.
    – zed
    24 янв 2020 в 15:17

1 ответ 1

0

Добился подключения только через

InternetErrorDlg(Application.Handle, httpRequest,
ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED,
FLAGS_ERROR_UI_FILTER_FOR_ERRORS
or FLAGS_ERROR_UI_FLAGS_GENERATE_DATA
or FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS,
PPointer(nil)^ )

Заголовки все равно различаются, кстати, я привел неправильные заголовки в вопросе, т.к. они без https.

Ниже код модуля с готовым объектом для использования под cisco vpn, например, если вы хотите подключаться из дома к корпоративному порталу и прочему. Не претендую на чистоту кода, много лишнего и местами криво, но функции выполняет. Замечу, что логин нужно указывать как domain\login.

{
Если логин с паролем не указывать (в конструкторе или после создания), то , при
необходимости будет выскакивать окно с запросом
}

unit UnitWinInet;

interface

uses
  System.SysUtils, System.Types, WinInet, Winapi.Windows;

type

  TWinInet = class
    private
      FHWND: THandle; // Хэндл вызывающего приложения
      FClientName, // Имя клиента
      FParam, // параметры запроса (которые после ?)
      FMethod, // GET, POST и др.
      FType_Access, // mime type и проч, если установлен в '', то используется по умолчанию
      FLogin, // логин
      FPass: string; // пароль
      FPostData: boolean; //True - передача параметров запроса через post data, False - через строку запроса
      procedure SetMethod(AMethod: string);
    public
      property HWND: THandle read FHWND write FHWND;
      property ClientName: string read FClientName write FClientName;
      property Param: string read FParam write FParam;
      property Method: string read FMethod write SetMethod;
      property Type_Access: string read FType_Access write FType_Access;
      property Login: string read FLogin write FLogin;
      property Pass: string read FPass write FPass;
      property PostData: boolean read FPostData write FPostData;
      function GetHTTP(AURL: string): AnsiString;
      constructor Create(AHWND: THandle);
  end;

implementation


constructor TWinInet.Create(AHWND: THandle);
begin
  FHWND:= AHWND;
  FClientName:= 'WinInet';
  FMethod:= 'GET';
  FType_Access:= 'Content-Type: application/x-www-form-urlenDELPHId' + #13#10 +
                   'Content-Length:' + IntToStr(length(FParam));
  FPostData:= False;
end;

procedure TWinInet.SetMethod(AMethod: string);
begin
  FMethod:= UpperCase(AMethod);
end;

function TWinInet.GetHTTP(AURL: string): AnsiString;

  function GetHostName(AUrl: string): string;
  var
    s: string;
  begin // Имя хоста
    if Pos('https://', AUrl) > 0 then
      s:= 'https://'
    else
      if Pos('http://', AUrl) > 0 then
        s:= 'http://'
      else
        s:= EmptyStr;
    if s <> EmptyStr then
      if Pos(s, AUrl) > 0 then
        Delete(AUrl, 1, Length(s));
    if Pos('/', AUrl) > 0 then
      SetLength(AUrl, Pos('/', AUrl) - 1);
    Result:= AUrl;
  end;

  function GetScriptName(AUrl, AHostname: string): string;
  begin // URL после имени хоста
    Result:= EmptyStr;
    Delete(AUrl, 1, Pos(AHostname, AUrl) + Length(AHostname));
    Result:= AUrl;
  end;

  procedure SetFlags(AUrl: string; out Flags_connection, Flags_Request: Cardinal);
  begin // Определяем https или http
    if Pos('https', AUrl) > 0 then
    begin
      Flags_connection:= INTERNET_DEFAULT_HTTPS_PORT;
      Flags_Request:= INTERNET_FLAG_RELOAD
                   or INTERNET_FLAG_NO_CACHE_WRITE
                   or INTERNET_FLAG_SECURE
                   or INTERNET_FLAG_IGNORE_CERT_CN_INVALID
                   or INTERNET_FLAG_IGNORE_CERT_DATE_INVALID
                   or INTERNET_FLAG_KEEP_CONNECTION
    end else
      begin
        Flags_connection:= INTERNET_DEFAULT_HTTP_PORT;
        Flags_Request:= INTERNET_FLAG_RELOAD
                     or INTERNET_FLAG_IGNORE_CERT_CN_INVALID
                     or INTERNET_FLAG_NO_CACHE_WRITE
                     or INTERNET_FLAG_PRAGMA_NOCACHE
                     or INTERNET_FLAG_KEEP_CONNECTION;
      end;
  end;

  function GetResponseHeader(const hRequest: Pointer): string;
  var
    dwSize, Index: DWORD;
    szBuff: array [0..1024] of Char;
  begin // Возвращает заголовок ответа сервера в виде строк с CR/LF
    Index:= 0;
    dwSize:= SizeOf(szBuff);
    HttpQueryInfo(hRequest, HTTP_QUERY_RAW_HEADERS_CRLF, @szBuff, dwSize, Index);
    Result:= PChar(@szBuff);
  end;

  function GetStatus(const hRequest: Pointer): DWORD;
  var
    dwSize, dwStatus, Index: DWORD;
  begin // Возвращает заголовок ответа сервера в виде строк с CR/LF
    // Возвращает код статуса HTTP из заголовка ответа
    Index:= 0;
    dwSize:= SizeOf(dwStatus);
    HttpQueryInfo(hRequest, HTTP_QUERY_STATUS_CODE or HTTP_QUERY_FLAG_NUMBER, @dwStatus, dwSize, Index);
    Result:= dwStatus;
  end;

  function AddSecurityFlags(httpReq: Pointer): Boolean;
  var
    dwSize, dwFlags: DWORD;
  begin
    Result:= False;
    dwSize:= SizeOf(dwFlags);     // Get the current security flags
    if (InternetQueryOption(httpReq, INTERNET_OPTION_SECURITY_FLAGS, @dwFlags, dwSize)) then
    begin // Add desired flags
       dwFlags:= dwFlags
         or SECURITY_FLAG_IGNORE_UNKNOWN_CA
         or SECURITY_FLAG_IGNORE_CERT_CN_INVALID
         or SECURITY_FLAG_IGNORE_CERT_DATE_INVALID
         or SECURITY_FLAG_IGNORE_REVOCATION;
       Result:= (InternetSetOption(httpReq,
              INTERNET_OPTION_SECURITY_FLAGS,
              @dwFlags,
              dwSize));
    end
  end;

  function SendRequest(httpRequest: Pointer; AType_Access, AParam: string): boolean;
  begin
    case FPostData of
      False: Result:= HttpSendRequest(httpRequest, nil, 0, nil, 0);
      True: Result:= HttpSendRequest(httpRequest, PChar(AType_Access), Length(AType_Access), PChar(AParam), Length(AParam));
    end;
  end;

var
  httpSession, httpConnect, httpRequest: HINTERNET;
  bytes, b, pos: Cardinal;
  hostname, script: string;
  Flags_connection, Flags_Request: Cardinal;
  DlgError: DWORD;
begin
  Result:= EmptyAnsiStr;
  hostname:= GetHostName(AURL); // имя хоста
  script:= GetScriptName(AURL, hostname); // скрипт
  // установка доп. параметров
  if not FPostData then // если передаем параметры через строку запроса, то
    if FParam <> EmptyStr then // дополняем скрипт
      if script[Length(script)] = '?' then
        script:= script + FParam
      else
        script:= script + '?' + FParam;
  try
    SetFlags(AURL, Flags_connection, Flags_Request); // Устанавливаем флаги (http или https)
    // Открываем сессию (инициализируем WinInet)
    httpSession:= InternetOpen(PChar(FClientName), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
    if Assigned(httpSession) then // Проверяем хэндл
    try // Открываем соединение
      httpConnect:= InternetConnect(httpSession, PChar(hostname), Flags_connection, nil, nil, INTERNET_SERVICE_HTTP, 0, 0);
      if Assigned(httpConnect) then // Проверяем хэндл
      try // Открываем запрос (передаем остаток URL (скрипт GetScriptName) в ф-ю HttpOpenRequest под параметром lpszObjectName)
        httpRequest:= HttpOpenRequest(httpConnect, PChar(FMethod), PChar(script), HTTP_VERSION, nil, nil, Flags_Request, 0);
        if Assigned(httpRequest) then
        try
          AddSecurityFlags(httpRequest);
          SendRequest(httpRequest, FType_Access, FParam); // Отправляем запрос
          if GetStatus(httpRequest) = HTTP_STATUS_DENIED then
          begin // Если необходима авторизация
            if FLogin <> EmptyStr then
            begin
              InternetSetOption(httpRequest, INTERNET_OPTION_USERNAME, PChar(FLogin), SizeOf(FLogin));
              InternetSetOption(httpRequest, INTERNET_OPTION_PASSWORD, PChar(FPass), SizeOf(FPass));
            end
              else
              begin
                DlgError:= InternetErrorDlg(FHWND, httpRequest,
                   ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED,
                   FLAGS_ERROR_UI_FILTER_FOR_ERRORS
                or FLAGS_ERROR_UI_FLAGS_GENERATE_DATA
                   //or FLAGS_ERROR_UI_SERIALIZE_DIALOGS
                or FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS,
                   PPointer(nil)^ );
                if DlgError = 0 then
                begin
                  Result:= AnsiString('Доступ запрещен! Ввод учетных данных отменен.'
                   + sLineBreak + SysErrorMessage(GetLastError));
                  Exit;
                end;
              end;
            SendRequest(httpRequest, FType_Access, FParam);
          end;
          if GetStatus(httpRequest) = HTTP_STATUS_OK then
          begin
            pos:= 1;
            b:= 1;
            while b > 0 do
            begin // Если количество данных 0 - генерируем исключение
              if not InternetQueryDataAvailable(httpRequest, bytes, 0, 0) then
                Result:= AnsiString('Сервер не вернул данные! (функция InternetQueryDataAvailable)' + sLineBreak + SysErrorMessage(GetLastError));
              SetLength(Result, Cardinal(Length(Result)) + bytes);
              // Получаем данные с сервера
              InternetReadFile(httpRequest, @Result[Pos], bytes, b);
              Inc(Pos, b);
            end;
            Result:= Result + AnsiString(sLineBreak + SysErrorMessage(GetLastError));
          end else
            Result:= AnsiString('ОШИБКА ' + IntToStr(GetStatus(httpRequest)) + sLineBreak + SysErrorMessage(GetLastError));
        finally
          InternetCloseHandle(httpRequest); // закрываем запрос
        end else
          Result:= AnsiString('Ошибка формирования запроса (функция HttpOpenRequest)' + sLineBreak + SysErrorMessage(GetLastError));
      finally
        InternetCloseHandle(httpConnect); // закрываем соединение
      end else
        Result:= AnsiString('Ошибка открытия сессии (функция InternetConnect)' + sLineBreak + SysErrorMessage(GetLastError));
    finally
      InternetCloseHandle(httpSession); // закрываем сессию
    end else
      Result:= AnsiString('Отсутствует подключение к сети (функция InternetOpen)' + sLineBreak + SysErrorMessage(GetLastError));
  except
    On E: Exception do
      Result:= AnsiString('Ошибка! ' + E.ClassName + ': ' + E.Message);
  end;
end;

end.

Использование:

uses
  ..., UnitWinInet;
...
  Client:= TWinInet.Create(FrmTesting.Handle);
  with Client do
  try
    if FrmTesting.CheckBox1.Checked then
    begin
      Login:= 'Domen\login';
      Pass:= 'Password';
    end;
    FHTTPResult:= GetHTTP(FrmTesting.Edt1.Text);    
  finally
    FreeAndNil(Client);
  end;
2
  • Ошибка ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED говорит, что сервер запрашивает авторизацию через сертификат клиента. И раз у вас получается работать с сервером авторизуясь по паролю, значит авторизация через сертификат является опциональной. И в этом случае, серверу можно заранее сказать, что сертификата нет: Optional Client SSL Certificates
    – zed
    31 янв 2020 в 10:09
  • Или можно попробовать вот так: stackoverflow.com/a/10000752
    – zed
    31 янв 2020 в 10:14

Ваш ответ

By clicking “Отправить ответ”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками или задайте свой вопрос.