复制代码 代码如下:
<%
Response.Expires=0
Response.expiresabsolute=Now()-1
Response.addHeader"pragma","no-cache"
Response.addHeader"cache-control","private"
Response.CacheControl="no-cache"
Response.Buffer=True
Response.Clear
Server.ScriptTimeOut=999999999
'***************************************************************
'*定义MusicGet类
'***************************************************************
ClassGetHttp
PrivateOXML,FSO,ADOS
PrivateSubClass_Initialize
SetOXML=server.CreateObject("Microsoft.XMLHTTP")
SetFSO=Server.CreateObject("Scripting.FileSystemObject")
SetADOS=Server.CreateObject("ADODB.Stream")
EndSub

PrivateSubClass_Terminate
SetOXML=Nothing
SetFSO=Nothing
SetADOS=Nothing
EndSub

PublicPropertyGetVersion
Version="动感采集系统v3.0"
EndProperty

'*****************************************************************
'function（私有）
'作用：利用流进行中文编码
'参数：vIn（要进行编码的字符患）
'*****************************************************************
PrivateFunctionBytesToBstr(body)
DimBdat
Bdat=Body
ADOS.Type=1
ADOS.Mode=3
ADOS.Open
ADOS.WriteBdat
ADOS.Position=0
ADOS.Type=2
ADOS.Charset="GB2312"
BytesToBstr=ADOS.ReadText
ADOS.Close
EndFunction


'*****************************************************************
'function（私有）
'作用：利用流保存文件
'参数：from（远程文件地址），tofile（保存文件位置）
'*****************************************************************
PrivateFunctionSaveFiles(byreffrom,byreftofile)
DimDatas
Datas=GetData(from,0)
Response.Write"保存成功：<fontcolor=red>"&formatnumber(len(Datas)/1024*2,2)&"</font>Kb"
response.Flush
ifformatnumber(len(Datas)/1024*2,2)>1then
ADOS.Type=1
ADOS.Mode=3
ADOS.Open
ADOS.writeDatas
ADOS.SaveToFileserver.mappath(tofile),2
ADOS.Close()
else
Response.Write"保存失败：<fontcolor=red>文件大小"&formatnumber(len(imgs)/1024*2,2)&"Kb，小于1K</font>"
response.Flush
endif
endfunction

'*****************************************************************
'function（私有）
'作用：利用fso检测文件是否存在,存在返回true,不存在返回false
'参数：filespes（文件位置）
'*****************************************************************
PrivateFunctionIsExists(byreffilespec)
If(FSO.FileExists(server.MapPath(filespec)))Then
IsExists=True
Else
IsExists=False
EndIf
EndFunction

'*****************************************************************
'function（私有）
'作用：利用fso检测文件夹是否存在,存在返回true,不存在返回false
'参数：folder（文件夹位置）
'*****************************************************************
PrivateFunctionIsFolder(byrefFolder)
IfFSO.FolderExists(server.MapPath(Folder))Then
IsFolder=True
Else
IsFolder=False
EndIf
EndFunction

'*****************************************************************
'function（私有）
'作用：利用fso创建文件夹
'参数：fldr（文件夹位置）
'*****************************************************************
PrivateFunctionCreateFolder(byreffldr)
Dimf
Setf=FSO.CreateFolder(Server.MapPath(fldr))
CreateFolder=f.Path
Setf=nothing
EndFunction

'*****************************************************************
'function（公有）
'作用：保存文件，并自动创建多级文件夹
'参数：fromurl（远程文件地址），tofiles（保存位置）
'*****************************************************************
PublicFunctionSaveData(byrefFromUrl,byrefToFiles)
ToFiles=trim(Replace(ToFiles,"//","/"))
flName=ToFiles
fldr=""
IfIsExists(flName)=falsethen
GetNewsFold=split(flName,"/")
Fori=0toUbound(GetNewsFold)-1
iffldr=""then
fldr=GetNewsFold(i)
else
fldr=fldr&"\"&GetNewsFold(i)
endif
IfIsFolder(fldr)=falsethen
CreateFolderfldr
Endif
Next
SaveFilesFromUrl,flName
Endif
Endfunction

'*****************************************************************
'function（公有）
'作用：取得远程数据
'参数：url（远程文件地址），getmode（模式:0为二进制，1为中文编码）
'*****************************************************************
PublicFunctionGetData(byrefurl,byrefGetMode)
'onerrorresumenext
SourceCode=OXML.open("GET",url,false)
OXML.send()
ifOXML.readystate<>4thenexitfunction
ifGetMode=0then
GetData=OXML.responseBody
else
GetData=BytesToBstr(OXML.responseBody)
endif
iferr.number<>0thenerr.Clear
EndFunction

