unit O365WebHook;

// Lars Fosdal, 2020 OCT 16
// Simple example without error handling

interface
uses
  System.Classes, System.SysUtils, System.Json, Rest.Json,
  IDGlobal, IdHTTP, IdIOHandler, IdSSL, IdSSLOpenSSL;

type
  TWebHookMessage = class
  end;

/// <summary> See https://docs.microsoft.com/en-us/microsoftteams/platform/webhooks-and-connectors/how-to/connectors-using
/// for examples of how to structure the json for creating advanced formats</summary>
  TSimpleText = class(TWebHookMessage)
  private
    FText: String;
  public
    property Text: String read FText write FText;
    constructor Create(const aText: string);
  end;

type
  TWebHook = class
  private
    FHTTP: TIdHTTP;
    FURL: string;
  protected
    property HTTP: TIdHTTP read FHTTP;
  public
    constructor Create(const aURL: string = '');
    destructor Destroy; override;

    procedure Post(const aJson: string);
    procedure PostMessage(const aMsg: TWebhookMessage);

    property URL:String read FURL write FURL;
  end;


implementation

{ TWebHook }

constructor TWebHook.Create(const aURL: string);
begin
  FURL := aURL;
  // Remember that you need libeay32.dll and ssleay32.dll in the path for https to work
  FHTTP := TIdHTTP.Create(nil);
  HTTP.Request.ContentType := 'application/json';
  HTTP.Request.ContentEncoding := 'utf-8';
  HTTP.Request.CacheControl := 'no-cache';
  HTTP.HTTPOptions := HTTP.HTTPOptions - [hoForceEncodeParams] + [hoNoProtocolErrorException, hoWantProtocolErrorContent];
end;

destructor TWebHook.Destroy;
begin
  FHTTP.Free;
  inherited;
end;

procedure TWebHook.Post(const aJson: string);
var
  ReqString: TStringList;
  ResStream: TStringStream;
begin
  ReqString := TStringList.Create;
  try
    try
      ReqString.Text := aJson;
      ResStream := TStringStream.Create;
      try
//        DebugOut('HTTP Post ' + ReqString.Text);
        HTTP.Post(URL, ReqString, ResStream, IndyTextEncoding_UTF8);
//        DebugOut('Response: ' + ResStream.DataString);
      finally
        ResStream.Free;
      end;
    except // HTTP Exception
      on E: Exception
      do begin
//        DebugOutException(E, 'HTTP Post');
      end;
    end;
  finally
    ReqString.Free;
  end;
end;

procedure TWebHook.PostMessage(const aMsg: TWebhookMessage);
begin
  try
    Post(
      TJson.ObjectToJsonString(
        aMsg,
        [joIgnoreEmptyStrings, joIgnoreEmptyArrays, joDateIsUTC, joDateFormatISO8601]
      )
    );
  finally
    aMsg.Free;
  end;
end;

{ TSimpleText }

constructor TSimpleText.Create(const aText: string);
begin
  Text := aText;
end;

end.

procedure TestExampleToATeamsChannel;
var
  Teams: TWebhook;
begin
  Teams := TWebhook.Create('https:// ... YourLongWebHookURLHere ... ');
  try
    Teams.PostMessage(TSimpleText.Create('Hello from Delphi! :"{/=''æ}[øå] ÆØÅ'));
  finally
    Teams.Free;
  end;
end;

unit O365WebHook;

// Lars Fosdal, 2020 OCT 16
// Simple example without error handling
// Uwe Raabe replaced Indy for TRESTClient, eliminating the need for the OpenSLL DLLS

interface
uses
  System.Classes, System.SysUtils,
  REST.Json, REST.Client, REST.Types;

type
  TWebHookMessage = class
  end;

/// <summary> See https://docs.microsoft.com/en-us/microsoftteams/platform/webhooks-and-connectors/how-to/connectors-using
/// for examples of how to structure the json for creating advanced formats</summary>
  TSimpleText = class(TWebHookMessage)
  private
    FText: String;
  public
    property Text: String read FText write FText;
    constructor Create(const aText: string);
  end;

type
  TWebHook = class
  private
    FClient: TRESTClient;
    FRequest: TCustomRESTRequest;
    FURL: string;
  protected
    property Client: TRESTClient read FClient;
    property Request: TCustomRESTRequest read FRequest;
  public
    constructor Create(const aURL: string = '');
    destructor Destroy; override;
    function PostMessage(const aMsg: TWebhookMessage; aOwnsMsg: Boolean = False): Boolean;
    property URL: string read FURL write FURL;
  end;

implementation

{ TWebHook }

constructor TWebHook.Create(const aURL: string);
begin
  inherited Create;
  FURL := aURL;

  FClient := TRESTClient.Create(nil);
  FRequest := TCustomRESTRequest.Create(nil);
  FRequest.Client := FClient;
end;

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

function TWebHook.PostMessage(const aMsg: TWebhookMessage; aOwnsMsg: Boolean = False): Boolean;
begin
  try
    Request.Client.BaseURL := URL;
    Request.Method := rmPOST;
    Request.AddBody(aMsg);
    Request.Execute;
    Result := Request.Response.Status.Success;
  finally
    if aOwnsMsg then
      aMsg.Free;
  end;
end;

{ TSimpleText }

constructor TSimpleText.Create(const aText: string);
begin
  inherited Create;
  FText := aText;
end;

end.