📄 fun_webload.asp

📁 实时抓取凯神BT站的全部数据为自己所用
💻 ASP
字号:
<%
Function LoadBody()
	Response.Write LoadHead()
	Response.Write LoadTop()
	Response.Write LoadTopDH()
	Response.Write CreateSearch()
	Response.Write ListStr
	Response.Write CreateBottom()
End Function

Function LoadHead()
	Dim vStr
	vStr = ""
	vStr = vStr & "<html>" & VbCrlf
	vStr = vStr & "<head>" & VbCrlf
	vStr = vStr & "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">" & VbCrlf
	vStr = vStr & "<title>" & BT_WebTitle & "</title>" & VbCrlf
	vStr = vStr & "<link href=""inc/style.css"" rel=""stylesheet"" type=""text/css"">" & VbCrlf
	vStr = vStr & "</head>" & VbCrlf
	vStr = vStr & "<style type=""text/css"">" & VbCrlf
	vStr = vStr & "@import url(""inc/bt.css"");" & VbCrlf
	vStr = vStr & "@import url(""inc/cj.css"");" & VbCrlf
	vStr = vStr & "</style>" & VbCrlf
	vStr = vStr & "<body>" & VbCrlf
	LoadHead = vStr
End Function

Function LoadHead_Index()
	Dim vStr
	vStr = ""
	vStr = vStr & "<html>" & VbCrlf
	vStr = vStr & "<head>" & VbCrlf
	vStr = vStr & "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">" & VbCrlf
	vStr = vStr & "<title>" & BT_WebTitle & "</title>" & VbCrlf
	vStr = vStr & "<link href=""inc/style.css"" rel=""stylesheet"" type=""text/css"">" & VbCrlf
	vStr = vStr & "</head>" & VbCrlf
	vStr = vStr & "<body>" & VbCrlf
	LoadHead_Index = vStr
End Function

Function LoadTop()
	Dim vStr
	vStr = ""
	vStr = vStr & "<table cellpadding=""0"" cellspacing=""0"" class=""tb_Out tb_Top"">" & VbCrlf
	vStr = vStr & "  <tr>" & VbCrlf
		vStr = vStr & "<td width=""183""><a href=""index.asp""><img src=""images/logo.jpg"" width=""120"" height=""36"" border=0></a></td>" & VbCrlf
		vStr = vStr & "<td width=""497""><div id=""advTop"">" & BT_TopAdv & "</div></td>" & VbCrlf
		vStr = vStr & "<td width=""98""><table width=""100%""  border=""0"" cellspacing=""0"" cellpadding=""0"" id=""tb_topLink"">" & VbCrlf
		vStr = vStr & "  <tr>" & VbCrlf
			vStr = vStr & "<td><a href=""#"" onClick=""window.external.AddFavorite(document.location.href, '" & BT_WebTitle & "')"">加入收藏</a></td>" & VbCrlf
		vStr = vStr & "  </tr>" & VbCrlf
		vStr = vStr & "  <tr>" & VbCrlf
			vStr = vStr & "<td><a href=""#"" onClick=""this.style.behavior='url(#default#homepage)';this.setHomePage('" & BT_DomainUrl & "')"">设为首页</a></td>" & VbCrlf
		vStr = vStr & "</tr>" & VbCrlf
		vStr = vStr & "</table></td>" & VbCrlf
	 vStr = vStr & " </tr>" & VbCrlf
	vStr = vStr & "</table>" & VbCrlf
	LoadTop = vStr
End Function

Function LoadTopDH()
	Dim vStr
	vStr = ""
	vStr = vStr & "<table cellpadding=""0"" cellspacing=""0"" class=""tb_Out tb_DHMenu"">" & VbCrlf
	vStr = vStr & "  <tr>" & VbCrlf
		vStr = vStr & "<td><a href=""Class.asp"">资源首页</a>|<a href=""Class.asp?Type=1"">电影资源</a>|<a href=""Class.asp?Type=2"">综艺资源</a>|<a href=""Class.asp?Type=4"">连续剧资源</a>|<a href=""Class.asp?Type=6"">音乐资源</a>|<a href=""Class.asp?Type=5"">软件资源</a>|<a href=""Class.asp?Type=3"">动漫资源</a>|<a href=""Class.asp?Type=7"">体育资源</a>|<a href=""Class.asp?Type=8"">游戏资源</a>|<a href=""Class.asp?Type=9"">学习资源</a> </td>" & VbCrlf
	vStr = vStr & "  </tr>" & VbCrlf
	vStr = vStr & "</table>" & VbCrlf
	LoadTopDH = vStr
End Function

Function CreateSearch()
	Dim vStr
	vStr = ""
	vStr = vStr & "<form name=""searchFrm""  method=""post"" action=""search.asp"" style=""margin:0px; "">" & VbCrlf
	vStr = vStr & "<table cellpadding=""0"" cellspacing=""0"" class=""tb_Out tb_Search"">" & VbCrlf
	vStr = vStr & "  <tr>" & VbCrlf
		vStr = vStr & "<td width=""93"" align=""right""><strong>BT搜索：</strong></td>" & VbCrlf
		vStr = vStr & "<td width=""296"" align=""center""><input name=""searchkey"" type=""text"" size=""40""></td>" & VbCrlf
		vStr = vStr & "<td width=""389""><img src=""images/bt_search.gif"" width=""44"" height=""21"" onClick=""location.href='search.asp?searchkey='+document.searchFrm.searchkey.value;""></td>" & VbCrlf
	vStr = vStr & "  </tr>" & VbCrlf
	vStr = vStr & "</table>" & VbCrlf
	vStr = vStr & "</form>" & VbCrlf
	CreateSearch = vStr