'*****************************************************************
'function（公有）
'作用：格式化远程图片地址为本地位置
'参数：imgurl（远程图片地址），imgfolder（本地图片目录），fristname（加入的前缀名称）
'*****************************************************************
PublicFunctionFormatImgPath(byrefImgUrl,byrefImgFolder,byrefFristName,byrefnoimg)
strpath=""
ImgUrl=ImgUrl
ifinstr(ImgUrl,"Nophoto")orlenb(GetData(ImgUrl,0))<=0then
strpath=noimg
Response.Write"<ahref="&strpath&">"&strpath&"</a>"&vbcrlf
else
ifInstr(ImgUrl,".asp")then
strpath=FristName&"_"&Mid(ImgUrl,InStrRev(ImgUrl,"=")+1)&".jpg"
else
strpath=FristName&"_"&Mid(ImgUrl,InStrRev(ImgUrl,"/")+1)
endif
strpath=ImgFolder&"/"&strpath
strpath=Replace(strpath,"//","/")
ifleft(strpath,1)="/"thenstrpath=right(strpath,len(strpath)-1)
strpath=trim(strpath)
Response.Write"<ahref="&strpath&">"&strpath&"</a>"&vbcrlf
savedataImgUrl,strpath
endif
FormatImgPath=strpath
Endfunction

'*****************************************************************
'function（公有）
'作用：格式化远程音乐文件地址为本地位置
'参数：MusicUrl（远程文件地址），oServerUrl（原服务连接地址），MusicFolder（本地音乐文件目录）
'*****************************************************************
PublicFunctionFormatMusicPath(byrefMusicUrl,byrefoServerUrl,byrefMusicFolder)
strpath=""
strpath=Replace(MusicUrl,oServerUrl,"")
strpath=MusicFolder&"/"&strpath
strpath=Replace(strpath,"//","/")
ifleft(strpath,1)="/"thenstrpath=right(strpath,len(strpath)-1)
FormatMusicPath=trim(strpath)
Endfunction

'*****************************************************************
'function（公有）
'作用：格式化html
'*****************************************************************
PublicFunctionFormatHtml(Str,itype)
ifitype=0then
Str=replace(Str,chr(39),"&#39;")
Str=replace(Str,chr(34),"&quot;")
Str=replace(Str,"<","&lt;")
Str=replace(Str,">","&gt;")
else
Str=replace(Str,"chr(39)","")
Str=replace(Str,"chr(34)","")
endif
FormatHtml=Str
Endfunction

'*****************************************************************
'function（公有）
'作用：截取字符
'参数：str要操作的对像,start开始字符,last结束字符,n模式
'*****************************************************************
PublicFunctionGetContent(byrefstr,byrefstart,byreflast,byrefn)
IfInstr(lcase(str),lcase(start))>0then
selectcasen
case0'左右都截取（都取前面）（去处关键字）
GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))-Len(start)+1)
GetContent=Left(GetContent,Instr(lcase(GetContent),lcase(last))-1)
case1'左右都截取（都取前面）（保留关键字）
GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))+1)
GetContent=Left(GetContent,Instr(lcase(GetContent),lcase(last))+Len(last)-1)
case2'只往右截取（取前面的）（去除关键字）
GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))-Len(start)+1)
case3'只往右截取（取前面的）（包含关键字）
GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))+1)
case4'只往左截取（取后面的）（包含关键字）
GetContent=Left(str,InstrRev(lcase(str),lcase(start))+Len(start)-1)
case5'只往左截取（取后面的）（去除关键字）
GetContent=Left(str,InstrRev(lcase(str),lcase(start))-1)
case6'只往左截取（取前面的）（包含关键字）
GetContent=Left(str,Instr(lcase(str),lcase(start))+Len(start)-1)
case7'只往右截取（取后面的）（包含关键字）
GetContent=Right(str,Len(str)-InstrRev(lcase(str),lcase(start))+1)
case8'只往左截取（取前面的）（去除关键字）
GetContent=Left(str,Instr(lcase(str),lcase(start))-1)
case9'只往右截取（取后面的）（包含关键字）
GetContent=Right(str,Len(str)-InstrRev(lcase(str),lcase(start)))
endselect
Else
GetContent=""
Endif
Endfunction

