有没有大佬知道ASP自定义微信转发链接怎么实现?本人ASP小白,从网上找的代码都不能用

小熊啦啦啦丶 2019-08-08 05:04:53
请大佬帮忙看看为啥引用下面的代码直接页面变成白屏

<!--#include file="jssdk_config.asp"-->
<!--#include file="sha1.asp"-->
<%
'-------------------------------------------------'
'解析json'
'Call InitScriptControl'
'Set objTest = getJSONObject(strTest)'
'-------------------------------------------------'
Dim sc4Json
Sub InitScriptControl
Set sc4Json = Server.CreateObject("MSScriptControl.ScriptControl")
sc4Json.Language = "JavaScript"
sc4Json.AddCode "var itemTemp=null;function getJSArray(arr, index){itemTemp=arr[index];}"
End Sub
Function getJSONObject(strJSON)
sc4Json.AddCode "var jsonObject = " & strJSON
Set getJSONObject = sc4Json.CodeObject.jsonObject
End Function
Sub getJSArrayItem(objDest,objJSArray,index)
On Error Resume Next
sc4Json.Run "getJSArray",objJSArray, index
Set objDest = sc4Json.CodeObject.itemTemp
If Err.number=0 Then Exit Sub
objDest = sc4Json.CodeObject.itemTemp
End Sub
Call InitScriptControl


'-------------------------------------------------'
'函数名称:GetRnd'
'参数:t0 生成字符串长度'
'作用:生成随机字符串'
'-------------------------------------------------'
Function GetRnd(t0)
randomize
dim n1,n2,n3
do while len(getrnd)<t0 '随机字符位数'
n1=cstr(chrw((57-48)*rnd+48)) '0~9'
n2=cstr(chrw((90-65)*rnd+65)) 'a~z'
n3=cstr(chrw((122-97)*rnd+97)) 'a~z'
getrnd=getrnd&n1&n2&n3
loop
End Function

'-------------------------------------------------'
'函数名称:ToUnixTime'
'参数:strTime 欲转换的时间'
'作用:普通日期转换成时间戳'
'-------------------------------------------------'
Function ToUnixTime(strTime)
If IsEmpty(strTime) or Not IsDate(strTime) Then strTime = Now
ToUnixTime = DateAdd("h",-8,strTime)
ToUnixTime = DateDiff("s","1970-1-1 0:0:0", ToUnixTime)
End Function

'-------------------------------------------------'
'函数名称:Get_signature'
'参数:Ticket'
' nonceStr'
' uTime'
' LocationURL'
'作用:生成signature'
'-------------------------------------------------'
function Get_signature(Ticket,nonceStr,uTime,LocationURL)
Get_signature=sha1("jsapi_ticket="&Ticket&"&noncestr="&nonceStr&"×tamp="&uTime&"&url="&LocationURL&"")
end function

'-------------------------------------------------'
'函数名称:GetLocationURL'
'作用:获取得当页面地址'
'-------------------------------------------------'
Function GetLocationURL()
Dim Url
Dim ServerPort,ServerName,ScriptName,QueryString,indexfile
ServerName = Request.ServerVariables("SERVER_NAME")
ServerPort = Request.ServerVariables("SERVER_PORT")
ScriptName = Request.ServerVariables("SCRIPT_NAME")
indexfile = Mid(Request.ServerVariables("URL"),InstrRev(Request.ServerVariables("URL"),"/")+1)
if indexfile="index.asp" then
ScriptName=replace(ScriptName,"index.asp","")
end if
if indexfile="default.asp" then
ScriptName=replace(ScriptName,"default.asp","")
end if
QueryString = Request.ServerVariables("QUERY_STRING")
Url="http://"&ServerName
If ServerPort <> "80" Then Url = Url & ":" & ServerPort
Url=Url&ScriptName
If QueryString <>"" Then Url=Url&"?"& QueryString
GetLocationURL=Url
End Function

'-------------------------------------------------'
'函数名称:GetToken'
'作用:获取最新Access_token'
'-------------------------------------------------'
Private function GetToken()
dim strJson
strJson=GetURL("https://api.weixin.qq.com/cgi-bin/token?grant_type=client_credential&appid="&AppId&"&secret="&Appsecret&"")
if InStr(strJson,"errcode")>0 then GetToken="":exit function
Set objTest = getJSONObject(strJson)
TokenTime=nowTime
ExpiresIn=objTest.expires_in
GetToken=objTest.access_token '获取新Access_token'
set objTest=nothing
End function

