-
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 发布