微信公众号生成带参数的二维码asp源码下载

2020/12/18 14:10:56 字体: 浏览 546

<%
'**********************************************
'注意事项
'ASP文件需要以UTF-8的格式保存,否则乱码.
'作者 :565449214
'**********************************************
dim Signature    '微信加密签名
dim Timestamp    '时间戳
dim Nonce        '随机数
dim Echostr        '随机字符串
dim Token        '与微信后台设置的token一致
dim encrypt_type  '加密类型
dim msg_signature '签名

Token="qwbmqwbm"'

Signature = request.QueryString("signature")
Nonce = request.QueryString("nonce")
Timestamp = request.QueryString("timestamp")
Echostr = request.QueryString("echostr")
encrypt_type = request.QueryString("encrypt_type")
msg_signature = request.QueryString("msg_signature")

'验证微信接口
If EchoStr<>"" then       
        '下面进行Token,TimesTamp,Nonce三个参数的字典排序
        dim str,i
        dim Myarray:Myarray=Sort(Array(Token,TimesTamp,Nonce))
        For i=0 To Ubound(Myarray)
            str=str&Myarray(i)
        Next
        if Lcase(SignaTure)=Lcase(SHA1(str,"Hex")) then
            Response.Write EchoStr    '验证成功,返回正确EchoStr给微信,接通接口API
            Response.End()
        end if
End if



'获取微信主动发送过来的内容
Set xmldom = Server.CreateObject("MSXML2.DOMDocument")
            xmldom.load request
            xml = xmldom.documentElement.xml
            'call CreateTextFile(request.QueryString&xml,"a.txt")
            If encrypt_type = "aes" Then
               res =  ToAes(xml,0)
               xmldom.loadxml res
            End If
            ToUserName=xmldom.getelementsbytagname("ToUserName").item(0).text '接收者微信账号。即我们的公众平台账号。
            FromUserName=xmldom.getelementsbytagname("FromUserName").item(0).text '发送者微信账号Openid
            CreateTime=xmldom.getelementsbytagname("CreateTime").item(0).text
            MsgType=xmldom.getelementsbytagname("MsgType").item(0).text
            if (MsgType="event") then
                strEventType=xmldom.getelementsbytagname("Event").item(0).text '微信事件
                if strEventType="subscribe" then '表示订阅微信公众平台
                        EventKey=xmldom.getelementsbytagname("EventKey").item(0).text
                        Content="感谢关注"
                        if EventKey<>"" then
                            EventKey=replace(EventKey,"qrscene_","")
                            Content = "你的上线ID:"&EventKey
                        Else
                            EventKey= 0
                            Content = "感谢关注"                              
                        end if
                        Call Login(EventKey,FromUserName)
                        Call Return_Text(Content)
                ElseIf strEventType="unsubscribe" Then'取消关注
                        Content="取消关注"
                        Call Return_Text(Content)
                ElseIf strEventType="CLICK" Then'点击菜单获取关键字,获取
                        EventKey=xmldom.getelementsbytagname("EventKey").item(0).text
                        Content=EventKey
                        Call Return_Text(Content)
                ElseIf strEventType="VIEW" Then'点击菜单获取关键字,跳转到链接
                        EventKey=xmldom.getelementsbytagname("EventKey").item(0).text
                        Content=EventKey
                        Call Return_Text(Content)
                ElseIf strEventType="SCAN" Then '扫描二维码
                        EventKey=xmldom.getelementsbytagname("EventKey").item(0).text
                        Content= "欢迎再次光临"
                        Call Return_Text(Content)
                ElseIf strEventType="scancode_push" or strEventType="scancode_waitmsg" Then    '点击菜单,调用扫码推事件的事件推送
                        EventKey=xmldom.getelementsbytagname("EventKey").item(0).text
                        ScanResult=xmldom.getelementsbytagname("ScanResult").item(0).text
                        Content=ScanResult
                        Call Return_Text(Content)
                ElseIf strEventType="pic_sysphoto" or strEventType="pic_photo_or_album" or strEventType="pic_weixin" Then    '点击菜单,调用系统拍照发图
                        EventKey=xmldom.getelementsbytagname("EventKey").item(0).text
                        Counts=xmldom.getelementsbytagname("Count").item(0).text
                        Content="拍照发图,接收【"&Counts&"】张图片"
                        Call Return_Text(Content)
                ElseIf strEventType="location_select" Then    '点击菜单,调用位置发送
                        EventKey=xmldom.getelementsbytagname("EventKey").item(0).text
                        Location_X=xmldom.getelementsbytagname("Location_X").item(0).text
                        Location_Y=xmldom.getelementsbytagname("Location_Y").item(0).text
                        Scale=xmldom.getelementsbytagname("Scale").item(0).text
                        Label=xmldom.getelementsbytagname("Label").item(0).text
                        Content="发送位置"&EventKey
                        Call Return_Text(Content)                   
                ElseIf strEventType="LOCATION" Then'获取用户地理位置,当用户打开对话框时,自动获取微信用户的实时地址。本功能需要配合服务号的LEB接口。
                        Latitude=xmldom.getelementsbytagname("Latitude").item(0).text
                        Longitude=xmldom.getelementsbytagname("Longitude").item(0).text
                        Precision=xmldom.getelementsbytagname("Precision").item(0).text
                        '记录用户LEB信息
                end if
            else
                MsgId=xmldom.getelementsbytagname("MsgId").item(0).text
            End If
            If MsgType="text" then'接收文本信息
                Content=xmldom.getelementsbytagname("Content").item(0).text
                Call Return_Text(Content)
            elseif MsgType="image" then'接收图片信息
                MediaId=xmldom.getelementsbytagname("MediaId").item(0).text
                PicUrl=xmldom.getelementsbytagname("PicUrl").item(0).text
                Content=PicUrl
                Call Return_Text(Content)       
            elseif MsgType="voice" then'"接收语音信息
                MediaId=xmldom.getelementsbytagname("MediaId").item(0).text
                Format=xmldom.getelementsbytagname("Format").item(0).text
                Content=MediaId
                Call Return_Text(Content)
            elseif MsgType="video" then'接收视频信息
                MediaId=xmldom.getelementsbytagname("MediaId").item(0).text
                ThumbMediaId=xmldom.getelementsbytagname("ThumbMediaId").item(0).text
                Content=MediaId
                Call Return_Text(Content)
            elseif MsgType="location" then'接收位置信息
                Location_X=xmldom.getelementsbytagname("Location_X").item(0).text
                Location_Y=xmldom.getelementsbytagname("Location_Y").item(0).text
                Scale=xmldom.getelementsbytagname("Scale").item(0).text
                Label=xmldom.getelementsbytagname("Label").item(0).text
                Content="地理位置"&Location_X&","&Location_Y&"你发的是地址信息:"&Label
                Call Return_Text(Content)
            elseif MsgType="link" then'接收链接信息
                Title=xmldom.getelementsbytagname("Title").item(0).text
                Descriptions=xmldom.getelementsbytagname("Description").item(0).text
                Url=xmldom.getelementsbytagname("Url").item(0).text
                Content=Url
                Call Return_Text(Content)
            end if   
