请问哪里有采集别人网站内容的ASP程序,急!!!!!!!!!

[pig884]

请问哪里有采集别人网站内容的ASP程序,急!!!

[老彭1980]

http://www.mycode.net

[mh_rock]

网上搜索一下呀...

[pbyhz]

www.foosun.net

[mrtuzi]

func.asp:

<%
Function GetHttpPage(HttpUrl)
   If IsNull(HttpUrl)=True Or HttpUrl="$False$" Then
      GetHttpPage="$False$"
      Exit Function
   End If
   Dim Http
   Set Http=server.createobject("MSXML2.XMLHTTP")
   Http.open "GET",HttpUrl,False
   Http.Send()
   If Http.Readystate<>4 then
      Set Http=Nothing 
      GetHttpPage="$False$"
      Exit function
   End if
   GetHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")
   Set Http=Nothing
   If Err.number<>0 then
      Err.Clear
   End If
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 GetBody(ConStr,StartStr,OverStr,IncluL,IncluR)
   If ConStr="$False$" or ConStr="" or IsNull(ConStr)=True Or StartStr="" or IsNull(StartStr)=True  Then
      GetBody="$False$"
      Exit Function
   End If
   Dim ConStrTemp
   Dim Start,Over
   ConStrTemp=Lcase(ConStr)
   StartStr=Lcase(StartStr)
   OverStr=Lcase(OverStr)
   Start = InStrB(1, ConStrTemp, StartStr, vbBinaryCompare)
   If Start<=0 then
      GetBody="$False$"
      Exit Function
   Else
      If IncluL=False Then
         Start=Start+LenB(StartStr)
      End If
   End If
   Over=InStrB(Start,ConStrTemp,OverStr,vbBinaryCompare)
   If Over<=0 Or Over<=Start then
      GetBody="$False$"
      Exit Function
   Else
      If IncluR=True Then
         Over=Over+LenB(OverStr)
      End If
   End If
   GetBody=MidB(ConStr,Start,Over-Start)
End Function

index.asp:调用

function showLRCstr(sname)  '显示歌词及时间标签
HttpUrl="http://mp3.baidu.com/m?f=ms&tn=baidump3lyric&ct=150994944&lf=2&rn=10&lm=-1&word="&sname&"&aaa="&now()
'response.Write "有时间<br>"&HttpUrl
StartGet = GetHttpPage(HttpUrl)	
	List=GetBody(StartGet,"style=""padding-right:10px"" align=""absmiddle"">","<sup>HOT</sup></span><br>",false,1)
If List<>"$False$" Then
        List=replace(List,"<a href=""","")
        List=replace(List,""" >LRC歌词</a>","")
		lrcdata=GetHttpPage(List)
		lrcbody=GetBody(lrcdata,"无法","网页",false,1)
		if lrcbody<>"显示" then
			response.write lrcdata
		else
			response.Write "[00:05.50]找不到歌词"
			response.Write "[00:24.57]请进行手工搜索"
		end if
	End If
end function

[jykgps]

多了,去百度里搜 cms 一大堆,国内出名的,有动易,风讯,乔客,新云,

[mrtuzi]

补充下：index.asp:调用 的时候，要加入
<!--#include file="f.asp"-->
<%Response.Charset="GB2312"%>
然后你想在哪里显示，就直接<% showLRCstr(sname) %>