End Function

Function CreateBottom()
	Dim vStr
	vStr = ""
	vStr = vStr & "<table cellpadding=""0"" cellspacing=""0"" class=""tb_Out tb_bottom"">" & VbCrlf
	vStr = vStr & "  <tr>" & VbCrlf
		vStr = vStr & "<td width=""330"" align=""right""><img src=""images/logo_bottom.jpg"" width=""83"" height=""24""></td>" & VbCrlf
		vStr = vStr & "<td width=""448"">Copyright &copy; 2006 , All Rights Reserved<br>版权所有：<strong>零记忆工作站</strong></td>" & VbCrlf
	vStr = vStr & "  </tr>" & VbCrlf
	vStr = vStr & "</table>" & VbCrlf
	vStr = vStr & "<p>&nbsp;</p>" & VbCrlf
	vStr = vStr & "</body>" & VbCrlf
	vStr = vStr & "</html>" & VbCrlf
	CreateBottom = vStr
End Function

Function LoadData(Url)
	Dim BodyStr
	BodyStr = GetHTTPPage(Url)
	If BodyStr <> "" Then
		BodyStr = GetBetween(BodyStr,"<script language=""javascript"" src=""jsFile/search.js""></script>","<div id=""Right"">")
		BodyStr = Replace(BodyStr,"<a href=""html/","<a href=""show.asp?htm=html/")
		BodyStr = Replace(BodyStr,"href=""class.asp?id=","href=""class.asp?type=")
		BodyStr = Replace(BodyStr,"href=""?curpage=","href=""?page=")
		BodyStr = Replace(BodyStr,"&id=","&type=")
	End If
	LoadData = BodyStr
End Function

Function LoadData_Group(Url)
	Dim BodyStr
	BodyStr = GetHTTPPage(Url)
	If BodyStr <> "" Then
		BodyStr = GetBetween(BodyStr,"<div id=""GroupInfo_New"">","<div id=""Right"">")
		BodyStr = Replace(BodyStr,"<A  class=pagetitle href=""html/","<A  class=pagetitle href=""show.asp?htm=html/")
		BodyStr = Replace(BodyStr,"href=""class.asp?id=","href=""class.asp?type=")
		BodyStr = Replace(BodyStr,"href=""?curpage=","href=""?page=")
		BodyStr = "<div id=""GroupInfo_New"">" & BodyStr
	End If
	LoadData_Group = BodyStr
End Function

Function LoadData_Show(Url)
	Dim BodyStr
	BodyStr = GetHTTPPage(Url)
	If BodyStr <> "" Then
		BodyStr = GetBetween(BodyStr,"<div id=""WZ""><script src=""http://www.kaicn.com/kaicn_adv/autoJS/wz.js""></script></div>","<div class=""LeftAdv"">")
		BodyStr = Replace(BodyStr,"<a href=""../../union_user.asp?uid=","<a href=""union_user.asp?uid=")
		BodyStr = Replace(BodyStr,"<a href=""../../union.asp?Gid=","<a href=""union.asp?Gid=")
		BodyStr = Replace(BodyStr,"src=""../../Images","src=""Images")
		BodyStr = Replace(BodyStr,"../../user/Manage.asp","index.asp")
		BodyStr = Replace(BodyStr,"../../show/SendErr.asp","index.asp")
		BodyStr = Replace(BodyStr,"../../show/Down_Torrent.asp","http://bt.kaicn.com/show/Down_Torrent.asp")
		BodyStr = Replace(BodyStr,"<script src=""http://www.kaicn.com/kaicn_adv/autoJS/BT_Html_Txt_Down.js""></script>","<a href=""" & BT_DomainUrl & """>欢迎访问" & BT_WebTitle & "</a>")
		BodyStr = "<div class=""table_gray"" style="" background-color:#FFFFFF;width:770px;padding-left:3px; padding-right:3px; margin-top:3px; "">" & BodyStr & "</div>"
	End If
	LoadData_Show = BodyStr
End Function

Function GetBetween(strdata, strstart, strend)
  Dim lngstart, lngend
  lngstart = Instr(strdata, strstart) + Len(strstart)
  If (lngstart <> 0) Then
	lngend = Instr(lngstart, strdata, strend)
	If (lngend <> 0) Then
	  GetBetween = Mid(strdata, lngstart, lngend - lngstart)
	End If
  End If
End Function
	
'XMLHTTP抓取网页数据
'------------------------------------------------------------
Function GetHTTPPage(url) 
	On Error Resume Next 
	Dim Http 
	Set Http = Server.CreateObject("Microsoft.XMLHTTP") 
	Http.Open "GET",url,False 
	Http.Send() 
	If Http.ReadyState <> 4 Then
		Exit Function 
	End If 
	GetHTTPPage = Bytes2BSTR(Http.ResponseBody) 
	Set Http = NoThing
	If Err.Number <> 0 Then Err.Clear  
End Function 

Function Bytes2BSTR(vIn) 
	Dim strReturn
	Dim i1,ThisCharCode,NextCharCode 
	strReturn = "" 
	For i1 = 1 To LenB(vIn) 
		ThisCharCode = AscB(MidB(vIn,i1,1)) 
		If ThisCharCode < &H80 Then 
			strReturn = strReturn & Chr(ThisCharCode) 
		Else 
			NextCharCode = AscB(MidB(vIn,i1+1,1)) 
			strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode)) 
			i1 = i1 + 1 
		End If 
	Next 
	bytes2BSTR = strReturn 
End Function
'-----------------------------------------------------------------------------
%>
💿 文件大小 23 K
👤 上传用户 szdoudou
📂 所属分类其他行业
🏷️ 相关标签

#数据
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -