<%
= 0
= Now() - 1
"pragma", "no-cache"
"cache-control", "private"
= "no-cache"
= True
=999999999
'***************************************************************
'* Definition MusicGet Class
'***************************************************************
Class GetHttp
Private OXML,FSO,ADOS
Private Sub Class_Initialize
Set OXML = ("")
Set FSO = ("")
Set ADOS = ("")
End Sub
Private Sub Class_Terminate
Set OXML = Nothing
Set FSO = Nothing
Set ADOS = Nothing
End Sub
Public Property Get Version
Version="Dynamic Acquisition System v3.0"
End Property
'*****************************************************************
' function (private)
' Function: Use streams to encode Chinese
' Parameters: vIn (character to be encoded)
'*****************************************************************
Private Function BytesToBstr(body)
Dim Bdat
Bdat=Body
= 1
=3
Bdat
= 0
= 2
= "GB2312"
BytesToBstr =
End Function
'*****************************************************************
' function (private)
' Function: Use streams to save files
' Parameters: from (remote file address), tofile (save file location)
'*****************************************************************
Private Function SaveFiles(byref from,byref tofile)
Dim Datas
Datas=GetData(from,0)
"Save successfully: <font color=red>"&formatnumber(len(Datas)/1024*2,2)&"</font>Kb"
if formatnumber(len(Datas)/1024*2,2)>1 then
= 1
=3
Datas
(tofile),2
()
else
"Save failed: <font color=red>File size"&formatnumber(len(imgs)/1024*2,2)&"Kb, less than 1K</font>"
end if
end function
'*****************************************************************
' function (private)
' Function: Use fso to detect whether the file exists. Return true if it exists. If it does not exist, return false if it does not exist.
' Parameters: filespes (file location)
'*****************************************************************
Private Function IsExists(byref filespec)
If (((filespec))) Then
IsExists = True
Else
IsExists = False
End If
End Function
'*****************************************************************
' function (private)
' Function: Use fso to detect whether the folder exists. If it exists, it will return true. If it does not exist, it will return false.
' Parameters: folder (folder location)
'*****************************************************************
Private Function IsFolder(byref Folder)
If ((Folder)) Then
IsFolder = True
Else
IsFolder = False
End If
End Function
'*****************************************************************
' function (private)
' Function: Use fso to create folders
' Parameters: fldr (folder location)
'*****************************************************************
Private Function CreateFolder(byref fldr)
Dim f
Set f = ((fldr))
CreateFolder =
Set f=nothing
End Function
'*****************************************************************
' function (public)
' Function: Save the file and automatically create multi-level folders
' Parameters: fromurl (remote file address), tofiles (save location)
'*****************************************************************
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
End if
End function
'*****************************************************************
' function (public)
' Function: Obtain remote data
' Parameters: url (remote file address), getmode (mode: 0 is binary, 1 is Chinese encoding)
'*****************************************************************
Public Function GetData(byref url,byref GetMode)
'on error resume next
SourceCode = ("GET",url,false)
()
if <>4 then exit function
if GetMode=0 then
GetData =
else
GetData = BytesToBstr()
end if
if <>0 then
End Function
'*****************************************************************
' function (public)
' Function: Format the remote image address to the local location
' Parameters: imgurl (remote image address), imgfolder (local image directory), fristname (added prefix name)
'*****************************************************************
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
"<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)
"<a href="&strpath&">"&strpath&"</a>" &vbcrlf
savedata ImgUrl,strpath
end if
FormatImgPath = strpath
End function
'*****************************************************************
' function (public)
' Function: Format the remote music file address to the local location
' Parameters: MusicUrl (remote file address), oServerUrl (original service connection address), MusicFolder (local music file directory)
'*****************************************************************
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 (public)
' Function: Format html
'*****************************************************************
Public Function FormatHtml(Str,itype)
if itype=0 then
Str=replace(Str,chr(39),"'")
Str=replace(Str,chr(34),""")
Str=replace(Str,"<","<")
Str=replace(Str,">",">")
else
Str=replace(Str,"chr(39)","")
Str=replace(Str,"chr(34)","")
end if
FormatHtml=Str
End function
'*****************************************************************
' function (public)
' Function: Intercept characters
' Parameters: the object to be operated by str, start character, last end character, n mode
'*****************************************************************
Public Function GetContent(byref str,byref start,byref last,byref n)
If Instr(lcase(str),lcase(start))>0 then
select case n
case 0 'Either left and right intercept (both before) (the keyword of the place to go)
GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))-Len(start)+1)
GetContent=Left(GetContent,Instr(lcase(GetContent),lcase(last))-1)
case 1 'Either left and right intercept (both before) (keep the keywords)
GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))+1)
GetContent=Left(GetContent,Instr(lcase(GetContent),lcase(last))+Len(last)-1)
case 2 'Only intercept the right (take the previous one) (remove the keyword)
GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))-Len(start)+1)
case 3 'Only intercept the right (take the previous one) (including keywords)
GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))+1)
case 4 'Only intercept left (take the latter) (including keywords)
GetContent=Left(str,InstrRev(lcase(str),lcase(start))+Len(start)-1)
case 5 'Only intercept left (take the latter) (remove keywords)
GetContent=Left(str,InstrRev(lcase(str),lcase(start))-1)
case 6 'Only intercept left (take the previous one) (including keywords)
GetContent=Left(str,Instr(lcase(str),lcase(start))+Len(start)-1)
case 7 'Only intercept the right (take the latter) (including the keyword)
GetContent=Right(str,Len(str)-InstrRev(lcase(str),lcase(start))+1)
case 8 'Only intercept left (take the previous one) (remove keywords)
GetContent=Left(str,Instr(lcase(str),lcase(start))-1)
case 9 'Only intercept the right (take the latter) (including the keyword)
GetContent=Right(str,Len(str)-InstrRev(lcase(str),lcase(start)))
end select
Else
GetContent=""
End if
End function
'*****************************************************************
' function (public)
' Function: Get the pinyin of the characters
'*****************************************************************
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: loop to get the pinyin of the string
'*****************************************************************
Public Function GetPy(byref Str)
for i=1 to len(Str)
GetPy=GetPy&GetPyChar(mid(Str,i,1))
next
end function
'*****************************************************************
' function (public)
' Function: Obtain song lyrics
'*****************************************************************
Public Function LrcMusicGc(MusicName,singer)
musicGc=Getdata("/m?tn=baidump3lyric&ct=150994944&word="&musicname&"%20"&singer,1)
if instr(musicgc,"It is recommended that you check if there are any errors in the input text") then
MusicGc= "Not yet"
else
musicGc=FormatHtml(musicgc,0)
musicGc=GetContent(musicgc,"Album:<a href="/m?tn=baidump3&ct=134217728&lm=-1&word=","<p align=right>",0)
musicgc=Replace(musicgc,"<","<")
musicgc=Replace(musicgc,">",">")
musicgc=Replace(musicgc," "," ")
musicgc=Replace(musicgc,"<font style=color:#e10900>","")
musicgc=Replace(musicgc,"</font>","")
musicgc=GetContent(musicgc,"<p>","</p>",0)
' musicGc
end if
if musicgc="" then
LrcMusicgc="Not yet"
else
LrcMusicgc=MusicGc
end if
End function
End Class
%>