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

发布时间：2023-07-31 14:55:24 所属栏目：Asp教程来源：

导读：一般都是php实现的，那么如何利用asp实现呢，其实也很简单，看我下面写的这个临时的demo（将以下代码保存为asp文件运行即可）：

-------------------------------代码区开始-----------------------------------

一般都是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.Cuoxin.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.Cuoxin.com//develop//asp//v74697","status":0,"tinyurl":"http:////www.dwz.cn//2gGUl"}

原始网址：http://www.Cuoxin.com/develop/asp/v74697

获取的短网址：http://www.dwz.cn/2gGUl

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

（编辑：聊城站长网）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!