百度短网址服务介绍:http://www.baidu.com/search/dwz.html
一般都是php实现的,那么如何利用asp实现呢,其实也很简单,看我下面写的这个临时的demo(将以下代码保存为asp文件运行即可):
-------------------------------代码区开始-----------------------------------
<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%
Response.Charset = "UTF-8"
Session.Codepage = 65001
Session.Timeout = 1440
Server.Scripttimeout = 99999
'远程获取
Function PostHttpPage(PostUrl,PostSet,PostData,PostReferer)
If InStr(LCase(PostUrl),"http://") = 0 Then
PostHttpPage = "$Null$":Exit Function
End If
On Error Resume Next
Dim PostHttp
'Set PostHttp = Server.CreateObject("MSXML2.XMLHttp")
'Set PostHttp = Server.CreateObject("Microsoft.XMLHTTP")
Set PostHttp = Server.CreateObject("MSXML2.ServerXMLHTTP")
'Set PostHttp = Server.CreateObject("MSXML2.ServerXMLHTTP.3.0")
'Set PostHttp = Server.CreateObject("MSXML2.ServerXMLHTTP.4.0")
PostHttp.SetTimeOuts 10000, 10000, 15000, 15000
PostHttp.open "POST", PostUrl, False
PostHttp.setRequestHeader "Content-Length",Len(PostData)
PostHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
PostHttp.setRequestHeader "Referer", PostReferer
PostHttp.Send PostData
If PostHttp.Readystate <> 4 And PostHttp.status <> 200 Then
Set PostHttp = Nothing
PostHttpPage = "$Null$":Exit function
End If
PostHttpPage = BytesToBstr(PostHttp.responseBody,PostSet)
Set PostHttp = Nothing
If Err.number<>0 Then Err.Clear
If PostHttpPage = "" Or IsNull(PostHttpPage) Then PostHttpPage = "$Null$"
End Function
Function BytesToBstr(Body,Cset)
Dim Objstream
Set Objstream = Server.CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode =3
objstream.Open
objstream.Write body
objstream.Position = 0
objstream.Type = 2
objstream.Charset = Cset
BytesToBstr = objstream.ReadText
objstream.Close
set objstream = nothing
End Function
Function UrlEncoding(DataStr)
Dim StrReturn,Si,ThisChr,InnerCode,Hight8,Low8
StrReturn = ""
For Si = 1 To Len(DataStr)
ThisChr = Mid(DataStr,Si,1)
If Abs(Asc(ThisChr)) < &HFF Then
StrReturn = StrReturn & ThisChr
Else
InnerCode = Asc(ThisChr)
If InnerCode < 0 Then
InnerCode = InnerCode + &H10000
End If
Hight8 = (InnerCode And &HFF00)/ &HFF
Low8 = InnerCode And &HFF
StrReturn = StrReturn & "%" & Hex(Hight8) & "%" & Hex(Low8)
End If
Next
UrlEncoding = StrReturn
End Function
Dim test_Url:test_Url = "url=http://www.Vevb.com/develop/asp/v74697"
Dim p_Data:p_Data = UrlEncoding(test_Url)
Dim v_Date:v_Date = PostHttpPage("http://www.dwz.cn/create.php","UTF-8",p_Data,"http://www.dwz.cn")
Response.write "获取的json数据:" & v_Date & "<br/>"
Dim v_Json:Set v_Json = toObject(v_Date)
Response.Write "原始网址:" & v_Json.longurl & "<br/>"
Response.Write "获取的短网址:" & v_Json.tinyurl & "<br/>"
Set v_Json = Nothing
%>
<script language="JScript" runat="Server">
function toObject(json) {
eval("var o=" + json);
return o;
}
</script>
-------------------------------代码区结束-----------------------------------
上面代码运行结果如下:
获取的json数据:{"longurl":"http:////www.Vevb.com//develop//asp//v74697","status":0,"tinyurl":"http:////www.dwz.cn//2gGUl"}
原始网址:http://www.Vevb.com/develop/asp/v74697
获取的短网址:http://www.dwz.cn/2gGUl
新闻热点
疑难解答