'-------------------------------------------------'
'函数名称:Get_Ticket'
'作用:获取最新jsapi_ticket'
'-------------------------------------------------'
Private function Get_Ticket()
dim strJson
strJson=GetURL("https://api.weixin.qq.com/cgi-bin/ticket/getticket?access_token="&AccessToken&"&type=jsapi")
Set objTest2 = getJSONObject(strJson)
if objTest2.errcode<>"0" then Get_Ticket="":exit function
TicketTime=nowTime
ExpiresIn=objTest2.expires_in
Get_Ticket=objTest2.ticket '获取新jsapi_ticket'
set objTest2=nothing
End function

'-------------------------------------------------'
'函数名称:PostURL'
'参数:url'
' PostStr'
'作用:Post内容,通过xml.http形式获取远程文件'
'-------------------------------------------------'
Function PostURL(url,PostStr)
Set Retrieval = Server.CreateObject("Msxml2.ServerXMLHTTP")
With Retrieval
.Open "POST", url, false ,"" ,""
.setRequestHeader "Content-Type","application/x-www-form-urlencoded"
.Send(PostStr)
PostURL = .responsetext
End With
Set Retrieval = Nothing
'response.Write PostURL'
End Function

'-------------------------------------------------'
'函数名称:GetURL'
'参数:url'
'作用:Get内容,通过xml.http形式获取远程文件'
'-------------------------------------------------'
Function GetURL(url)
dim http
set http=server.createobject("Msxml2.ServerXMLHTTP")
http.open "GET",url,false
http.setRequestHeader "If-Modified-Since","0"
http.send()
GetURL=http.responsetext
set http=nothing
'response.Write GetURL'
End Function

'-------------------------------------------------'
'函数名称:ReadTextFile'
'参数:FileUrl'
' CharSet'
'作用:利用AdoDb.Stream对象来读取UTF-8格式的文本文件'
'----------------------------------------------------'
Function ReadFromTextFile (FileUrl,CharSet)
dim str,stm
set stm=server.CreateObject("adodb.stream")
stm.Type=2 '以本模式读取'
stm.mode=3
stm.charset=CharSet
stm.open
stm.loadfromfile server.MapPath(FileUrl)
str=stm.readtext
stm.Close
set stm=nothing
ReadFromTextFile=str
End Function

'-------------------------------------------------'
'函数名称:WriteToTextFile'
'参数:FileUrl'
' Str'
' CharSet'
'作用:利用AdoDb.Stream对象来写入UTF-8格式的文本文件'
'----------------------------------------------------'
Sub WriteToTextFile (FileUrl,byval Str,CharSet)
dim stm
set stm=server.CreateObject("adodb.stream")
stm.Type=2 '以本模式读取'
stm.mode=3
stm.charset=CharSet
stm.open
stm.WriteText str
stm.SaveToFile server.MapPath(FileUrl),2
stm.flush
stm.Close
set stm=nothing
End Sub

dim nowTime,outConten,timestamp,nonceStr,signature,lUrl
nowTime = ToUnixTime(now)

If nowTime-TokenTime>ExpiresIn then '当Access_token过期时,重新获取新Access_token'
AccessToken = GetToken()
End If

If nowTime-TicketTime>ExpiresIn then '当jsapi_ticket过期时,重新获取新jsapi_ticket'
JsapiTicket = Get_Ticket()
End If

outConten = "<"&Chr("37")&vbcrlf
outConten = outConten&"dim AppId,AppSecret,AccessToken,TokenTime,JsapiTicket,TicketTime,ExpiresIn"&vbcrlf
outConten = outConten&"AppId = ""预置AppId"""&vbcrlf
outConten = outConten&"AppSecret = ""预置Secret"""&vbcrlf
outConten = outConten&"AccessToken = """&AccessToken&""""&vbcrlf
outConten = outConten&"TokenTime = "&TokenTime&vbcrlf
outConten = outConten&"JsapiTicket = """&JsapiTicket&""""&vbcrlf
outConten = outConten&"TicketTime = "&TicketTime&vbcrlf
outConten = outConten&"ExpiresIn = 7000"&vbcrlf
outConten = outConten&Chr("37")&">"
call WriteToTextFile("jssdk_config.asp",outConten,"utf-8")

timestamp=ToUnixTime(now)
nonceStr=GetRnd(10)
lUrl=GetLocationURL()
signature=Get_signature(JsapiTicket,nonceStr,timestamp,lUrl)
%>
...全文
194 1 打赏 收藏 转发到动态 举报
写回复
用AI写文章
1 条回复
切换为时间正序
请发表友善的回复…
发表回复
hgwyl 2019-08-10
  • 打赏
  • 举报
回复
没看懂业务需求,帮不上忙。

28,391

社区成员

发帖
与我相关
我的任务
社区描述
ASP即Active Server Pages,是Microsoft公司开发的服务器端脚本环境。
社区管理员
  • ASP
  • 无·法
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