function.asp

音乐管理系统的采集数据程序可自行添加采集点,适合一些大型音乐网站数据的采集

<%
Response.Buffer = True
Server.ScriptTimeOut=999999999
Server.ScriptTimeOut=999999999

'*****************************************************************
'	function（公有）
'	作用 ：取得歌曲歌词
'*****************************************************************
Public Function LrcMusicGc(MusicName,singer)
		musicGc=Getdata("http://mp3.baidu.com/m?tn=baidump3lyric&ct=150994944&word="&musicname&"%20"&singer,1)
		if instr(musicgc,"建议您检查输入文字有无错误") then 
			MusicGc= "暂无"
		else
			musicGc=FormatHtml(musicgc,0)
			musicGc=GetContent(musicgc,"专辑:&lt;a href=&quot;http://mp3.baidu.com/m?tn=baidump3&ct=134217728&lm=-1&word=","&lt;p align=right&gt;",0)
			musicgc=Replace(musicgc,"&lt;","<")
			musicgc=Replace(musicgc,"&gt;",">")
			musicgc=Replace(musicgc,"&nbsp;"," ")
			musicgc=Replace(musicgc,"<font style=color:#e10900>","")
			musicgc=Replace(musicgc,"</font>","")
			musicgc=GetContent(musicgc,"<p>","</p>",0)
			'response.write musicGc
		end if
		if musicgc="" then 
			LrcMusicgc="暂无"
		else
			LrcMusicgc=MusicGc
		end if
End function
 Public Function GetFileText(url) 
     'on error resume next '有错误时继续执行代码
     Dim http '定义变量
     'Set http=Server.createobject(XmlHttpCom) '申请对象 
           Set http=Server.createobject("Microsoft.XMLHTTP") '保险起见，写出一个服务器一般都支持的版本 
     Http.open "GET",url,False   '打开对象 用GET方式 等待服务器响应
     Http.Send() '发送
     If Http.readystate<>4 Then  '如果服务器没反应,则退出函数
           Exit Function 
     End If 

     GetFileText=bytes2BSTR(Http.responseBody,"GB2312") 

     Set http=Nothing 
     If err.number<>0 Then err.Clear   '如果有错误,清除错误
    End Function
     Function Bytes2bStr(vin,cSet)
       Dim BytesStream,StringReturn
       Set BytesStream = Server.CreateObject("ADODB.Stream")
             BytesStream.Type = 2
             BytesStream.Open
             BytesStream.WriteText vin
             BytesStream.Position = 0
             BytesStream.CharSet = cSet
             BytesStream.Position = 2
             StringReturn =BytesStream.ReadText
             BytesStream.close
              Set BytesStream = Nothing
             Bytes2bStr = StringReturn
     End Function
Public Function GetContent(byref str,byref start,byref last,byref n)

If Instr(lcase(str),lcase(start))>0 then
		select case n
		case 0	'左右都截取（都取前面）（去处关键字）
		GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))-Len(start)+1)
		GetContent=Left(GetContent,Instr(lcase(GetContent),lcase(last))-1)
		case 1	'左右都截取（都取前面）（保留关键字）
		GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))+1)
		GetContent=Left(GetContent,Instr(lcase(GetContent),lcase(last))+Len(last)-1)
		case 2	'只往右截取（取前面的）（去除关键字）
		GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))-Len(start)+1)
		case 3	'只往右截取（取前面的）（包含关键字）
		GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))+1)
		case 4	'只往左截取（取后面的）（包含关键字）
		GetContent=Left(str,InstrRev(lcase(str),lcase(start))+Len(start)-1)
		case 5	'只往左截取（取后面的）（去除关键字）
		GetContent=Left(str,InstrRev(lcase(str),lcase(start))-1)
		case 6	'只往左截取（取前面的）（包含关键字）
		GetContent=Left(str,Instr(lcase(str),lcase(start))+Len(start)-1)
		case 7	'只往右截取（取后面的）（包含关键字）
		GetContent=Right(str,Len(str)-InstrRev(lcase(str),lcase(start))+1)
		case 8	'只往左截取（取前面的）（去除关键字）
		GetContent=Left(str,Instr(lcase(str),lcase(start))-1)
		case 9	'只往右截取（取后面的）（包含关键字）
		GetContent=Right(str,Len(str)-InstrRev(lcase(str),lcase(start)))
		end select
	Else
		GetContent=""
	End if
