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

百度短网址服务介绍：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