📄 function.asp

📁 音乐管理系统的采集数据程序可自行添加采集点,适合一些大型音乐网站数据的采集
💻 ASP
📖 第 1 页 / 共 2 页
字号:
上一页 12
	ADOS.Position = 0
	ADOS.Type = 2
	ADOS.Charset = "GB2312"
	BytesToBstr = ADOS.ReadText 
	ADOS.Close
	Set ADOS = Nothing
End Function


'*****************************************************************
'	function（私有）
'	作用 ：利用流保存文件
'	参数 ：from（远程文件地址），tofile（保存文件位置）
'*****************************************************************
Private Function SaveFiles(byref from,byref tofile)

	Dim Datas
	Datas=GetData(from,0)
	Response.Write "保存成功：<font color=red>"&formatnumber(len(Datas)/1024*2,2)&"</font>Kb"
	response.Flush
	if formatnumber(len(Datas)/1024*2,2)>1 then
	Set ADOS = Server.CreateObject("ADODB.Stream")
		ADOS.Type = 1
		ADOS.Mode =3
		ADOS.Open
		ADOS.write Datas
		ADOS.SaveToFile server.mappath(tofile),2
		ADOS.Close()
		set ADOS=nothing
	else
		Response.Write "保存失败：<font color=red>文件大小"&formatnumber(len(imgs)/1024*2,2)&"Kb，小于1K</font>"
		response.Flush
	end if
end function



'*****************************************************************
'	function（私有）
'	作用 ：利用fso检测文件夹是否存在,存在返回true,不存在返回false
'	参数 ：folder（文件夹位置）
'*****************************************************************
Private Function IsFolder(byref Folder)
	Set FSO  =  Server.CreateObject("Scripting.FileSystemObject")  
	If FSO.FolderExists(server.MapPath("/"&Folder)) Then  
	IsFolder = True
	Else
	IsFolder = False
	End If
	Set FSO  = Nothing
End Function

'*****************************************************************
'	function（私有）
'	作用 ：利用fso创建文件夹
'	参数 ：fldr（文件夹位置）
'*****************************************************************
Private Function CreateFolder(byref fldr)
	Set FSO  =  Server.CreateObject("Scripting.FileSystemObject")   
	Dim f
	Set f = FSO.CreateFolder(Server.MapPath("/"&fldr))
	CreateFolder = f.Path
	Set f=nothing
End Function

'*****************************************************************
'	function（公有）
'	作用 ：保存文件，并自动创建多级文件夹
'	参数 ：fromurl（远程文件地址），tofiles （保存位置）
'*****************************************************************
Public Function SaveData(byref FromUrl,byref ToFiles)
	ToFiles=trim(Replace(ToFiles,"//","/"))
	flName=ToFiles
	fldr=""
	If IsExists(flName)=false then 
		GetNewsFold=split(flName,"/")
	For i=0 to Ubound(GetNewsFold)-1
		if fldr="" then
			fldr=GetNewsFold(i)
		else
			fldr=fldr&"/"&GetNewsFold(i)
		end if
		If IsFolder(fldr)=false then
			CreateFolder fldr
		End if
	Next

	SaveFiles FromUrl,flName
	SaveData = flName
	else
	SaveData = flName
	end if
End function

'*****************************************************************
'	function（公有）
'	作用 ：取得远程数据
'	参数 ：url（远程文件地址），getmode （模式:0为二进制，1为中文编码）
'*****************************************************************
Public Function GetData(byref url,byref GetMode)
Set OXML = server.CreateObject("Microsoft.XMLHTTP") 
	'on error resume next 
	SourceCode = OXML.open ("GET",url,false)
	OXML.send() 
	If OXML.status = 200 Then
	if OXML.readystate<>4 then exit function
	if GetMode=0 then
	GetData = OXML.responseBody
	else
	GetData = BytesToBstr(OXML.responseBody)
	end if
	end if
	if err.number<>0 then err.Clear
		Set OXML = Nothing 
End Function