End function
'**************************************************************
'截取音乐列表
'**************************************************************
Private Function music_CO(byref music_str)
if rs("musicS") <> "0" then
  music_CO=GetContent(music_str,""&rs("musicS")&"",""&rs("musicO")&"",0)
end if
end Function
'**************************************************************
'截取分类
'**************************************************************
Private Function SClass_CO(byref SClass_str)
if rs("SClassS") <> "0" then
  SClass_CO = GetContent(SClass_str,""&rs("SClassS")&"",""&rs("SClassO")&"",0)
end if
end Function
'**************************************************************
'截取歌手
'**************************************************************
Private Function NClass_CO(byref NClass_str)
if rs("NClassS") <> "0" then
  NClass_CO = GetContent(NClass_str,""&rs("NClassS")&"",""&rs("NClassO")&"",0)
end if
end Function
'**************************************************************
'截取专集名称
'**************************************************************
Private Function Name_CO(byref Name_str)
if rs("NameS") <> "0" then
  Name_CO = GetContent(Name_str,""&rs("NameS")&"",""&rs("NameO")&"",0)
end if
end Function
'**************************************************************
'截取演员
'**************************************************************
Private Function Yuyan_CO(byref Yuyan_str)
if rs("YuyanS") <> "0" then
  Yuyan_CO = GetContent(Yuyan_str,""&rs("YuyanS")&"",""&rs("YuyanO")&"",0)
end if
end Function
'**************************************************************
'截取公司
'**************************************************************
Private Function GongSi_CO(byref GongSi_str)
if rs("GongSiS") <> "0" then
  GongSi_CO = GetContent(GongSi_str,""&rs("GongSiS")&"",""&rs("GongSiO")&"",0)
end if
end Function
'**************************************************************
'截取发行时间
'**************************************************************
Private Function Times_CO(byref Times_str)
if rs("TimesS") <> "0" then
  Times_CO = GetContent(Times_str,""&rs("TimesS")&"",""&rs("TimesO")&"",0)
end if
end Function
'**************************************************************
'截取专集介绍
'**************************************************************
Private Function Info_CO(byref Info_str)
if rs("InfoS") <> "0" then
  Info_CO = GetContent(Info_str,""&rs("InfoS")&"",""&rs("InfoO")&"",0)
end if
  if Info_CO = "" then
     Info_CO = "暂无介绍" 
  end if
end Function
'**************************************************************
'截取专集图片
'**************************************************************
Private Function ima_CO(byref ima_str)
if rs("imaS") <> "0" then
  ima_CO = GetContent(ima_str,""&rs("imaS")&"",""&rs("imaO")&"",0)
end if
end Function
'**************************************************************
'截取歌曲列表
'**************************************************************
Private Function musiclist_CO(byref musiclist_str)
if rs("musicnamelistS") <> "0" then

  musiclist_CO = GetContent(musiclist_str,""&rs("musicnamelistS")&"" ,""&rs("musicnamelistO")&"",0)
end if
end Function
'**************************************************************
'截取歌曲名称
'**************************************************************
Private Function musicname_CO(byref musicname_str)
if rs("imaS") <> "0" then
  musicname_CO = GetContent(musicname_str,""&rs("musicnameS")&"",""&rs("musicnameO")&"",0)
end if
end Function
'**************************************************************
'截取歌曲连接
'**************************************************************
Private Function musicwmaurl_CO(byref musicwmaurl_str)
    if rs("musicwmaurl")="0" then
       musicID=GetContent(musicwmaurl_str,""&rs("musicIDS")&"",""&rs("musicIDO")&"",0)
    else
       musicID=""&rs("musicwmaurl")&""& GetContent(musicwmaurl_str,""&rs("musicIDS")&"",""&rs("musicIDO")&"",0)
    end if
   if rs("playurlStr")="0" then
       musicwmaurl_CO=GetContent(GetFileText(musicID),""&rs("playurlS")&"",""&rs("playurlO")&"",0)
   else
       musicwmaurl_CO=""&rs("playurlStr")&""& doget.GetContent(GetFileText(musicID),""&rs("playurlS")&"",""&rs("playurlO")&"",0)
   end if
