Thema: Delphi TRestClient TLS Win7

Einzelnen Beitrag anzeigen

TiGü

Registriert seit: 6. Apr 2011
Ort: Berlin
3.070 Beiträge
 
Delphi 10.4 Sydney
 
#7

AW: TRestClient TLS Win7

  Alt 23. Okt 2018, 15:46
Hier Quelltext zum sehen und verstehen.
Ich hooke hier die WinHttpSendRequest, um die beiden Aufrufe von WinHttpSetOption in TWinHTTPClient.DoExecuteRequest nicht zu stören.

Einfach die Detours-Units von GitHub ziehen, zum Projekt hinzufügen, entsprechend der Vorgabe hooken und dann ist gut.

Delphi-Quellcode:
unit RestAsync.View;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,

  REST.Client,
  REST.Types,
  REST.HttpClient,
  IPPeerClient,
  System.Json,
  System.Net.URLClient,

  DDetours,
  Winapi.WinHTTP;

type
  TForm4 = class(TForm)
    Button1: TButton;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    FRESTClient: TRESTClient;
    FRESTRequest: TRESTRequest;
    FRESTResponse: TRESTResponse;
  public
  end;

var
  TrampolineWinHttpSendRequest: function(hRequest: HINTERNET; lpszHeaders: LPCWSTR;
    dwHeadersLength: DWORD; lpOptional: Pointer; dwOptionalLength: DWORD;
    dwTotalLength: DWORD; dwContext: DWORD_PTR): BOOL; stdcall = nil;

function InterceptWinHttpSendRequest(hRequest: HINTERNET; lpszHeaders: LPCWSTR;
  dwHeadersLength: DWORD; lpOptional: Pointer; dwOptionalLength: DWORD;
  dwTotalLength: DWORD; dwContext: DWORD_PTR): BOOL; stdcall;

var
  Form4: TForm4;

implementation

{$R *.dfm}


procedure TForm4.FormDestroy(Sender: TObject);
begin
  FRESTResponse.Free;
  FRESTRequest.Free;
  FRESTClient.Free;

  if Assigned(TrampolineWinHttpSendRequest) then
  begin
    InterceptRemove(@TrampolineWinHttpSendRequest);
    TrampolineWinHttpSendRequest := nil;
  end;
end;

function InterceptWinHttpSendRequest(hRequest: HINTERNET; lpszHeaders: LPCWSTR;
  dwHeadersLength: DWORD; lpOptional: Pointer; dwOptionalLength: DWORD;
  dwTotalLength: DWORD; dwContext: DWORD_PTR): BOOL;
var
  OptionValue: DWORD;
begin
  // https://docs.microsoft.com/de-de/windows/desktop/WinHttp/option-flags
  OptionValue := WINHTTP_FLAG_SECURE_PROTOCOL_TLS1_1 or WINHTTP_FLAG_SECURE_PROTOCOL_TLS1_2;
  WinHttpSetOption(hRequest, WINHTTP_OPTION_SECURE_PROTOCOLS, @OptionValue, SizeOf(OptionValue));

  Result := TrampolineWinHttpSendRequest(hRequest, lpszHeaders, dwHeadersLength, lpOptional, dwOptionalLength, dwTotalLength, dwContext);
end;

procedure TForm4.FormCreate(Sender: TObject);
begin
  if not Assigned(TrampolineWinHttpSendRequest) then
  begin
    @TrampolineWinHttpSendRequest := InterceptCreate(@WinHttpSendRequest, @InterceptWinHttpSendRequest);
  end;

  FRESTClient := TRESTClient.Create(nil);
  FRESTRequest := TRESTRequest.Create(nil);
  FRESTResponse := TRESTResponse.Create(nil);

  FRESTRequest.Client := FRESTClient;
  FRESTRequest.Response := FRESTResponse;
end;

procedure TForm4.Button1Click(Sender: TObject);
var
  MyCompletionHandler: TCompletionHandler;
  MyErrorCompletionHandler: TCompletionHandlerWithError;
begin
  FRESTClient.BaseURL := 'http://www.codigopostal.gov.co';
  FRESTClient.RaiseExceptionOn500 := False;

  FRESTRequest.ClearBody;

  FRESTRequest.AddParameter('municipio', 'Santa Marta');
  FRESTRequest.AddParameter('departamento', 'Magdalena');
  FRESTRequest.AddParameter('direccion', 'Cra. 16 1c-20');
  FRESTRequest.Resource := 'glow/param';

  // mit den anonymen Methoden dient nur als Beispiel, kann natürlich auch mit klassischen Methoden gelöst werden:
  MyCompletionHandler := procedure
    begin
      if FRESTResponse.StatusCode = 200 then
      begin
        ShowMessage(FRESTResponse.Content);
      end
      else
        ShowMessage('Ist alles oll!');
    end;

  MyErrorCompletionHandler := procedure(AObject: TObject)
    begin
      ShowMessage('Zoooonk!!!');
    end;

  FRESTRequest.ExecuteAsync(MyCompletionHandler, True, True, MyErrorCompletionHandler);
end;

end.
  Mit Zitat antworten Zitat