Search code examples
delphimicrosoft-edgecryptoapimutual-authentication

Delphi mutual authentication


I use the WinINet library to connect to a website.

Using the Internet Explorer (Win10) it works and shows me the message to select the certificate to use.

This is the delphi code I call:

FUNCTION TRAD.lastOrganization(): Integer;
VAR
  js:TlkJSONobject;
  ws: TlkJSONstring;
  url, resp: String;
  count,statusCodeLen, bodyCodeLen: Cardinal;
  header,tmp: String;
  buffer, body: String;
  statusCode: ARRAY [0 .. 1024] OF Char;
  bodyCode: ARRAY [0 .. 1024] OF Char;
  UrlHandle: HINTERNET;
BEGIN
  buffer := '00000000000000000000';
  url := contextUrl + '/rest/organization/count';
  UrlHandle := InternetOpenUrl(NetHandle, PChar(url), nil, 0, INTERNET_FLAG_RELOAD, 0);
  IF NOT ASSIGNED(UrlHandle) THEN
    SHOWMESSAGE('Unable to read the amount of Organization using the URL ' + url + ': ' +  SysErrorMessage(GetLastError));
  statusCodeLen := Length(statusCode);
  bodyCodeLen := Length(bodyCode);
  count := 0;
  IF HttpQueryInfo(UrlHandle, HTTP_QUERY_STATUS_CODE, @statusCode[0], statusCodeLen, count) THEN
  BEGIN
    buffer := statusCode;
    IF buffer <> '200' THEN
    BEGIN
      ShowMessage('While read amount of Organization I got a status code ' + buffer + ' but 200 was expected.');
      EXIT;
    END;
  END;

  count := 0;
  body := '';
  REPEAT
    FillChar(bodyCode, bodyCodeLen, 0);
    IF NOT InternetReadFile(UrlHandle, @bodyCode[0], bodyCodeLen, count) THEN
    BEGIN
      ShowMessage('Problem on reading from response stream while read the amount of Organization using the URL ' + url + '.');
      EXIT;
    END;
    IF count > 0 THEN
    BEGIN
      tmp := bodyCode;
      body := body + LeftStr(tmp, count);
    END;
  UNTIL count = 0;

  InternetCloseHandle(UrlHandle);
  Result := strtoint(body);
END;

If I call the method, I get this message:

enter image description here

Buuut, using the Edge-Browser I have to specify a certificate, and it works just great.

enter image description here

Question

How to specify the certificate?

Edit (new informations):

If I change the code to

FUNCTION TRAD.lastOrganization(): Integer;
VAR
  js:TlkJSONobject;
  ws: TlkJSONstring;
  url, resp: String;
  count,statusCodeLen, bodyCodeLen: Cardinal;
  header,tmp: String;
  buffer, body: String;
  statusCode: ARRAY [0 .. 1024] OF Char;
  bodyCode: ARRAY [0 .. 1024] OF Char;
  UrlHandle: HINTERNET;
BEGIN
  buffer := '00000000000000000000';
  url := contextUrl + '/rest/organization/count';
  UrlHandle := InternetOpenUrl(NetHandle, PChar(url), nil, 0, INTERNET_FLAG_RELOAD, 0);
  IF NOT ASSIGNED(UrlHandle) THEN
    raiseLastOSError();

It shows: enter image description here


Solution

  • Consider the use of InternetErrorDlg

    Code example:

    function WebSiteConnect(const UserAgent: string; const Server: string; const Resource: string;): string;
    var
      hInet: HINTERNET;
      hConn: HINTERNET;
      hReq:  HINTERNET;
      dwLastError:DWORD;
    
      nilptr:Pointer;
      dwRetVal:DWORD;
    
      bLoop: boolean;
      port:Integer;
    begin
      hInet := InternetOpen(PChar(UserAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
      if hInet = nil then exit;
      hConn := InternetConnect(hInet, PChar(Server), INTERNET_DEFAULT_HTTPS_PORT, nil, nil, INTERNET_SERVICE_HTTP, 0, 0);
      if hConn = nil then
      begin
        InternetCloseHandle(hInet);
        exit;
      end;
      hReq := HttpOpenRequest(hConn, 'GET', PChar(Resource), 'HTTP/1.0', nil, nil, INTERNET_FLAG_SECURE, 0);
      if hReq = nil then
      Begin
        InternetCloseHandle(hConn);
        InternetCloseHandle(hInet);
        exit;
      end;
    
      bLoop := true;
      while bLoop do
      begin
        if HttpSendRequest(hReq, nil, 0, nil, 0) then
          dwLastError := ERROR_SUCCESS
        else
          dwLastError:= GetLastError();
    
        if dwLastError = ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED then
        begin
          dwRetVal:= InternetErrorDlg(application.handle, hReq, dwLastError,
          FLAGS_ERROR_UI_FILTER_FOR_ERRORS or
          FLAGS_ERROR_UI_FLAGS_GENERATE_DATA or
          FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS,
          nilptr );
    
          if dwRetVal = ERROR_INTERNET_FORCE_RETRY then
            continue
          else  // CANCEL button
          begin
            InternetCloseHandle(hReq);
            InternetCloseHandle(hConn);
            InternetCloseHandle(hInet);
            exit;
          end;
        end
        else
          bLoop := false;
      end;
      Result:= ...
    end;