<!--#include file="user/md5.asp"-->
<%
'response.write request("echostr")
'response.end

dim signature    '微信加密签名
dim timestamp    '时间戳
dim nonce        '随机数
'dim echostr        '随机字符串
dim Token
dim signaturetmp
token="waptxq"'您在后台添写的 token

signature = Request("signature")
nonce = Request("nonce")
timestamp = Request("timestamp")

dim ToUserName    '开发者微信号
dim FromUserName'发送方帐号（一个OpenID）
dim CreateTime    '消息创建时间（整型）
dim MsgType        'text
dim Content        '文本消息内容
dim MsgId        '消息id，64位整型




set xml_dom = Server.CreateObject("MSXML2.DOMDocument")'此处根据您的实际服务器情况改写
xml_dom.load request
ToUserName=xml_dom.getelementsbytagname("ToUserName").item(0).text
FromUserName=xml_dom.getelementsbytagname("FromUserName").item(0).text
MsgType=xml_dom.getelementsbytagname("MsgType").item(0).text
if MsgType="text" then
Content=xml_dom.getelementsbytagname("Content").item(0).text
end if

if MsgType="location" then
Label=xml_dom.getelementsbytagname("Label").item(0).text
Location_X =xml_dom.getelementsbytagname("Location_X").item(0).text
Location_Y =xml_dom.getelementsbytagname("Location_Y").item(0).text
Scale =xml_dom.getelementsbytagname("Scale").item(0).text
returnstr=returnstr&"你的当前位置:"&Label &VBCrLf
returnstr=returnstr&"地理位置维度:"&Location_X &VBCrLf
returnstr=returnstr&"地理位置精度:"&Location_Y &VBCrLf
end if

if MsgType="image" then
PicUrl =xml_dom.getelementsbytagname("PicUrl").item(0).text
MediaId =xml_dom.getelementsbytagname("MediaId").item(0).text
returnstr=returnstr&PicUrl&MediaId &VBCrLf
end if

if MsgType="voice" then
Format =xml_dom.getelementsbytagname("Format").item(0).text
MediaId  =xml_dom.getelementsbytagname("MediaId").item(0).text
Recognition=xml_dom.getelementsbytagname("Recognition").item(0).text
returnstr=returnstr&Format&MediaID&Recognition &VBCrLf
end if

if MsgType="event" then
Eventa=xml_dom.getelementsbytagname("Event").item(0).text
end if

if Eventa="CLICK" then'====================================================
EventKey=xml_dom.getelementsbytagname("EventKey").item(0).text
returnstr=returnstr&EventKey &VBCrLf
if EventKey="home" then
call dantuwen(fromusername,tousername,namesit,namesit,sypic,siteurl)
end if
end if'======================================================================

if Eventa="unsubscribe" then
returnstr=returnstr&Eventa &VBCrLf
end if

if Eventa="LOCATION" then
Latitude   =xml_dom.getelementsbytagname("Latitude").item(0).text '地理位置纬度
Preci  =xml_dom.getelementsbytagname("Precision").item(0).text '地理位置精度
Longitude   =xml_dom.getelementsbytagname("Longitude").item(0).text '地理位置经度
returnstr=returnstr&Longitude &VBCrLf
end if


'On Error Resume Next '程序遇到错误还会向下执行
db = "/data/!@#$%cherry.mdb"
connstr = "DBQ=" + server.mappath(""&db&"") + ";DefaultDir=;DRIVER={Microsoft Access Driver (*.mdb)};"
Set conn = server.CreateObject("ADODB.CONNECTION")
conn.Open connstr
If Err<>0 Then
    Err.Clear
    Set conn = Nothing
    Response.Write("不能连接到数据库！")
    Response.End()
End If

set xml_dom=Nothing
'得到IP地址
Function GetIP()
    UserTrueIP=Request.ServerVariables("HTTP_X_FORWARDED_FOR")
    If UserTrueIP="" Then UserTrueIP=Request.ServerVariables("REMOTE_ADDR")
    GetIP=UserTrueIP
End Function

ip=getip()

Set site = server.CreateObject("adodb.recordset")
exec = "select * from site"
site.Open exec, conn, 1, 1
urlsite=site("site_url")
imgsite=site("site_code")
namesit=site("site_name")
sttel=site("site_tel")
site_description=site("site_description")
homepage=md5(now()&Session.SessionID&FromUserName)&md5(Replace(Replace(now,":","")," ",""))
siteurl=""&urlsite&"/?sid="&homepage&""
siteurla=""&urlsite&""
dim  mingling,mlid
sypic=""&imgsite&""

Set Rs=Conn.Execute("select UserName from [user] where UserName='"&left(md5(FromUserName),8)&"'")
if not rs.eof then
Conn.Execute("update [user] set homepage='"&homepage&"' where UserName='"&left(md5(FromUserName),8)&"'")
else
Conn.Execute("insert into [user](UserName,homepage) values('"&left(md5(FromUserName),8)&"','"&homepage&"')")
end if
Conn.Execute("insert into [log](user,ip) values('"&left(md5(FromUserName),8)&"','"&ip&"')")



if Eventa="subscribe" or content="首页" or content="home" then
strresponse="<xml>"
 strresponse=strresponse&"<ToUserName><![CDATA["&fromusername&"]]></ToUserName>"
 strresponse=strresponse&"<FromUserName><![CDATA["&tousername&"]]></FromUserName>"
 strresponse=strresponse&"<CreateTime>"&now&"</CreateTime>"
 strresponse=strresponse&"<MsgType><![CDATA[news]]></MsgType>"
 strresponse=strresponse&"<ArticleCount>1</ArticleCount>"
 strresponse=strresponse&"<Articles>"
  strresponse=strresponse&"<item>"
 strresponse=strresponse&"<Title><![CDATA["&namesit&"]]></Title>"
 strresponse=strresponse&"<Description><![CDATA["&site_description&"]]></Description>"
 strresponse=strresponse&"<PicUrl><![CDATA["&sypic&"]]></PicUrl>"
 strresponse=strresponse&"<Url><![CDATA["&siteurl&"]]></Url>"
 strresponse=strresponse&"</item>"
 strresponse=strresponse&"</Articles>"
 strresponse=strresponse&"</xml>"
response.write strresponse
end if


call dantuwen(fromusername,tousername,namesit,site_description,sypic,siteurl)

function dantuwen(a,b,c,d,e,f)
strresponse="<xml>"
 strresponse=strresponse&"<ToUserName><![CDATA["&a&"]]></ToUserName>"
 strresponse=strresponse&"<FromUserName><![CDATA["&b&"]]></FromUserName>"
 strresponse=strresponse&"<CreateTime>"&now&"</CreateTime>"
 strresponse=strresponse&"<MsgType><![CDATA[news]]></MsgType>"
 strresponse=strresponse&"<ArticleCount>1</ArticleCount>"
 strresponse=strresponse&"<Articles>"
  strresponse=strresponse&"<item>"
 strresponse=strresponse&"<Title><![CDATA["&c&"]]></Title>"
 strresponse=strresponse&"<Description><![CDATA["&d&"]]></Description>"
 strresponse=strresponse&"<PicUrl><![CDATA["&e&"]]></PicUrl>"
 strresponse=strresponse&"<Url><![CDATA["&f&"]]></Url>"
 strresponse=strresponse&"</item>"
  strresponse=strresponse&"</Articles>"
 strresponse=strresponse&"</xml>"
response.write strresponse

楼主是在推广？

我是在请教……老大。

可以告诉我吗。谢谢。

诚心请教。在哪里可以找到。

我也不清楚