geturl.asp

来自「多用户管理分权限发布、管理软件信息； 自由选择系统默认为静态HTML或动态A」· ASP 代码 · 共 233 行

<!--#include file="setup.asp"-->
<!--#include file="base64.asp" -->
<%
NC_Admin.Check
%>
<%

server.ScriptTimeOut = 5000000
Set rs = server.CreateObject("adodb.recordset")

i = request("id")
If i = "" Then response.End
        SQL = "select * from NC_SoftInfo where softid=" & i
        rs.Open SQL, Conn, 1, 3

If rs.EOF And rs.bof Then

Else
    surl = rs("searchurl")
    lx = rs("sortname")

    If lx <> "连续剧q" Then

        pagee = getHTTPPage(surl)

	pagea=pagee

        ss = InStr(pagee, "<td id=""pic1"">")
            If ss > 5 Then
                oo = InStr(ss, pagee, "</table>")
                pagee = Mid(pagee, ss, oo - ss)
                dyurl = Split(pagee, "onclick=""javascript:showdesc")
                    If UBound(dyurl) = 0 Then
                    
                    Else
                        If UBound(dyurl) < 40 Then
                            bb = UBound(dyurl)
                        Else
               
                        End If
                        
                        For t = 1 To bb
                                sd = InStr(dyurl(t), "http://")
                                If InStr(dyurl(t), "此资源") Then
                                    od = InStr(sd, dyurl(t), " onclick=") - 1
                                Else
                                    od = InStr(sd, dyurl(t), "  target=") - 1
                                End If
                                sdurl = Mid(dyurl(t), sd, od - sd) '下载页URL

                                start = InStr(dyurl(t), "尺寸：") + 3
                                    If start > 10 Then
                                        over = InStr(start, dyurl(t), " class") - 1
                                        cc = Mid(dyurl(t), start, over - start)
                                    Else
                                        over = InStr(dyurl(t), "class=""star")
                                    End If

                                    start = InStr(over, dyurl(t), "<td>") + 4
                                    over = InStr(start, dyurl(t), "</td>")
                                    dx = Mid(dyurl(t), start, over - start)

                                    start = InStr(over, dyurl(t), "<td>") + 4
                                    over = InStr(start, dyurl(t), "</td>")
                                    gs = Mid(dyurl(t), start, over - start)

                                    start = InStr(over, dyurl(t), "<td>") + 4
                                    over = InStr(start, dyurl(t), "</td>")
                                    sc = Mid(dyurl(t), start, over - start)
    
                                    sdurl = Replace(sdurl, "58.61.39.221", "61.129.76.80")
                                    pa = getHTTPPage(sdurl)
                                    sq = InStr(pa, "u: '") + 4
                                    oq = InStr(sq, pa, "'")
                                    downurl = Mid(pa, sq, oq - sq)
downurl = ThunderEncode(downurl)
                                    start = InStr(pa, "<title>") + 7
                                    over = InStr(pa, "</title>")
                                    pm = Mid(pa, start, over - start)
                                    pm = Replace(pm, "-狗狗影视搜索-找电影来狗狗", "")
                                    pm = Replace(pm, "", "")

                                    downurll = downurll & "下载地址:" & downurl & "<turl>" & "<font color=red>[" & pm & "]" & "[" & cc & "]" & "[" & dx & "]" & "[" & gs & "]" & "[" & sc & "]</font>" & "<ubttb>"
                    
                    
                          Next

                    End If
            End If

        If InStr(pagea, "下一页")<5 Then
	xyy="没有下一页"

	else
        start = InStr(pagea, "<li class=""long""><a  hre") + 27
        over = InStr(start, pagea, ">下一页") - 1
        xyy = Mid(pagea, start, over - start) '下一页地址

        pagee = getHTTPPage(xyy)
        ss = InStr(pagee, "<td id=""pic1"">")
            If ss > 5 Then
                oo = InStr(ss, pagee, "</table>")
                pagee = Mid(pagee, ss, oo - ss)
                dyurl = Split(pagee, "onclick=""javascript:showdesc")
                    If UBound(dyurl) = 0 Then
                    
                    Else
                        If UBound(dyurl) < 40 Then
                            bb = UBound(dyurl)
                        Else
               
                        End If
                        
                        For t = 1 To bb
                                sd = InStr(dyurl(t), "http://")
                                If InStr(dyurl(t), "此资源") Then
                                    od = InStr(sd, dyurl(t), " onclick=") - 1
                                Else
                                    od = InStr(sd, dyurl(t), "  target=") - 1
                                End If
                                sdurl = Mid(dyurl(t), sd, od - sd) '下载页URL

                                start = InStr(dyurl(t), "尺寸：") + 3
                                    If start > 10 Then
                                        over = InStr(start, dyurl(t), " class") - 1
                                        cc = Mid(dyurl(t), start, over - start)
                                    Else
                                        over = InStr(dyurl(t), "class=""star")
                                    End If

                                    start = InStr(over, dyurl(t), "<td>") + 4
                                    over = InStr(start, dyurl(t), "</td>")
                                    dx = Mid(dyurl(t), start, over - start)

                                    start = InStr(over, dyurl(t), "<td>") + 4
                                    over = InStr(start, dyurl(t), "</td>")
                                    gs = Mid(dyurl(t), start, over - start)

                                    start = InStr(over, dyurl(t), "<td>") + 4
                                    over = InStr(start, dyurl(t), "</td>")
                                    sc = Mid(dyurl(t), start, over - start)
    
                                    sdurl = Replace(sdurl, "58.61.39.221", "61.129.76.80")
                                    pa = getHTTPPage(sdurl)
                                    sq = InStr(pa, "u: '") + 4
                                    oq = InStr(sq, pa, "'")
                                    downurl = Mid(pa, sq, oq - sq)
downurl = ThunderEncode(downurl)
                                    start = InStr(pa, "n: '") + 4
                                    over = InStr(start,pa, "'")
                                    pm = Mid(pa, start, over - start)
                                    pm = Replace(pm, "-狗狗影视搜索-找电影来狗狗", "")
                                    pm = Replace(pm, "", "")

                                    downurll = downurll & "下载地址:" & downurl & "<turl>" & "<font color=red>[" & pm & "]" & "[" & cc & "]" & "[" & dx & "]" & "[" & gs & "]" & "[" & sc & "]</font>" & "<ubttb>"
                    
                    
                          Next

                    End If
            End If






    End If



End If



        





End If
downurll = downurll & "<br><urlid>" & i & "</urlid>"
Set fso = CreateObject("Scripting.FileSystemObject")
Set Fout = Fso.CreateTextFile(server.mappath("../url/"&i&".htm"))
Fout.WriteLine downurll
if len(downurll)>50 then

rs("dyurl")=1
rs("byone")=date
else
rs("dyurl")=0
end if
Rs.Update
rs.Close
Set rs = Nothing




Function getHTTPPage(url) 
		dim http 
		set http=Server.createobject("Microsoft.XMLHTTP")
       'Set Http=Server.CreateObject("MSXML2.XMLHTTP")
		Http.open "GET",url,false 
		Http.send() 
		if Http.readystate<>4 then
		   exit function 
		end if 
		getHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")
		set http=nothing
		if err.number<>0 then err.Clear  
	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


%>
<%=downurll%>