使用 WebHooks 从 Delphi 向 Teams 发布消息

使用 WebHooks 从 Delphi 向 Teams 发布消息

想要从 Delphi 应用程序向 Teams 频道发送消息？

这很简单 - 只需将消息发布到您的团队频道的 WebHook URL。

更新 - 添加了 Uwe Raabe 的 TRESTClient 版本。

好吧，也许不是这些钩子。

Pexels.com 上的cottonbro 拍摄的照片

以下是有关如何从 Delphi 执行此操作的低级基础知识。您只需使用预先格式化的 Json 字符串执行 http 帖子即可。

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;

在开始向 Teams 频道发送垃圾邮件之前，请务必阅读限制和其他参与规则。有关更多详细信息，请参阅有关 WebHooks 的 MS 文章。

更新！ Uwe Raabe做了一个翻新版本，消除了 Indy 和 OpenSLL DLL 的需要，并使代码跨平台工作！

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.