set xmldom=Nothing           

'多图文消息
Function Return_News(Articles)
ArticleCount = Ubound(Articles)+1
str = "<xml>"&_
      "<ToUserName><![CDATA["&FromUserName&"]]></ToUserName>"&_
      "<FromUserName><![CDATA["&ToUserName&"]]></FromUserName>"&_
      "<CreateTime>"&DateDiff("s","1970-01-01 08:00:00",Now())&"</CreateTime>"&_
      "<MsgType><![CDATA[news]]></MsgType>"&_
      "<ArticleCount>"&ArticleCount&"</ArticleCount>"&_
      "<Articles>"
For i = 0 To ArticleCount-1
str = str & "<item>"&_
      "<Title><![CDATA["&Articles(i)(0)&"]]></Title>"&_
      "<Description><![CDATA["&Articles(i)(1)&"]]></Description>"&_
      "<PicUrl><![CDATA["&Articles(i)(2)&"]]></PicUrl>"&_
      "<Url><![CDATA["&Articles(i)(3)&"]]></Url>"&_
      "</item>"
Next
str = str & "</Articles>"&_
      "</xml>"
Response.Write str
End Function

'文本消息
Function Return_Text(Content)
str = "<xml>"&_
      "<ToUserName><![CDATA["&FromUserName&"]]></ToUserName>"&_
      "<FromUserName><![CDATA["&ToUserName&"]]></FromUserName>"&_
      "<CreateTime>"&DateDiff("s","1970-01-01 08:00:00",Now())&"</CreateTime>"&_
      "<MsgType><![CDATA[text]]></MsgType>"&_
      "<Content><![CDATA["&Content&"]]></Content>"&_
      "</xml>"
Response.Write str    
End Function

'字典排序
Function Sort(ary)
        Dim KeepChecking,I,FirstValue,SecondValue
        KeepChecking = TRUE
        Do Until KeepChecking = FALSE
            KeepChecking = FALSE
            For I = 0 to UBound(ary)
                If I = UBound(ary) Then Exit For
                If ary(I) > ary(I+1) Then
                    FirstValue = ary(I)
                    SecondValue = ary(I+1)
                    ary(I) = SecondValue
                    ary(I+1) = FirstValue
                    KeepChecking = TRUE
                End If
            Next
        Loop
        Sort = ary
End Function
   
