ASP application implementation of Baidu Short URL service

Baidu short URL service introduction: http://www.baidu.com/search/dwz.html

It is generally implemented in PHP, so how to use ASP for implementation is actually very simple. See the temporary demo written below (save the following code as an ASP file):

------------------------------------------------------------------------------------------------------------------------------------------------------------- -----------------------------------------------------------

<%@Language = VBScript CodePage = 65001%>

<%

Response.charset = UTF-8

Session.codePage = 65001

Session.timeout = 1440

Server.scripttimeout = 99999

'Remote acquisition

Function posthttppage (postUrl, PostSet, Postdata, Postreferr)

If Instr (LCASE (POSTURL), HTTP: //) = 0 THEN

Posthttppage = $ NULL $: Exit Function

End if

On error resume next

Dim posthtp

'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.setRequstheader Content-Length, Len (Postdata)

Posthttp.setRequestHeader Content-Type, Application/X-WWW-Form-Urlencoded

Posthttp.setRequestHeader Referer, Postreferr

Posthttp.send postdata

If posthttp.reamstate <> 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 the err.clear

If postppage = 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?

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, Thiskr, InnerCode, Hight8, LOW8

Strreturn =

For si = 1 to len (datastr)

Thischr = MID (datastr, si, 1)

If ABS (ASC (Thiscr)) <& HFF THEN

Strreturn = Strreturn & Thiskr

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 = posthtpppage (http://www.dwz.cn/create.php ,utf-8,p_data, http://www.dwz.cn)

JSON data obtained by response.write: & v_date & <br/>

Dim v_json: set v_json = Toobject (v_date)

Response.write original website: & v_json.longurl & <br/>

Response.write short URL: & v_json.tinyurl & <br/>

Set v_json = nothing

%>

<script Language = JScript Runat = Server>

Function ToObject (JSON) {

Eval (var o = + json);

Return o;

}

</script>

----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------— -----------------------------------------------------------

The results of the code above are as follows:

JSON data obtained: {Longurl: http:////www.vevb.com//develop//asp/v74697,status: 0, tinyurl: http:///www.dwz.cn/2Gggul}

Original website: http://www.vevb.com/develop/asp/v74697

The short URL obtained: http://www.dwz.cn/2ggul