'*****************************************************************
'	function（公有）
'	作用 ：格式化远程图片地址为本地位置
'	参数 ：imgurl（远程图片地址），imgfolder （本地图片目录），fristname（加入的前缀名称）
'*****************************************************************
Public Function FormatImgPath(byref ImgUrl,byref ImgFolder,byref FristName,byref noimg)
	strpath=""
	ImgUrl=ImgUrl
	if instr(ImgUrl,"Nophoto") or lenb(GetData(ImgUrl,0))<=0 then
		strpath=noimg
		Response.Write "<a href="&strpath&">"&strpath&"</a>" &vbcrlf
	else
		if Instr(ImgUrl,".asp") then
			strpath=FristName&"_"&Mid(ImgUrl, InStrRev(ImgUrl, "=")+1)&".jpg"
		else
			strpath=FristName&"_"&Mid(ImgUrl, InStrRev(ImgUrl, "/")+1)
		end if
		strpath = ImgFolder&"/"&strpath
		strpath = Replace(strpath,"//","/")
		if left(strpath,1)="/" then strpath=right(strpath,len(strpath)-1)
		strpath = trim(strpath)
		Response.Write "<a href="&strpath&">"&strpath&"</a>" &vbcrlf
		savedata ImgUrl,strpath
	end if
	FormatImgPath = strpath
End function

'*****************************************************************
'	function（公有）
'	作用 ：格式化远程音乐文件地址为本地位置
'	参数 ：MusicUrl（远程文件地址），oServerUrl （原服务连接地址），MusicFolder（本地音乐文件目录）
'*****************************************************************
Public Function FormatMusicPath(byref MusicUrl,byref oServerUrl,byref MusicFolder)
	strpath=""
	strpath = Replace(MusicUrl,oServerUrl,"")
	strpath = MusicFolder&"/"&strpath
	strpath = Replace(strpath,"//","/")
	if left(strpath,1)="/" then strpath=right(strpath,len(strpath)-1)
	FormatMusicPath=trim(strpath)
End function

'*****************************************************************
'	function（公有）
'	作用 ：格式化html
'*****************************************************************
Public Function FormatHtml(Str,itype)
	if itype=0 then
		Str=replace(Str,"chr(39)","") 
		Str=replace(Str,"chr(34)","") 
	end if
	FormatHtml=Str
End function 

'*****************************************************************
'	function（公有）
'	作用 ：截取字符
'	参数 ：str要操作的对像,start开始字符,last结束字符,n模式
'*****************************************************************
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

