百度短网址服务之asp应用实现

作者: 来源: 更新时间:2012-06-09 15:09:05 点击:

百度短网址服务介绍: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.jscode.cn/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 & "
"
Dim v_Json:Set v_Json = toObject(v_Date)
Response.Write "原始网址:" &? v_Json.longurl & "
"
Response.Write "获取的短网址:" &? v_Json.tinyurl & "
"
Set v_Json = Nothing
%>

-------------------------------代码区结束-----------------------------------

上面代码运行结果如下:

获取的json数据:{"longurl":"http:\/\/www.jscode.cn\/develop\/asp\/v74697","status":0,"tinyurl":"http:\/\/www.dwz.cn\/2gGUl"}
原始网址:http://www.jscode.cn/develop/asp/v74697
获取的短网址:http://www.dwz.cn/2gGUl


上面只是简单的写了操作原理,具体的功能应用大家可以自己根据自己的情况操作了。