百度短網址服務之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