unit ExtRtcHttpReq;

{$mode objfpc}{$H+}

interface

uses
  // RTC
  rtcInfo, rtcHttpCli, rtcDataCli, rtcConn,
  //
  Classes, SysUtils;

type

  { TRtcRequestWrapper }

  TRtcRequestWrapper = class
  private
    FRequest: TRtcDataRequest;
    FClient: TRtcHttpClient;
    FContent: string;
    FResponse: string;
    FConnectionError: string;
    FStatusCode: Integer;
    FStatusText: string;
    procedure BeginRequest(Sender: TRtcConnection);
    procedure ConnectError(Sender: TRtcConnection; E: Exception);
    procedure ConnectFail(Sender: TRtcConnection);
    procedure DataReceived(Sender: TRtcConnection);
  public
    constructor Create(const Method, Url, FileName, ContentType, Content: string; const UserName: string = ''; const UserPassword: string = '');
    destructor Destroy; override;
    procedure Execute;
    //property Client: TRtcHttpClient read FClient;
    //property Request: TRtcDataRequest read FRequest;
    property ResponseText: string read FResponse;
    property StatusCode: Integer read FStatusCode;
    property StatusText: string read FStatusText;
  end;

function HttpRequest(const Method, Url, FileName, ContentType, Content: string; out ContentOut: string; const UserName: string = ''; const UserPassword: string = ''): Integer;

var
  // Ожидание ответа после установки соединения
  RequestAfterConnectTimeout: Integer = 10;

resourcestring
  STimeoutExpired = 'Connection problems, response timed out';

implementation

uses
  StrUtils;

{ HttpRequest }

function HttpRequest(const Method, Url, FileName, ContentType, Content: string; out ContentOut: string; const UserName, UserPassword: string): Integer;
begin
  with TRtcRequestWrapper.Create(Method, Url, FileName, ContentType, Content, UserName, UserPassword) do
  try
    Execute;
    ContentOut := ResponseText;
    Result := StatusCode;
  finally
    Free;
  end;
end;

{ ExtractUrlParams }

procedure ExtractUrlParams(const Url: string; out UseSSL: Boolean; out ServerAddr, ServerPort: string);
var
  I: SizeInt;
begin
  ServerAddr := Url;
  UseSSL := AnsiStartsText('https://', ServerAddr);
  if UseSSL then
    Delete(ServerAddr, 1, Length('https://'))
  else if AnsiStartsText('http://', ServerAddr) then
    Delete(ServerAddr, 1, Length('http://'));
  I := Pos(':', ServerAddr);
  if I > 0 then
  begin
    ServerPort := Copy(ServerAddr, I + 1, Length(ServerAddr) - 2);
    SetLength(ServerAddr, I - 1);
  end else
    ServerPort := BoolToStr(UseSSL, '443', '80');
end;

{ TRtcRequestWrapper }

procedure TRtcRequestWrapper.BeginRequest(Sender: TRtcConnection);
begin
  with TRtcDataClient(Sender) do
    Write(FContent);
end;

procedure TRtcRequestWrapper.ConnectError(Sender: TRtcConnection; E: Exception);
begin
  FConnectionError := Format('Connection Error (%s): %s', [E.ClassName, E.Message]);
end;

procedure TRtcRequestWrapper.ConnectFail(Sender: TRtcConnection);
begin
  FConnectionError := 'Connection Fail';
end;

procedure TRtcRequestWrapper.DataReceived(Sender: TRtcConnection);
begin
  with TRtcDataClient(Sender) do
    if Response.Done then
    begin
      FResponse := FResponse + Read;
      FStatusCode := Response.StatusCode;
      FStatusText := Response.StatusText;
    end;
end;

constructor TRtcRequestWrapper.Create(const Method, Url, FileName, ContentType, Content, UserName, UserPassword: string);
var
  UseSSL: Boolean;
  ServerAddr, ServerPort: string;
begin
  ExtractUrlParams(Url, UseSSL, ServerAddr, ServerPort);

  FClient := TRtcHttpClient.Create(nil);
  FClient.OnConnectError := @ConnectError;
  FClient.OnConnectFail := @ConnectFail;
  FClient.ServerAddr := ServerAddr;
  FClient.ServerPort := ServerPort;
  FClient.UseSSL := UseSSL;
  FClient.AutoConnect := True;
  FClient.ReconnectOn.ConnectLost := True;
  FClient.Blocking := True;
  FClient.UserLogin.UserName := UserName;
  FClient.UserLogin.UserPassword := UserPassword;
  //
  //FClient.MultiThreaded := True;
  FClient.Timeout.AfterConnect := RequestAfterConnectTimeout;

  FRequest := TRtcDataRequest.Create(nil);
  FRequest.OnBeginRequest := @BeginRequest;
  FRequest.OnDataReceived := @DataReceived;
  FRequest.Client := FClient;
  FRequest.Request.Method := Method;
  FRequest.Request.Host := ServerAddr;
  FRequest.Request.FileName := FileName;
  FRequest.Request.ContentType := ContentType;

  FContent := Content;
end;

destructor TRtcRequestWrapper.Destroy;
begin
  FRequest.Free;
  FClient.Free;
  inherited Destroy;
end;

procedure TRtcRequestWrapper.Execute;
begin
  FRequest.Post;
  if FClient.TimedOut then
    raise Exception.Create(STimeoutExpired);
  if FConnectionError > '' then
    raise Exception.Create(FConnectionError);
end;

end.