'*****************************************************************
'	function（公有）
'	作用 ：取得字符的拼音
'*****************************************************************
Public Function GetPyChar(byref Char)
	tmp=65536+asc(Char)
	if(tmp>=45217 and tmp<=45252) or (tmp=65601) or (tmp=65633) or (tmp=37083) then
	 GetPyChar= "A"
	elseif(tmp>=45253 and tmp<=45760) or (tmp=65602) or (tmp=65634) or (tmp=39658) then
	 GetPyChar= "B"
	elseif(tmp>=45761 and tmp<=46317) or (tmp=65603) or (tmp=65635) or (tmp=33405) then
	 GetPyChar= "C"
	elseif(tmp>=46318 and tmp<=46930) or (tmp>=61884 and tmp<=61884) or (tmp=65604) or (tmp>=36820 and tmp<=38524) or (tmp=65636) then
	 GetPyChar= "D"
	elseif(tmp>=46931 and tmp<=47009) or (tmp=65605) or (tmp=65637) or (tmp=61513) then
	 GetPyChar= "E"
	elseif(tmp>=47010 and tmp<=47296) or (tmp=65606) or (tmp=65638) or (tmp=61320) or (tmp=63568) or (tmp=36281) then
	 GetPyChar= "F"
	elseif(tmp>=47297 and tmp<=47613) or (tmp=65607) or (tmp=65639) or (tmp=35949) or (tmp=36089) or (tmp=36694) or (tmp=34808) then
	 GetPyChar= "G"
	elseif(tmp>=47614 and tmp<=48118) or (tmp>=59112 and tmp<=59112) or (tmp=65608) or (tmp=65640) then
	 GetPyChar= "H"
	elseif(tmp=65641) or (tmp=65609) or (tmp=65641) then
	 GetPyChar="I"
	elseif(tmp>=48119 and tmp<=49061 and tmp<>48739) or (tmp>=62430 and tmp<=62430) or (tmp=65610) or (tmp=65642) or (tmp=39048) then
	 GetPyChar= "J"
	elseif(tmp>=49062 and tmp<=49323) or (tmp=65611) or (tmp=65643) then
	 GetPyChar= "K"
	elseif(tmp>=49324 and tmp<=49895) or (tmp>=58838 and tmp<=58838) or (tmp=65612) or (tmp=65644) or (tmp=62418) or (tmp=48739) then
	 GetPyChar= "L"
	elseif(tmp>=49896 and tmp<=50370) or (tmp=65613) or (tmp=65645) then
	 GetPyChar= "M"
	elseif(tmp>=50371 and tmp<=50613) or (tmp=65614) or (tmp=65646) then
	 GetPyChar= "N"
	elseif(tmp>=50614 and tmp<=50621) or (tmp=65615) or (tmp=65647) then
	 GetPyChar= "O"
	elseif(tmp>=50622 and tmp<=50905) or (tmp=65616) or (tmp=65648) then
	 GetPyChar= "P"
	elseif(tmp>=50906 and tmp<=51386) or (tmp>=62659 and tmp<=63172) or (tmp=65617) or (tmp=65649) then
	 GetPyChar= "Q"
	elseif(tmp>=51387 and tmp<=51445) or (tmp=65618) or (tmp=65650) then
	 GetPyChar= "R"
	elseif(tmp>=51446 and tmp<=52217) or (tmp=65619) or (tmp=65651) or (tmp=34009) then
	 GetPyChar= "S"
	elseif(tmp>=52218 and tmp<=52697) or (tmp=65620) or (tmp=65652) then
	 GetPyChar= "T"
	elseif(tmp=65621) or (tmp=65653) then
	 GetPyChar="U"
	elseif(tmp=65622) or (tmp=65654) then
	 GetPyChar="V"
	elseif(tmp>=52698 and tmp<=52979) or (tmp=65623) or (tmp=65655) then
	 GetPyChar= "W"
	elseif(tmp>=52980 and tmp<=53688) or (tmp=65624) or (tmp=65656) then
	 GetPyChar= "X"
	elseif(tmp>=53689 and tmp<=54480) or (tmp=65625) or (tmp=65657) then
	 GetPyChar= "Y"
	elseif(tmp>=54481 and tmp<=62383 and tmp<>59112 and tmp<>58838) or (tmp=65626) or (tmp=65658) or (tmp=38395) or (tmp=39783) then
	 GetPyChar= "Z"
	elseif(tmp=65584) then
	 GetPyChar="0-9"
	elseif(tmp=65585) then
	 GetPyChar="0-9"
	elseif(tmp=65586) then
	 GetPyChar="0-9"
	elseif(tmp=65587) then
	 GetPyChar="0-9"
	elseif(tmp=65588) then
	 GetPyChar="0-9"
	elseif(tmp=65589) then
	 GetPyChar="0-9"
	elseif(tmp=65590) then
	 GetPyChar="0-9"
	elseif(tmp=65591) then
	 GetPyChar="0-9"
	elseif(tmp=65592) then
	 GetPyChar="0-9"
	elseif(tmp=65593) then
	 GetPyChar="0-9"
	else
	 GetPyChar="0-9"
	end if
end function

'*****************************************************************
'	function（公有）
'	作用 ：循环取得字符患的拼音
'*****************************************************************
Public Function GetPy(byref Str)
	for i=1 to len(Str)
		GetPy=GetPy&GetPyChar(mid(Str,i,1))
	next
end function 
'**************************************************************
'截取歌词连接
'**************************************************************
Private Function gc_CO(byref gc_str)
if rs("gc_idS") <> "0" then
  gc_CO = GetContent(gc_str,""&rs("gc_idS")&"",""&rs("gc_idO")&"",0)
end if
if rs("gc_id_str") <> "0" then
  gc_CO = rs("gc_id_str") & gc_CO
end if
end Function
'**************************************************************
'截取歌词
'**************************************************************
Private Function gc_s_CO(byref gc_s_str)
if rs("gc_s") <> "0" then
  gc_s_CO = GetContent(Repla(GetFileText(gc_s_str)),""&rs("gc_s")&"",""&rs("gc_o")&"",0)
end if
if gc_s_CO = "" then
   gc_s_CO = "暂无"
end if
end Function

%>
上一页 12
💿 文件大小 382 K
👤 上传用户 shanon
📂 所属分类其他数据库
🏷️ 相关标签

#采集 #管理系统 #程序 #合一
⌨️ 快捷键说明

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