微信公众号接收回复

  1. type
  2.   TMsgType = (event, text, image, voice, video, location, link);

  3.   TMessage = Record
  4.     ToUserName: String;
  5.     FromUserName: String;
  6.     CreateTime: Integer;
  7.     MsgType: String;
  8.   end;

  9. uses System.SysUtils, System.JSON, TypInfo, Xml.XMLIntf, Xml.XMLDoc, ActiveX;

  10. function ReplyText(Msg: TMessage; MsgText: String): RawByteString;
  11. var
  12.   X: IXMLDocument;
  13. begin
  14.   X := NewXMLDocument;
  15.   try
  16.     X.Xml.text := TextMsg;
  17.     X.Active := true;
  18.     with X.DocumentElement.ChildNodes do
  19.     begin
  20.       Nodes['ToUserName'].NodeValue := Msg.FromUserName;
  21.       Nodes['FromUserName'].NodeValue := Msg.ToUserName;
  22.       Nodes['CreateTime'].NodeValue := UnixTime(now);
  23.       Nodes['MsgType'].NodeValue := 'text';
  24.       Nodes['Content'].NodeValue := MsgText;
  25.     end;
  26.     Result := UTF8Encode(X.Xml.text);
  27.   finally
  28.     X.Active := False;
  29.     X := nil;
  30.   end;
  31. end;

  32. function ResponseText(M: TMessage; X: IXMLDocument): RawByteString;
  33. begin
  34.       Result := ReplyText(M, '有什么问题留言吧,我们会尽快答复您!');
  35. end;

  36. function ResponseImage(M: TMessage; X: IXMLDocument): RawByteString;
  37. begin
  38.   Result := ReplyText(M, '您发的图片很漂亮!');
  39. end;

  40. function ResponseVoice(M: TMessage; X: IXMLDocument): RawByteString;
  41. begin
  42.   try
  43.     with X.DocumentElement.ChildNodes do
  44.     begin
  45.       Result := ReplyText(M, Format(VoiceMsg,
  46.         [Nodes['Recognition'].NodeValue]));
  47.     end;
  48.   except
  49.     Result := ReplyText(M, '没听清您说什么,不过您的声音很有磁性^_^');
  50.   end;
  51. end;

  52. function ResponseVideo(M: TMessage; X: IXMLDocument): RawByteString;
  53. begin
  54.   Result := ReplyText(M, '什么视频?不会是A片吧?');
  55. end;

  56. function ResponseLocation(M: TMessage; X: IXMLDocument): RawByteString;
  57. begin
  58.   Result := ReplyText(M, '把你的位置发给我了,不怕我跟踪你?哈哈!');
  59. end;

  60. function ResponseLink(M: TMessage; X: IXMLDocument): RawByteString;
  61. begin
  62.   Result := ReplyText(M, '什么链接?不会木马吧?');
  63. end;

  64. procedure AddLog(S: String);
  65. begin
  66.   Form1.Log.Lines.Add(formatdatetime(TimeFormat, now) + ': ' + S);
  67. end;

  68. function Response(M: TMessage; X: IXMLDocument): RawByteString;
  69. var
  70.   MsgType: TMsgType;
  71. begin
  72.   MsgType := TMsgType(GetEnumValue(TypeInfo(TMsgType), M.MsgType));
  73.   case MsgType of
  74.     event:
  75.       begin
  76.         Result := ResponseEvent(M, X);
  77.       end;
  78.     text:
  79.       begin
  80.         Result := ResponseText(M, X);
  81.         addlog('收到文本消息...' + M.MsgType + ', ' + M.FromUserName);
  82.       end;
  83.     image:
  84.       begin
  85.         Result := ResponseImage(M, X);
  86.         addlog('收到图片消息...' + M.MsgType + ', ' + M.FromUserName);
  87.       end;
  88.     voice:
  89.       begin
  90.         Result := ResponseVoice(M, X);
  91.         addlog('收到语音消息...' + M.MsgType + ', ' + M.FromUserName);
  92.       end;
  93.     video:
  94.       begin
  95.         Result := ResponseVideo(M, X);
  96.         addlog('收到视频消息...' + M.MsgType + ', ' + M.FromUserName);
  97.       end;
  98.     location:
  99.       begin
  100.         Result := ResponseLocation(M, X);
  101.         addlog('收到位置消息...' + M.MsgType + ', ' + M.FromUserName);
  102.       end;
  103.     link:
  104.       begin
  105.         Result := ResponseLink(M, X);
  106.         addlog('收到链接消息...' + M.MsgType + ', ' + M.FromUserName);
  107.       end
  108.   else
  109.     begin
  110.       Result := '';
  111.       addlog('收到未知消息:' + M.MsgType + ', ' + M.FromUserName);
  112.     end;
  113.   end;
  114. end;

  115. function Analysis(Stream: TStream): RawByteString;
  116. var
  117.   X: IXMLDocument;
  118.   M: TMessage;
  119. begin
  120.   try
  121.     X := NewXMLDocument;
  122.     X.Xml.BeginUpdate;
  123.     X.Xml.text := StreamToString(Stream);
  124.     X.Xml.EndUpdate;
  125.     X.Active := true;
  126.     with X.DocumentElement.ChildNodes do
  127.     begin
  128.       M.ToUserName := Nodes['ToUserName'].NodeValue;
  129.       M.FromUserName := Nodes['FromUserName'].NodeValue;
  130.       M.CreateTime := Nodes['CreateTime'].NodeValue;
  131.       M.MsgType := Nodes['MsgType'].NodeValue;
  132.     end;
  133.     Result := Response(M, X);
  134.   finally
  135.     X.Active := False;
  136.     X := nil;
  137.   end;
  138. end;

  139. procedure Form1.IdHTTPServerCommandGet(AContext: TIdContext;
  140.   ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
  141. begin
  142.   if CheckSignature(ARequestInfo) then
  143.     if ARequestInfo.Params.Values['echostr'] <> '' then
  144.     begin
  145.       AResponseInfo.ContentType := 'text/html; charset=UTF-8';
  146.       AResponseInfo.ContentText := ARequestInfo.Params.Values['echostr'];
  147.     end
  148.     else
  149.     begin
  150.       if ARequestInfo.PostStream <> nil then
  151.       begin
  152.         CoInitialize(nil);
  153.         try
  154.           AResponseInfo.ContentType := 'text/html; charset=UTF-8';
  155.           AResponseInfo.ContentText := Analysis(ARequestInfo.PostStream);
  156.         finally
  157.           CoUninitialize;
  158.         end;
  159.       end;
  160.     end;
  161. end;
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值