【Delphi】用于企业微信发送信息的示例程序(要求Delphi 10.1及更新版本）

 

 

unit uMainForm;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private const //以下三个常量的值需更换为实际值
    CorpID = 'xxxxxxxxxxxxxxxx';
    AgendID = '1234567';
    Secret = '############################################';
  private
    WeWork: TWeWork;
  public
    constructor Create(aOwner: TComponent); override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses uTextBuilder;

constructor TForm1.Create(aOwner: TComponent);
begin
  inherited;
  OnCreate  := FormCreate;
  OnDestroy := FormDestroy;
  Button1.OnClick := Button1Click;
  Button2.OnClick := Button2Click;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  WeWork := TWeWork.Create(CorpID, AgendID, Secret);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  WeWork.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  JObj: TJSONObject;
begin
  TTextBuilder.Create
    .Add('你的快递已到，请携带工卡前往邮件中心领取。')
    .Add('出发前可查看<a href="http://work.weixin.qq.com">邮件中心视频实况</a>，聪明避开排队');

  JObj := WeWork.SendAppMsg('aUserName', TTextBuilder.Text); //注意：aUserName需更换为实际用户名
  Memo1.Lines.Text := JObj.Format;
  JObj.Free;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  TTextBuilder.Create
    .Add('您的会议室已经预定，稍后会同步到`邮箱`')
    .Add('> **事项详情**')
    .Add('> 事　项：<font color="info">开会</font>')
    .Add('> 组织者：@miglioguan')
    .Add('> 参与者：@miglioguan、@kunliu、@jamdeezhou、@kanexiong、@kisonwang')
    .Add('> ')
    .Add('> 会议室：<font color="info">广州TIT 1楼 301</font>')
    .Add('> 日　期：<font color="warning">2018年5月18日</font>')
    .Add('> 时　间：<font color="comment">上午9:00-11:00</font>')
    .Add('> ')
    .Add('> 请准时参加会议。')
    .Add('> ')
    .Add('> 如需修改会议信息，请点击：[修改会议信息](https://work.weixin.qq.com)"');

  with WeWork.SendAppMarkDown('aUserName', TTextBuilder.Text) do //注意：aUserName需更换
  begin
    Memo1.Lines.Text := Format;
    Free;
  end;
end;

end.

unit uWeWork;

interface

uses
  System.Classes, System.SysUtils, System.DateUtils, System.JSON,
  System.JSON.Types, System.JSON.Writers, System.JSON.Builders,
  IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP;

type
  TWeWork = class(TObject)
  private const
    CPrefix  : String = 'https://qyapi.weixin.qq.com/cgi-bin/';
    CTokenURL: String = 'gettoken?corpid=ID&corpsecret=SECRET';
    CMsgUrl  : String = 'message/send?access_token=ACCESS_TOKEN';
  private
    FHttp: TIdHTTP;
    FExpireTime: TDateTime;
    FCorpID, FAgentID, FSecret, FToken: String;
    FSourceStream  : TStringStream;
    FResponseStream: TBytesStream;
    function GetToken: String;
    function HttpGet (const aUrl: String): TJSONObject;
    function HttpPost(const aUrl: String): TJSONObject;
  public
    function SendAppMsg(const aToUser, aMsg: String): TJSONObject;
    function SendAppMarkDown(const aToUser, aMsg: String): TJSONObject;
    property Token: String read GetToken;
    constructor Create(const aCorpID, aAgentID, aSecret: String); overload;
    destructor  Destroy; override;
  end;

implementation

uses uJSonBuilder;

constructor TWeWork.Create(const aCorpID, aAgentID, aSecret: String);
begin
  inherited Create();
  FCorpID  := aCorpID;
  FAgentID := aAgentID;
  FSecret  := aSecret;
  FExpireTime := 0;
  FHttp := TIdHTTP.Create(nil);
  FHttp.IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(FHttp);
  FHttp.Request.ContentType := 'application/json';
  FHttp.Request.ContentEncoding := 'utf-8';
  FSourceStream := TStringStream.Create('', TEncoding.UTF8);
  FResponseStream := TBytesStream.Create;
end;

destructor TWeWork.Destroy;
begin
  FHttp.Free;
  FSourceStream.Free;
  FResponseStream.Free;
  inherited;
end;

function TWeWork.HttpGet(const aUrl: String): TJSONObject;
begin
  FResponseStream.Clear;
  FHttp.Get(CPrefix + aUrl, FResponseStream);
  Result := TJSONObject(TJSonObject.ParseJSONValue(FResponseStream.Bytes, 0, FResponseStream.Size));
end;

function TWeWork.HttpPost(const aUrl: String): TJSONObject;
begin
  FSourceStream.Clear;
  FSourceStream.WriteString(TJSONBuilder.JSON);
  FResponseStream.Clear;
  FHttp.Post(CPrefix + aUrl, FSourceStream, FResponseStream);
  Result := TJSONObject(TJSonObject.ParseJSONValue(FResponseStream.Bytes, 0, FResponseStream.Size));
end;

function TWeWork.GetToken: String;
var
  JObj: TJSONObject;
  ErrCode: Integer;
  ErrMsg: String;
begin
  if FExpireTime < Now then
  begin
    JObj := HttpGet(CTokenURL.Replace('ID', FCorpID).Replace('SECRET', FSecret));
    ErrCode := JObj.GetValue<Integer>('errcode');
    ErrMsg  := JObj.GetValue<String >('errmsg' );
    if ErrCode = 0 then
    begin
      FToken := JObj.GetValue<String>('access_token');
      FExpireTime := IncSecond(Now,  //Expire_In: 7200(2小时)-200 = 70000秒
           JObj.GetValue<Integer>('expires_in') - 200);
    end;
    JObj.Free;
    if ErrCode <> 0 then Exception.Create(ErrMsg);
  end;

  Result := FToken;
end;

function TWeWork.SendAppMsg(const aToUser, aMsg: String): TJSONObject;
begin
  TJSONBuilder.Create
    .BeginObject
       .Add('touser', aToUser)
       .Add('msgtype', 'text'  )
       .Add('agentid', FAgentID)
       .BeginObject('text')
          .Add('content', aMsg)
       .EndObject
    .EndObject;
  Result := HttpPost(CMsgUrl.Replace('ACCESS_TOKEN', Token));
end;

function TWeWork.SendAppMarkDown(const aToUser, aMsg: String): TJSONObject;
begin
  TJSONBuilder.Create
    .BeginObject
      .Add('touser' , aToUser)
      .Add('msgtype', 'markdown')
      .Add('agentid', FAgentID)
      .beginobject('markdown')
        .Add('content', aMsg)
      .endobject
    .EndObject;
  Result := HttpPost(CMsgUrl.Replace('ACCESS_TOKEN', Token));
end;

end.

unit uJSonBuilder;

interface

uses System.Classes, System.SysUtils, System.JSON, System.JSON.Types,
     System.JSON.Writers, System.JSON.Readers, System.JSON.Builders;

type  //TJSONObjectBuilder --- Delphi 10.1或更新版本才有此类
 TJSONBuilder = class(TJSONObjectBuilder)  //单实例类
  private
    StringBuilder : TStringBuilder;
    StringWriter  : TStringWriter;
    JSONTextWriter: TJsonTextWriter;
    class var FJSONBuilder: TJSONBuilder;
    class function GetJSON: string; static;
  public
    class property JSON: String read GetJSON;
    constructor Create(const AFormatting: TJsonFormatting = TJsonFormatting.None);
    destructor Destroy; override;
  end;

implementation

constructor TJSONBuilder.Create(const AFormatting: TJsonFormatting);
begin
  if FJSONBuilder <> nil then
    FJSONBuilder.Free;  //只保持单实例

  StringBuilder  := TStringBuilder.Create;
  StringWriter   := TStringWriter.Create(StringBuilder);
  JSONTextWriter := TJsonTextWriter.Create(StringWriter);
  JSONTextWriter.Formatting := AFormatting;
  inherited Create(JSONTextWriter);
  FJSONBuilder := Self;
end;

destructor TJSONBuilder.Destroy;
begin
  inherited;
  StringBuilder.Free;
  StringWriter.Free;
  JSONTextWriter.Free;
  FJSONBuilder := nil;
end;

class function TJSONBuilder.GetJSON: string;
begin
  if FJSONBuilder = nil then
    Result := ''
  else
    Result := FJSONBuilder.StringBuilder.ToString;
end;

initialization
  TJSONBuilder.FJSONBuilder := nil;

finalization
  if TJSONBuilder.FJSONBuilder <> nil then
    TJSONBuilder.FJSONBuilder.Free;

end.

unit uTextBuilder;

interface

uses System.Classes;

type
  TTextBuilder = class  //单实例类
  private
    FText: String;
    class var FTextBuilder: TTextBuilder;
    class function GetText: String; static;
  public
    function Clear: TTextBuilder;
    function Add(const S: String): TTextBuilder;
    class property Text: String read GetText;
    constructor Create; overload;
    destructor  Destroy; override;
  end;

implementation

constructor TTextBuilder.Create;
begin
  if FTextBuilder <> nil then  //仅保持单实例
    FTextBuilder.Free;
  inherited;

  FText := '';
  FTextBuilder := Self;
end;

destructor TTextBuilder.Destroy;
begin
  inherited;
  FTextBuilder := nil;
end;

class function TTextBuilder.GetText: String;
begin
  if FTextBuilder <> nil then
    Result := FTextBuilder.FText
  else
    Result := '';
end;

function TTextBuilder.Clear: TTextBuilder;
begin
  FText := '';
  Result := FTextBuilder;
end;

function TTextBuilder.Add(const S: String): TTextBuilder;
begin
  if FText = '' then
    FText := S
  else
    FText := FText + #10 + S;

  Result := FTextBuilder;
end;

initialization
  TTextBuilder.FTextBuilder := nil;

finalization
  if TTextBuilder.FTextBuilder <> nil then
    TTextBuilder.FTextBuilder.Free;

end.