当前位置:编程学习 > asp >>

asp实现的7xi音乐网的采集源代码

答案:共5个文件:
2个是配置文件:
配置文件:
cfg.txt '---保存检测ID信息的,第一次采集时设为1,从小到大检测
cfg.asp '---ASP的配置信息,内容如下:
复制代码 代码如下:

<%
'''
'''╔=======================================╗
'''┆ ┆
'''┆ @系统: 7xi音乐采集系统 Version 2.0 ┆
'''┆ @模块: 配置文件 ┆
'''┆ @创建: 2006/07/24 ┆
'''┆ @作者: D.S.Fang ┆
'''┆ @联系: fangds@gmail.com QQ-3700909 ┆
'''┆ @版权: 源码公开,无任何版权问题,您可以 ┆
'''┆ 放心使用!!!尊重作者劳动成果,请 ┆
'''┆ 保留此信息! ┆
'''┆ ┆
'''╚=======================================╝
'''
'
dim picc_FolderPath,mp3_FolderPath
dim v_7xijs_url,v_7xipicc_url,v_7xiplay_url,v_7xialbum_url,v_7ximp3_url,cfg_name,cfg_line
dim httpobj,str,str0,str1,str2,str3,str4,str5,str6,str7,str8,str9
dim is_getrm

'---音乐文件是否保存到本地,true-保存;false-不保存
is_getrm = false

'---保存路径
picc_FolderPath = "H:\mp3data\images\"
mp3_FolderPath = "H:\mp3data\rm\"

'---7xi相关页面
v_7xijs_url = "http://7xi.net/player/Js.js"
v_7xipicc_url = "http://ww.7xi.net/picc/"
v_7xiplay_url = "http://7xi.net/playsong/"
v_7xialbum_url = "http://ww.7xi.net/Vo2/"
v_7ximp3_url = "" '---实时读取

'---检测ID
cfg_name = "cfg.txt"
cfg_line = 1

'---读取播放js文件,获得rm文件路径
set httpobj = server.createobject("paopao.http")
str = httpobj.get(v_7xijs_url)
str0 = split(str,"theurl2="&chr(34))
str1 = split(str0(1),chr(34))
v_7ximp3_url = str1(0)
set httpobj = nothing
str = ""

'---数据库连接
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
%>


1个是手动添加歌手:
addsinger.asp '---手动添加歌手,内容如下:

程序代码
<%
'''
'''╔=======================================╗
'''┆ ┆

上一个:Highlight patterns within strings
下一个:全面优化ASP应用程序的性能的方法

CopyRight © 2022 站长资源库 编程知识问答 zzzyk.com All Rights Reserved
部分文章来自网络,