Function PostHTTPPage(url,data)
    dim Http
    set Http=server.createobject("MSXML2.SERVERXMLHTTP.3.0")
    Http.open "POST",url,false
    Http.setRequestHeader "CONTENT-TYPE", "application/x-www-form-urlencoded"
    Http.send(data)
    if Http.readystate<>4 then
    exit function
    End if
    PostHTTPPage=Http.responseText
    set http=nothing
    if err.number<>0 then err.Clear
End Function

Function SHA1(ByVal Str,ByVal Types)
    Dim TAsc,Enc,Bytes,objXML,objXMLNode,Outstr
    'Borrow some objects from .NET (supported from 1.1 onwards)
    Set TAsc = Server.CreateObject("System.Text.UTF8Encoding")
    Set Enc = Server.CreateObject("System.Security.Cryptography.SHA1CryptoServiceProvider")
    'Convert the string to a byte array and hash it
    Bytes = TAsc.GetBytes_4(Str)
    Bytes = Enc.ComputeHash_2((Bytes))
    'Convert the byte array to a hex or bsae64 string
    Outstr = ""
    If Types = "Base64" Then
        Set objXML = Server.CreateObject("Msxml2.DOMDocument")
        Set objXMLNode = objXML.createElement("a")
        objXMLNode.DataType = "bin.base64"
        objXMLNode.NodeTypedValue = Bytes
        Outstr = Replace(objXMLNode.Text,Chr(10),"")
        Set objXML = Nothing
        Set objXMLNode = Nothing
    ElseIf Types = "Hex" Then
        Set objXML = Server.CreateObject("Msxml2.DOMDocument")
        Set objXMLNode = objXML.createElement("a")
        objXMLNode.DataType = "bin.hex"
        objXMLNode.NodeTypedValue = Bytes
        Outstr = Replace(objXMLNode.Text,Chr(10),"")
        Set objXML = Nothing
        Set objXMLNode = Nothing
    End If
    SHA1 = Outstr
    Set Enc = Nothing
    Set TAsc = Nothing
End Function

Sub Login(genKey,openid)
    Set Rs = Conn.ExeCute("Select * From [Wx_user] Where openid='"&openid&"'")
    If Rs.Eof Then
    UserInfo = Wx.Get_UserInfo(openid)
      nickname = UserInfo(0)
    sex = UserInfo(1)
    icon = UserInfo(2)
    province = UserInfo(4)
    city = UserInfo(5)   
    Conn.ExeCute("Insert Into [Wx_user]([username],[password],headurl,sex,province,city,openid,genkey,pid) values('"&nickname&"','"&openid&"','"&icon&"',"&sex&",'"&province&"','"&city&"','"&openid&"','"&genkey&"',"&genkey&")")
    End If
End Sub

%>

相关阅读
网上购物车购物数量加减效果
常用CSS缩写语法总结
留言板(钓鱼岛模板)V5.3
利用CSS里面的A:hover鼠标滑过缩略图时放大图片
全部功能介绍
微信公众平台
超强的中间自适应,左右固定,有许多值得学习的地方
利用fso判断文件是否存在
共有0条关于《微信公众号生成带参数的二维码asp源码下载》的评论
发表评论
正在加载评论......
返回顶部发表评论
呢 称:
表 情:
内 容:
评论内容:不能超过 1000 字,需审核,请自觉遵守互联网相关政策法规。
验证码: 验证码 
网友评论声明,请自觉遵守互联网相关政策法规。

您发布的评论即表示同意遵守以下条款:
一、不得利用本站危害国家安全、泄露国家秘密,不得侵犯国家、社会、集体和公民的合法权益;
二、不得发布国家法律、法规明令禁止的内容;互相尊重,对自己在本站的言论和行为负责;
三、本站对您所发布内容拥有处置权。

更多信息>>栏目类别选择
百度小程序开发
微信小程序开发
微信公众号开发
uni-app
asp函数库
ASP
DIV+CSS
HTML
更多>>同类信息
微信公众号用户关注时自动推送回复小程序卡片(图文卡片)不需要第三方平台就可以做
微信公众号用客服接口推送菜单消息
微信公众号回复图文消息或用客服接口推送图文消息
微信公众号回复音乐消息或用客服接口推送音乐消息
微信公众号回复视频消息或用客服接口推送视频消息
微信公众号回复语音消息或用客服接口推送语音消息
更多>>最新添加文章
呼伦贝尔市北天草原旅行社有限公司
四川悠旅地旅游有限公司
连云港五洲旅行社有限公司
邓州市途鸿旅行社
连云港华夏国际旅行社有限公司
重庆长航江山国际旅行社
松原市海航商务旅行社
广西亚太国际旅行社有限公司
更多>>随机抽取信息
来自网易空间排行宽度可以变化的选项卡
你们这个系统太专业,很复杂?
uni-app设置像页面html或者body的全局背景色
小说封面制作网站留言板模板
会员系统
超级实用且不花哨的js代码大全( 2 )