end Function
'***************************************************************************
'替换一级分类
'***************************************************************************
Private Function ClassT_CO(byref ClassT_str)
     if rs("ClassT") = 1 then 
       call TLconnstr1
       set rs=server.createobject("adodb.recordset")
       sql="select * from class where TlID =" & request("TlID")   
       rs.Open sql,conn,1,1
       count = rs.recordcount
       for i = 1 to count
         if Trim(rs("TSClass")) = Trim(""&ClassT_str&"") then
	    ClassT_CO = rs("SClass")
         end if
       rs.movenext 
       next
       rs.close   
     else
       ClassT_CO = ClassT_str
     end if
end function
Public function TlLY(TladoStr)
  if request("edit") = "on" then
     response.write ""&TladoStr&""
  else
     response.write "0"
  end if
end function
'-----------------过滤与替换定意-----------------------------
Public function Repla(ReplaGet)
  if rs("Replace1S") <> 0 then
   Replace1 = GetContent(ReplaGet,""&rs("Replace1S")&"",""&rs("Replace1O")&"",0)
   Repla= Replace(ReplaGet,""&ReplaGet&"","")
  end if
  if rs("Replace2") <> 0 then
   Repla= Replace(ReplaGet,""&rs("Replace2")&"","")
  end if
  if rs("Replace3") <> 0 then
   Repla= Replace(ReplaGet,""&rs("Replace3")&"","")
  else
   Repla=ReplaGet
  end if
end function
''''''''''''''''''''''图片保存函数''''''''''''''''''
Private Function save_img(img_url,fldr,fristname)
   if instr(img_url,"http")=0 then
      Response.Write "该图片保存失败" &vbcrlf
         save_img=""
      exit function
   else
      img_name_str = Replace(img_url,"\","/")
      img_name_str = Replace(img_name_str,"//","/")
      f_img_url = split(img_name_str,"/")
      img_name = f_img_url(Ubound(f_img_url))
      fldr ="/"&TlMyfile(fldr)&"/"
      if img_name = "" then
          img_name = f_img_url(Ubound(f_img_url)-1)
      end if
if IsExists(fldr&fristname&"_"&img_name) = False then
	set xmlhttp=server.createobject("Microsoft.XMLHTTP")
	xmlhttp.open "get",img_url,false
	xmlhttp.send
   If xmlhttp.status = 200 Then
	img=xmlhttp.ResponseBody
	set objAdostream=server.createobject("ADODB.Stream")
	objAdostream.type=1
	objAdostream.Mode=3
	objAdostream.Open()
	objAdostream.Write(img)
        objAdostream.SaveToFile(server.mappath(fldr&fristname&"_"&img_name))
        Picgeturl = ""
	objAdostream.SetEOS
	set xmlhttp=nothing
	set objAdostream=nothing
        else
         save_img = ""
         exit function
        end if 
   end if
        save_img="."&fldr&fristname&"_"&img_name
     end if 
end function

'*************************************************************************
'创建文件夹，返回函数TlMyfile，传递过程函数Myfile_Str_name
'*************************************************************************
Private Function TlMyfile(byref Myfile_Str) 
 Set Fso = Server.CreateObject("Scripting.FileSystemObject")
 'GetFold=split(Myfile_Str,"/") 
 'if Fold_i = "0" to Ubound(GetFold)
if FSO.FolderExists(server.MapPath("/"&Myfile_Str&"")) Then 
    zj_FSO = True
 else
    Fso.CreateFolder(Server.Mappath("/"&Myfile_Str&""))
end if
 Set Fso=Nothing
 TlMyfile = Myfile_Str
end Function
'*****************************************************************
'	function（私有）
'	作用 ：利用fso检测文件是否存在,存在返回true,不存在返回false
'	参数 ：filespes（文件位置）
'*****************************************************************
Private Function IsExists(byref filespec) 
	Set FSO  =  Server.CreateObject("Scripting.FileSystemObject")  
	If (FSO.FileExists(server.MapPath(filespec))) Then
	IsExists = True
	Else
	IsExists = False
	End If
	Set FSO  = Nothing
End Function
'*****************************************************************
'	function（私有）
'	作用 ：利用流进行中文编码
'	参数 ：vIn（要进行编码的字符患）
'*****************************************************************
Private Function BytesToBstr(body)
Set ADOS = Server.CreateObject("ADODB.Stream")
	Dim Bdat
	Bdat=Body
	ADOS.Type = 1
	ADOS.Mode =3
	ADOS.Open
	ADOS.Write Bdat