Personal

按照序列号获取起点小说的文章名，作者名和分类

作者:admin 日期:2009-4-23 23:32:41

字体大小: 小中大

<%
Function GetPageContent(Url)
        Dim HTTPObj
        On Error Resume Next
        Set HTTPObj = Server.CreateObject("Microsoft.XMLHTTP")
        With HTTPObj
                .Open "Get", Url, False, "", ""
                .Send
        End With
        if HTTPObj.Readystate <> 4 then
                Set HTTPObj = Nothing
                GetPageContent = False
                Exit Function
        end if
        GetPageContent = ResponseStrToStr(HTTPObj.ResponseBody)
        Set HTTPObj = Nothing
End Function

Function ResponseStrToStr(BodyStr)
        Dim ADOStreamObj
        Set ADOStreamObj = Server.CreateObject("ADODB.Stream")
        ADOStreamObj.Type = 1
        ADOStreamObj.Mode = 3
        ADOStreamObj.Open
        ADOStreamObj.Write BodyStr
        ADOStreamObj.Position = 0
        ADOStreamObj.Type = 2
        ADOStreamObj.Charset = "GB2312"
        ResponseStrToStr = ADOStreamObj.ReadText
        ADOStreamObj.Close
        Set ADOStreamObj = Nothing
End Function

Function GetContent(Str,StartStr,LastStr,Flag)
        Dim SearchIndex
        On Error Resume Next
        if Instr(LCase(Str),LCase(StartStr)) > 0 then
                Select Case Flag
                        Case 0
                                GetContent = Right(Str,Len(Str) - Instr(LCase(Str),LCase(StartStr)) - Len(StartStr) + 1)
                                SearchIndex = Instr(LCase(GetContent),LCase(LastStr))
                                if SearchIndex <= 0 then
                                        GetContent = ""
                                else
                                        GetContent = Left(GetContent,SearchIndex - 1)
                                end if
                        Case 1
                                GetContent = Right(Str,Len(Str) - Instr(LCase(Str),LCase(StartStr)) + 1)
                                GetContent = Left(GetContent,Instr(LCase(GetContent),LCase(LastStr)) + Len(LastStr) - 1)
                        Case 2
                                GetContent = Right(Str,Len(Str) - Instr(lcase(Str),LCase(StartStr))-Len(StartStr) + 1)
                        Case else
                                GetContent = ""
                End Select
        else
                GetContent = ""
        end if
        if Err.Number <> 0 then GetContent = ""
End Function%>

<table width="100%" border="0"><%Server.ScriptTimeOut =999999
dim ListHeadSetting,ListFootSetting,ResponseAllStr,ObjURL,NewstitleStr,geturldata
ListHeadSetting = "<title>"
ListFootSetting = "</title>"
for i= 1 to 10
ObjURL="http://www.qidian.com/Book/"&i&".aspx"
ResponseAllStr = GetPageContent(ObjURL)
NewstitleStr = GetContent(ResponseAllStr,ListHeadSetting,ListFootSetting,0)
NewstitleStr=replace(NewstitleStr,"/全本/首发/最新章节/起点中文小说网","")
NewstitleStr=replace(NewstitleStr,"HTTP 404 您所要访问的页面在服务器上不存在"," 此书不存在")
Response.Write "<tr><td>序号"&i&"</td>"
for   each   k   in     split(NewstitleStr,"/")
        Response.Write("<td>"&k   &"</td>")
next
'    Response.Write("<td>"&NewstitleStr&"</td>")
Response.Write "</tr>"
next
%>
</table>