'---数据库连接 set Conn = Server.CreateObject("ADODB.Connection") Conn.Open "driver={SQL server};server=localhost;uid=mp3;pwd=mp3;database=mp3db"
'---拼SQL语句execute时需要过滤一下 Function IndbStr(str) if isNull(str) or str = "" then IndbStr = str else IndbStr = replace(replace(trim(str),"'","''"),"%","") end if End Function
'---关闭数据库连接 Function CloseConn() conn.close set cOnn=nothing End Function
'---取得远程文件并保存到本地 Function GetRemoteFiles(RemotePath, LocalPath, FileName) Dim strBody Dim FilePath On Error Resume Next '---取得流 strBody = GetBody(RemotePath) '---取得保存的文件名 if Right(LocalPath, 1) <> "\" then LocalPath = LocalPath & "\" if not CheckDir(bkfolder) then MakeNewsDir bkfolder FilePath = LocalPath & GetFileName(RemotePath, FileName) '---保存文件 if SaveToFile(strBody, FilePath) = true and err.Number = 0 then GetRemoteFiles = true else GetRemoteFiles = false end if End Function
'---远程获取内容 Function GetBody(url) Dim Retrieval '---建立XMLHTTP对象 Set Retrieval = CreateObject("Microsoft.XMLHTTP") With Retrieval .Open "Get", url, False, "", "" .Send GetBody = .ResponseBody End With Set Retrieval = Nothing End Function
'---重组文件名 Function GetFileName(RemotePath, FileName) Dim arrTmp Dim strFileExt arrTmp = Split(RemotePath, ".") strFileExt = arrTmp(UBound(arrTmp)) GetFileName = FileName & "." & strFileExt End Function
'---将流内容保存为文件 Function SaveToFile(Stream, FilePath) Dim objStream On Error Resume Next '---建立ADODB.Stream对象,必须要ADO 2.5以上版本 Set objStream = Server.CreateObject("ADODB.Stream") objStream.Type = 1 '以二进制模式打开 objStream.Open objstream.write Stream objstream.SaveToFile FilePath, 2 objstream.Close() '---关闭对象,释放资源 Set objstream = Nothing if err.Number <> 0 then SaveToFile = false else SaveToFile = true end if End Function
'---读取文本文件 Function FSOlinedit(filename,lineNum) if linenum < 1 then exit function dim fso,f,temparray,tempcnt set fso = server.CreateObject("scripting.filesystemobject") if not fso.fileExists(server.mappath(filename)) then exit function set f = fso.opentextfile(server.mappath(filename),1) if not f.AtEndofStream then tempcnt = f.readall f.close set f = nothing temparray = split(tempcnt,chr(13)&chr(10)) if lineNum>ubound(temparray)+1 then exit function else FSOlinedit = temparray(lineNum-1) end if end if End function
'---检查绝对路径是否存在 Function CheckFolder(FolderPath) dim fso1 Set fso1 = CreateObject("Scripting.FileSystemObject") If fso1.FolderExists(FolderPath) then '存在 CheckFolder = True Else '不存在 CheckFolder = False End if Set fso1 = nothing End Function
'---根据指定名称生成目录 Function MakeNewsDir(foldername) dim fso1,f Set fso1 = CreateObject("Scripting.FileSystemObject") Set f = fso1.CreateFolder(foldername) MakeNewsDir = True Set fso1 = nothing End Function
''''''''编码(日文字符)'''''''' Function Jencode(byVal iStr) if isnull(iStr) or isEmpty(iStr) then Jencode="" Exit function end if dim F,i,E E=array("Jn0;","Jn1;","Jn2;","Jn3;","Jn4;","Jn5;","Jn6;","Jn7;","Jn8;","Jn9;","Jn10;","Jn11;","Jn12;","Jn13;","Jn14;","Jn15;","Jn16;","Jn17;","Jn18;","Jn19;","Jn20;","Jn21;","Jn22;","Jn23;","Jn24;","Jn25;") F=array(chr(-23116),chr(-23124),chr(-23122),chr(-23120),_ chr(-23118),chr(-23114),chr(-23112),chr(-23110),_ chr(-23099),chr(-23097),chr(-23095),chr(-23075),_ chr(-23079),chr(-23081),chr(-23085),chr(-23087),_ chr(-23052),chr(-23076),chr(-23078),chr(-23082),_ chr(-23084),chr(-23088),chr(-23102),chr(-23104),_ chr(-23106),chr(-23108)) Jencode=iStr for i=0 to 25 Jencode=replace(Jencode,F(i),E(i)) next End Function
''''''''解码(日文字符)'''''''' Function Juncode(byVal iStr) if isnull(iStr) or isEmpty(iStr) then Juncode="" Exit function end if dim F,i,E E=array("Jn0;","Jn1;","Jn2;","Jn3;","Jn4;","Jn5;","Jn6;","Jn7;","Jn8;","Jn9;","Jn10;","Jn11;","Jn12;","Jn13;","Jn14;","Jn15;","Jn16;","Jn17;","Jn18;","Jn19;","Jn20;","Jn21;","Jn22;","Jn23;","Jn24;","Jn25;") F=array(chr(-23116),chr(-23124),chr(-23122),chr(-23120),_ chr(-23118),chr(-23114),chr(-23112),chr(-23110),_ chr(-23099),chr(-23097),chr(-23095),chr(-23075),_ chr(-23079),chr(-23081),chr(-23085),chr(-23087),_ chr(-23052),chr(-23076),chr(-23078),chr(-23082),_ chr(-23084),chr(-23088),chr(-23102),chr(-23104),_ chr(-23106),chr(-23108)) Juncode=iStr for i=0 to 25 Juncode=replace(Juncode,E(i),F(i))'□ next End Function %>
<% dim t7xiid,url,FolderPath,fso,fout dim songid(100),songname(100) dim strsinger,strlang,stralbum,strtime,strcorp,strcontent,strpicc,singerid,albumid dim rssort,rssinger,rsalbum,rssong,i,m,sql,okimg
t7xiid = FSOlinedit(cfg_name,cfg_line)
url = v_7xialbum_url&"v_"&t7xiid&".htm"
set httpobj=server.createobject("paopao.http")
Err.Clear 'on error resume next
str = "" str = httpobj.get(url)
if str = "" then CloseConn() if t7xiid < 3198 then '---没有检测到时是否递增ID,继续检测 str = t7xiid + 1 FolderPath = Server.MapPath(".\") Set fso = Server.CreateObject("Scripting.FileSystemObject") Set fout = fso.CreateTextFile(FolderPath & "\cfg.txt") fout.WriteLine str fout.close response.write " 当前ID号不存在,正在检查下一ID号 ... " response.write "" else '---不需要递增ID检测时,转到歌曲信息采集 response.write " 歌手专辑信息检查完毕,正在准备检查获取歌曲信息 ... " response.write "" response.end end if else str0 = split(str,"歌 手 : ") str1 = split(str0(1),"") strsinger = IndbStr(str1(0)) response.write " 歌手:"&strsinger
set rssinger = conn.execute("select * from d_singer where singer_name='"&strsinger&"'") '---歌手信息不存在时需要手动添加歌手 if rssinger.eof then response.write " select * from d_singer where singer_name='"&strsinger&"'" response.write "
歌手不存在,需要手动操作添加。
请按以下要求添加歌手:
" %>
">
<% CloseConn() response.end else '---歌手信息已存在,检查专辑信息是否需要入库 singerid = rssinger("id") conn.execute("update d_singer set is_down=0 where id="&singerid) response.write "
歌手信息正确,正在检查获取专辑信息 ... " set rsalbum = conn.execute("select * from d_album where album_singer="&singerid&" and album_name='"&stralbum&"'") if rsalbum.eof then str1 = split(strpicc,".") str2 = str1(0) sql="insert into d_album (album_singer,file_img,album_name,album_lang,album_corp,album_time,album_intro,add_time,is_down,album_7xi) values ('"&singerid&"','"&strpicc&"','"&stralbum&"','"&strlang&"','"&strcorp&"','"&strtime&"','"&strcontent&"','"&now&"',0,"&t7xiid&")" conn.execute(sql) '---采集保存专辑缩略图 okimg = GetRemoteFiles(v_7xipicc_url&strpicc,picc_FolderPath,str2) response.write " 专辑信息检查添加完成,正在检查获取歌曲信息 ..."&" SQL语句:"&sql else response.write "
专辑信息正确,正在准备检查获取歌曲信息 ..." end if rsalbum.close set rsalbum = nothing end if rssinger.close set rssinger = nothing
set rsalbum = conn.execute("select * from d_album where album_singer="&singerid&" and album_name='"&stralbum&"'") albumid = rsalbum("id") rsalbum.close set rsalbum = nothing
response.write "
专辑歌曲信息 "
'----歌曲ID i = 1 str0 = split(str," response.write " 歌曲ID:" do while i <= Ubound(str0) str1 = split(str0(i),chr(34)) songid(i-1) = str1(0) response.write songid(i-1)&" - " i = i + 1 loop response.write "共"&i&"首。"
","") lyric = IndbStr(trim(lyric)) if Instr(lyric,"mp3.baidu.com") then lyric = "暂时还没歌词"
if len(lyric) < 20 or Err <> 0 then lyric = "暂时还没歌词" response.write " 7xi自带歌词不完整,将采集baidu歌词" end if
if lyric = "暂时还没歌词" then Err.Clear tmp_url = "http://mp3.baidu.com/m?f=ms&rn=10&tn=baidump3lyric&ct=150994944&word="&singer&"+"&song response.write " "&tmp_url str0 = httpobj.get(tmp_url) str1 = split(str0,"") if Ubound(str1) >= 1 then str2 = split(str0,"
") str3 = split(str2(1),"
") lyric = str3(0) lyric = replace(lyric," ",chr(13)) lyric = replace(lyric," "," ") lyric = replace(lyric," lyric = replace(lyric,"","") else lyric = "暂时还没歌词" end if end if
response.write " 歌词 - "&lyric
'---将采集到的信息更新到数据库 if is_getrm then conn.execute("update d_mp3 set file_rm='"&filerm&"',mp3_lyric='"&lyric&"',is_down='1' where id="&id) else conn.execute("update d_mp3 set file_rm='"&filerm&"',mp3_lyric='"&lyric&"',is_down='0' where id="&id) end if else '---读取目标页面出错时的处理 conn.execute("update d_mp3_t set file_rm='nourl',is_down='1' where id="&id) response.write "
错误:获取目标页面错误,请检查:"& url &"" response.end end if rssong.movenext loop rssong.close set rssong = nothing CloseConn()
if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[s_sort]') and OBJECTPROPERTY(id, N'IsUserTable') = 1) drop table [dbo].[s_sort] GO
Create TABLE [dbo].[s_sort] ( [ID] [int] IDENTITY (1, 1) NOT NULL , [sort_name] [nvarchar] (20) COLLATE Chinese_PRC_CI_AS NOT NULL ) ON [PRIMARY] GO
Alter TABLE [dbo].[s_sort] WITH NOCHECK ADD CONSTRAINT [PK_s_sort] PRIMARY KEY CLUSTERED ( [ID] ) ON [PRIMARY] GO
d_singer ----歌手信息表
if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[d_singer]') and OBJECTPROPERTY(id, N'IsUserTable') = 1) drop table [dbo].[d_singer] GO
Alter TABLE [dbo].[d_singer] WITH NOCHECK ADD CONSTRAINT [PK_d_singer] PRIMARY KEY CLUSTERED ( [ID] ) ON [PRIMARY] GO
d_album ----专辑信息表
if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[d_album]') and OBJECTPROPERTY(id, N'IsUserTable') = 1) drop table [dbo].[d_album] GO