asp微信写的jssdk代码，很多朋友在网上找，今天贡献出来

Posted 2021-11-28 yjed

想实现微信公众号的jssdk功能，如果你的代码是asp写的，那么有福音了，用下面的代码就行了：
<!--#include file="php_MD5.asp" -->
<!--#include file="JSON.asp" -->
<% 
Set Rs = SqlHelper("Select * From [sys_config] Where ID=1","")
If Not Rs.Eof Then
 AppId = Rs("AppID")
 AppSecret = Rs("appsecret")
 If Rs("access_token")<>"" And DateDiff("s",Now,Rs("access_token_expires"))>0 Then
    Session("Token") = Rs("access_token")
	Session("Ticket") = Rs("ticket")
 Else
    Call Get_Token()
	Call Get_Ticket()
 End If
End If
   Private Function RequestUrl(url)
		Set XmlObj = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
		XmlObj.open "GET",url, false
		XmlObj.send
		If XmlObj.Readystate=4 Then
	       RequestUrl = XmlObj.responseText
	    Else
	       Response.Write("xmlhttp请求超时！") 
		   Response.End()
	    End If
		Set XmlObj = nothing
	End Function
	
	Public Function MakeRandNum()
		Randomize
		Dim width : width = 6 ‘随机数长度,默认6位
		width = 10 ^ (width - 1)
		MakeRandNum = Int((width*10 - width) * Rnd() + width)
	End Function
	
	Public Function MakeRandStr(intLength) 
        Dim strSeed, seedLength, pos, Str, i 
            strSeed = "abcdefghijklmnopqrstuvwxyz123456789" 
            seedLength = Len(strSeed) 
            Str = "" 
            Randomize 
            For i = 1 To intLength 
                Str = Str + Mid(strSeed, Int(seedLength * Rnd) + 1, 1) 
            Next 
            MakeRandStr = Str 
     End Function 
	
	Public Function GetDateTime()
	      Dim sTime,sResult
	      sTime=now()
	      sResult = year(sTime)&right("0" & month(sTime),2)&right("0" & day(sTime),2)&right("0" & hour(sTime),2)&right("0" & minute(sTime),2)&right("0" & second(sTime),2)
	      GetDateTime = sResult
    End Function
    Public Function Get_Token()
	    Dim url, params,Temp
		Url="https://api.weixin.qq.com/cgi-bin/token?"
		params = "grant_type=client_credential"
		params = params & "&appid="&AppId
		params = params & "&secret="&AppSecret
		url = Url & params
		Temp=RequestUrl(url)
		If CheckData(Temp,"access_token") = True Then
		   set obj = getjson(Temp)
		   if isobject(obj) Then
		       Session("Token") = obj.access_token
			   Call SqlHelper("Update [sys_config] set access_token=?,access_token_expires=? Where ID=1",Array(obj.access_token,DateAdd("s",obj.expires_in,Now)))
		   End If
		  set obj = Nothing
		Else
		   Response.Write("获取 Token 时发生错误，错误信息："&Temp) 
		   Response.End()
		End If
	End Function

	Public Function Get_Ticket()
	    Dim url, params,Temp
		Url="https://api.weixin.qq.com/cgi-bin/ticket/getticket?"
		params = "access_token="&Session("Token")
		params = params & "&type=jsapi"
		url = Url & params
		Temp=RequestUrl(url)
		If CheckData(Temp,"ticket") = True Then
		   set obj = getjson(Temp)
		   if isobject(obj) Then
		       Session("Ticket") = obj.ticket
		       Call SqlHelper("Update [sys_config] set ticket=? Where ID=1",Array(obj.ticket))
		   End If
		  set obj = Nothing
		Else
		   Response.Write("获取 Ticket 时发生错误，错误信息："&Temp) 
		   Response.End()
		End If
	End Function
	
	Function Get_Sign()
		Dim Str,url
        url = "http://"&request.ServerVariables("HTTP_HOST")&request.ServerVariables("URL")
		If Trim(Request.QueryString)<>"" Then
           url = url&"?"&Trim(Request.QueryString)
		End If		
        Str = "jsapi_ticket="&Session("Ticket")&"&noncestr="&nonceStr&"&timestamp="&timestamp&"&url="&url
		Get_Sign = SHA1(Str)
	End Function
	
	Function CheckData(data,str)
		If Instr(data,str)>0 Then
		   CheckData = True
		Else
		   CheckData = False
		End If
	End Function
‘保存图片	
	Function SaveRemoteFile(LocalFileName,RemoteFileUrl)
                  SaveRemoteFile=True
           dim Ads,Http,GetRemoteData
           Set Http = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
           With Http
           .Open "Get", RemoteFileUrl, False, "", ""
           .Send
        If .Readystate<>4 then
            SaveRemoteFile=False
            Exit Function
        End If
        GetRemoteData = .ResponseBody
            End With
          Set Http = Nothing
          Set Ads = Server.CreateObject("Adodb.Stream")
              With Ads
                    .Type = 1
                    .Open
                   .Write GetRemoteData
                   .SaveToFile server.MapPath(LocalFileName),2
                  .Cancel()
                  .Close()
              End With
          Set Ads=nothing
       End Function
 %>