aford
aford

Reputation: 21

Delphi. WinInet + cisco + NTLM. 12045 and 12057 errors

I connect to the corporate network through Cisco, and then through domain NTLM authorization to the corporate https site.

So I go through the proxy (it’s enough to log in with the password once in IE) and the program goes to all sites except the corporate one, it fails with error 12045 (ERROR_INTERNET_INVALID_CA) or 12057.

How to get a certificate from the store? Naturally, without using a username with a password and certificate name. Help, please, who knows. I tried it also through http.

Here is the function:

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

  function GetHostName(AUrl: string): string;
  var
    s: string;
  begin // Host name
    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
    Result:= EmptyStr;
    Delete(AUrl, 1, Pos(AHostname, AUrl) + Length(AHostname));
    Result:= AUrl;
  end;

  procedure SetFlags(AUrl: string; out Flags_connection, Flags_Request: Cardinal);
  begin // http or https choosing
    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); // hostname
  script:= GetScriptName(AUrl, hostname); // script
  // установка доп. параметров
  if not APostData then // if passing params through URL
    if AParam <> EmptyStr then // then add to script
      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
    // set flags (http или https)
    SetFlags(AUrl, Flags_connection, Flags_Request);
    // WinInet init
    hInet:= InternetOpen(PChar(Application.ExeName), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0); //
    if Assigned(hInet) then
    try
      // open session
      hCon:= InternetConnect(hInet, PChar(hostname), Flags_connection, nil, nil, INTERNET_SERVICE_HTTP, 0, 1);
      if Assigned(hCon) then
      try
        // open request
        hReq:= HttpOpenRequest(hCon, PChar(UpperCase(AMethod)), PChar(script), HTTP_VERSION, nil, nil, Flags_Request, 1);
        if Assigned(hReq) then
        try // send request
          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 // cert error
          begin
                        // autorization window
              {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('cert error!');
                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 
              if not InternetQueryDataAvailable(hReq, bytes, 0, 0) then
                Result:= AnsiString('data is empty! (function InternetQueryDataAvailable)' + sLineBreak + SysErrorMessage(GetLastError));
              SetLength(Result, Cardinal(Length(Result)) + bytes);
              // get data from server
              InternetReadFile(hReq, @Result[Pos], bytes, b);
              Inc(Pos, b);
            end;
          end else
            Result:= AnsiString('Error ' + IntToStr(GetLastError) + '!');
        finally
          InternetCloseHandle(hReq); // close request
        end else
          Result:= AnsiString('Error (function HttpOpenRequest)' + sLineBreak + SysErrorMessage(GetLastError));
      finally
        InternetCloseHandle(hCon); // close session
      end else
        Result:= AnsiString('Error (function InternetConnect)' + sLineBreak + SysErrorMessage(GetLastError));
    finally
      InternetCloseHandle(hInet); // close connection
    end else
      Result:= AnsiString('Error (function InternetOpen)' + sLineBreak + SysErrorMessage(GetLastError));
  except
    On E: Exception do
      Result:= AnsiString('Error! ' + E.ClassName + ': ' + E.Message);
  end;
end;

Addition

I solved the problem with the certificate, using the keys:

SECURITY_FLAG_IGNORE_UNKNOWN_CA
or SECURITY_FLAG_IGNORE_CERT_CN_INVALID
or SECURITY_FLAG_IGNORE_CERT_DATE_INVALID or
SECURITY_FLAG_IGNORE_REVOCATION

But now I getting 401 auth error.

Program Log:

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 Log (not fully but last response code is 200):

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



------------------------------------------------------------------ This site is not secure, I press "Go on to the webpage (not recommended)"

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



------------------------------------------------------------------ - entering password

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

The application does not send headers with basic authentication... How to fix it?

Upvotes: 1

Views: 670

Answers (1)

aford
aford

Reputation: 21

Login have to be with a domain name, eg Domain\Login

The code below is working for me:


//If you don`t pass credentials (while creating object or after that) then request window will appear 

unit UnitWinInet;

interface

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

type

  TWinInet = class
    private
      FHWND: THandle; 
      FClientName, 
      FParam, 
      FMethod, 
      FType_Access, 
      FLogin, 
      FPass: string; 
      FPostData: boolean; 
      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
    Result:= EmptyStr;
    Delete(AUrl, 1, Pos(AHostname, AUrl) + Length(AHostname));
    Result:= AUrl;
  end;

  procedure SetFlags(AUrl: string; out Flags_connection, Flags_Request: Cardinal);
  begin 
    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 
    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 
    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);    
    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 
        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('Access Denied! Credential Entry Canceled.'
                   + 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 
              if not InternetQueryDataAvailable(httpRequest, bytes, 0, 0) then
                Result:= AnsiString(SysErrorMessage(GetLastError));
              SetLength(Result, Cardinal(Length(Result)) + bytes);              
              InternetReadFile(httpRequest, @Result[Pos], bytes, b);
              Inc(Pos, b);
            end;
            Result:= Result + AnsiString(SysErrorMessage(GetLastError));
          end else
            Result:= AnsiString(SysErrorMessage(GetLastError));
        finally
          InternetCloseHandle(httpRequest); 
        end else
          Result:= AnsiString(SysErrorMessage(GetLastError));
      finally
        InternetCloseHandle(httpConnect); 
      end else
        Result:= AnsiString(sLineBreak + SysErrorMessage(GetLastError));
    finally
      InternetCloseHandle(httpSession); 
    end else
      Result:= AnsiString(SysErrorMessage(GetLastError));
  except
    On E: Exception do
      Result:= AnsiString('Error! ' + E.ClassName + ': ' + E.Message);
  end;
end;

end.

How to use:

uses
  ..., WinInet;
...
  Client:= TWinInet.Create(FrmTesting.Handle);
  with Client do
  try
    if FrmTesting.CheckBox1.Checked then
    begin
      Login:= 'Domain\login';
      Pass:= 'Password';
    end;
    FHTTPResult:= GetHTTP(FrmTesting.Edt1.Text);    
  finally
    FreeAndNil(Client);
  end;

Upvotes: 1

Related Questions