zoukankan      html  css  js  c++  java
  • Delphi XE7 用indy开发微信公众平台(4)- 接收普通消息

    接收普通消息

    原文链接:http://www.cnblogs.com/devinlee/p/4282593.html

    扫下方二维码关注,测试效果

    type
      TMsgType = (event, text, image, voice, video, location, link);
    
      TMessage = Record
        ToUserName: String;
        FromUserName: String;
        CreateTime: Integer;
        MsgType: String;
      end;
    
    uses System.SysUtils, System.JSON, TypInfo, Xml.XMLIntf, Xml.XMLDoc, ActiveX;
    
    function ReplyText(Msg: TMessage; MsgText: String): RawByteString;
    var
      X: IXMLDocument;
    begin
      X := NewXMLDocument;
      try
        X.Xml.text := TextMsg;
        X.Active := true;
        with X.DocumentElement.ChildNodes do
        begin
          Nodes['ToUserName'].NodeValue := Msg.FromUserName;
          Nodes['FromUserName'].NodeValue := Msg.ToUserName;
          Nodes['CreateTime'].NodeValue := UnixTime(now);
          Nodes['MsgType'].NodeValue := 'text';
          Nodes['Content'].NodeValue := MsgText;
        end;
        Result := UTF8Encode(X.Xml.text);
      finally
        X.Active := False;
        X := nil;
      end;
    end;
    
    function ResponseText(M: TMessage; X: IXMLDocument): RawByteString;
    begin
          Result := ReplyText(M, '有什么问题留言吧,我们会尽快答复您!');
    end;
    
    function ResponseImage(M: TMessage; X: IXMLDocument): RawByteString;
    begin
      Result := ReplyText(M, '您发的图片很漂亮!');
    end;
    
    function ResponseVoice(M: TMessage; X: IXMLDocument): RawByteString;
    begin
      try
        with X.DocumentElement.ChildNodes do
        begin
          Result := ReplyText(M, Format(VoiceMsg,
            [Nodes['Recognition'].NodeValue]));
        end;
      except
        Result := ReplyText(M, '没听清您说什么,不过您的声音很有磁性^_^');
      end;
    end;
    
    function ResponseVideo(M: TMessage; X: IXMLDocument): RawByteString;
    begin
      Result := ReplyText(M, '什么视频?不会是A片吧?');
    end;
    
    function ResponseLocation(M: TMessage; X: IXMLDocument): RawByteString;
    begin
      Result := ReplyText(M, '把你的位置发给我了,不怕我跟踪你?哈哈!');
    end;
    
    function ResponseLink(M: TMessage; X: IXMLDocument): RawByteString;
    begin
      Result := ReplyText(M, '什么链接?不会木马吧?');
    end;
    
    procedure AddLog(S: String);
    begin
      Form1.Log.Lines.Add(formatdatetime(TimeFormat, now) + ': ' + S);
    end;
    
    function Response(M: TMessage; X: IXMLDocument): RawByteString;
    var
      MsgType: TMsgType;
    begin
      MsgType := TMsgType(GetEnumValue(TypeInfo(TMsgType), M.MsgType));
      case MsgType of
        event:
          begin
            Result := ResponseEvent(M, X);
          end;
        text:
          begin
            Result := ResponseText(M, X);
            addlog('收到文本消息...' + M.MsgType + ', ' + M.FromUserName);
          end;
        image:
          begin
            Result := ResponseImage(M, X);
            addlog('收到图片消息...' + M.MsgType + ', ' + M.FromUserName);
          end;
        voice:
          begin
            Result := ResponseVoice(M, X);
            addlog('收到语音消息...' + M.MsgType + ', ' + M.FromUserName);
          end;
        video:
          begin
            Result := ResponseVideo(M, X);
            addlog('收到视频消息...' + M.MsgType + ', ' + M.FromUserName);
          end;
        location:
          begin
            Result := ResponseLocation(M, X);
            addlog('收到位置消息...' + M.MsgType + ', ' + M.FromUserName);
          end;
        link:
          begin
            Result := ResponseLink(M, X);
            addlog('收到链接消息...' + M.MsgType + ', ' + M.FromUserName);
          end
      else
        begin
          Result := '';
          addlog('收到未知消息:' + M.MsgType + ', ' + M.FromUserName);
        end;
      end;
    end;
    
    function Analysis(Stream: TStream): RawByteString;
    var
      X: IXMLDocument;
      M: TMessage;
    begin
      try
        X := NewXMLDocument;
        X.Xml.BeginUpdate;
        X.Xml.text := StreamToString(Stream);
        X.Xml.EndUpdate;
        X.Active := true;
        with X.DocumentElement.ChildNodes do
        begin
          M.ToUserName := Nodes['ToUserName'].NodeValue;
          M.FromUserName := Nodes['FromUserName'].NodeValue;
          M.CreateTime := Nodes['CreateTime'].NodeValue;
          M.MsgType := Nodes['MsgType'].NodeValue;
        end;
        Result := Response(M, X);
      finally
        X.Active := False;
        X := nil;
      end;
    end;
    
    procedure Form1.IdHTTPServerCommandGet(AContext: TIdContext;
      ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
    begin
      if CheckSignature(ARequestInfo) then
        if ARequestInfo.Params.Values['echostr'] <> '' then
        begin
          AResponseInfo.ContentType := 'text/html; charset=UTF-8';
          AResponseInfo.ContentText := ARequestInfo.Params.Values['echostr'];
        end
        else
        begin
          if ARequestInfo.PostStream <> nil then
          begin
            CoInitialize(nil);
            try
              AResponseInfo.ContentType := 'text/html; charset=UTF-8';
              AResponseInfo.ContentText := Analysis(ARequestInfo.PostStream);
            finally
              CoUninitialize;
            end;
          end;
        end;
    end;
  • 相关阅读:
    通过JavaMail发送(群发)邮件示例(内含附件图片) 代码复制可用
    需要把获取系统的当前时间存入库里 获取时是String类型,库里是Datetime类型 String 转化 Date
    用canvas和原生js写的一个笨鸟先飞的小游戏(暂时只有一个关卡)
    Svg和canvas的区别,伪类选择器有哪些(归类)
    微信web网页动态增减输入框,搜索框,基于jQuery weui、jQuery 实现无限插入数据,动态数据生成,外加高德地图POI和根据坐标获取位置信息的页面
    vue 使用tinymce富文本编辑器
    mamp环境下navicat无法链接本地mysql
    tp5 系统变量输出
    开始项目注意事项
    jQuery weui实现下拉刷新事件
  • 原文地址:https://www.cnblogs.com/devinlee/p/4282593.html
Copyright © 2011-2022 走看看