- 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;
微信公众号接收回复
最新推荐文章于 2024-06-20 10:18:02 发布