'*****************************************************************
'function（公有）
'作用：取得字符的拼音
'*****************************************************************
PublicFunctionGetPyChar(byrefChar)
tmp=65536+asc(Char)
if(tmp>=45217andtmp<=45252)or(tmp=65601)or(tmp=65633)or(tmp=37083)then
GetPyChar="A"
elseif(tmp>=45253andtmp<=45760)or(tmp=65602)or(tmp=65634)or(tmp=39658)then
GetPyChar="B"
elseif(tmp>=45761andtmp<=46317)or(tmp=65603)or(tmp=65635)or(tmp=33405)then
GetPyChar="C"
elseif(tmp>=46318andtmp<=46930)or(tmp>=61884andtmp<=61884)or(tmp=65604)or(tmp>=36820andtmp<=38524)or(tmp=65636)then
GetPyChar="D"
elseif(tmp>=46931andtmp<=47009)or(tmp=65605)or(tmp=65637)or(tmp=61513)then
GetPyChar="E"
elseif(tmp>=47010andtmp<=47296)or(tmp=65606)or(tmp=65638)or(tmp=61320)or(tmp=63568)or(tmp=36281)then
GetPyChar="F"
elseif(tmp>=47297andtmp<=47613)or(tmp=65607)or(tmp=65639)or(tmp=35949)or(tmp=36089)or(tmp=36694)or(tmp=34808)then
GetPyChar="G"
elseif(tmp>=47614andtmp<=48118)or(tmp>=59112andtmp<=59112)or(tmp=65608)or(tmp=65640)then
GetPyChar="H"
elseif(tmp=65641)or(tmp=65609)or(tmp=65641)then
GetPyChar="I"
elseif(tmp>=48119andtmp<=49061andtmp<>48739)or(tmp>=62430andtmp<=62430)or(tmp=65610)or(tmp=65642)or(tmp=39048)then
GetPyChar="J"
elseif(tmp>=49062andtmp<=49323)or(tmp=65611)or(tmp=65643)then
GetPyChar="K"
elseif(tmp>=49324andtmp<=49895)or(tmp>=58838andtmp<=58838)or(tmp=65612)or(tmp=65644)or(tmp=62418)or(tmp=48739)then
GetPyChar="L"
elseif(tmp>=49896andtmp<=50370)or(tmp=65613)or(tmp=65645)then
GetPyChar="M"
elseif(tmp>=50371andtmp<=50613)or(tmp=65614)or(tmp=65646)then
GetPyChar="N"
elseif(tmp>=50614andtmp<=50621)or(tmp=65615)or(tmp=65647)then
GetPyChar="O"
elseif(tmp>=50622andtmp<=50905)or(tmp=65616)or(tmp=65648)then
GetPyChar="P"
elseif(tmp>=50906andtmp<=51386)or(tmp>=62659andtmp<=63172)or(tmp=65617)or(tmp=65649)then
GetPyChar="Q"
elseif(tmp>=51387andtmp<=51445)or(tmp=65618)or(tmp=65650)then
GetPyChar="R"
elseif(tmp>=51446andtmp<=52217)or(tmp=65619)or(tmp=65651)or(tmp=34009)then
GetPyChar="S"
elseif(tmp>=52218andtmp<=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>=52698andtmp<=52979)or(tmp=65623)or(tmp=65655)then
GetPyChar="W"
elseif(tmp>=52980andtmp<=53688)or(tmp=65624)or(tmp=65656)then
GetPyChar="X"
elseif(tmp>=53689andtmp<=54480)or(tmp=65625)or(tmp=65657)then
GetPyChar="Y"
elseif(tmp>=54481andtmp<=62383andtmp<>59112andtmp<>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"
endif
endfunction

'*****************************************************************
'function（公有）
'作用：循环取得字符串的拼音
'*****************************************************************
PublicFunctionGetPy(byrefStr)
fori=1tolen(Str)
GetPy=GetPy&GetPyChar(mid(Str,i,1))
next
endfunction

'*****************************************************************
'function（公有）
'作用：取得歌曲歌词
'*****************************************************************
PublicFunctionLrcMusicGc(MusicName,singer)
musicGc=Getdata("http://mp3.baidu.com/m?tn=baidump3lyric&ct=150994944&word="&musicname&"%20"&singer,1)
ifinstr(musicgc,"建议您检查输入文字有无错误")then
MusicGc="暂无"
else
musicGc=FormatHtml(musicgc,0)
musicGc=GetContent(musicgc,"专辑:&lt;ahref=&quot;http://mp3.baidu.com/m?tn=baidump3&ct=134217728&lm=-1&word=","&lt;palign=right&gt;",0)
musicgc=Replace(musicgc,"&lt;","<")
musicgc=Replace(musicgc,"&gt;",">")
musicgc=Replace(musicgc,"&nbsp;","")
musicgc=Replace(musicgc,"<fontstyle=color:#e10900>","")
musicgc=Replace(musicgc,"</font>","")
musicgc=GetContent(musicgc,"<p>","</p>",0)
'response.writemusicGc
endif
ifmusicgc=""then
LrcMusicgc="暂无"
else
LrcMusicgc=MusicGc
endif
Endfunction
EndClass
%>