lyrics.asp

打开目录ads文件夹 找到top_ads.js文件 用记事本打开后就可以看到: -------------------------------------- var head_ads_tx

<%
	
	Option Explicit
	

	Dim Music_Name

	Music_Name = Request("Music")

	If (Trim(Music_Name) = "") Then
		Response.Write(NoExsits(Music_Name))
		Response.End
	End If

	Dim Artist, Title
	Dim Lyrics
	Lyrics = GetLyrics(Music_Name)

	Dim TagArrayTxt, LrcArrayTxt, EmtyLrc, CharSet
	Dim TitleN

	CharSet = "GB2312"
	Response.ContentType = "application/xml"
	Response.CharSet = CharSet

	If (Lyrics <> "") Then

		Call GetArrayTxt(Lyrics)

		Response.Write(XMLOut())

	Else

		Response.Write(NoExsits(Music_Name))

	End If
	'************************************************************************************************
	'************* 自 ******* 定 ******* 义 ******* 函 ******* 数 ******* 开 ******* 始 *************
	'************************************************************************************************
	
	Sub InitMusicInfo(Music_Name, Param)
		
		Dim sub1

		sub1 = Instr(Music_Name, " - ")
		If (sub1 > 0) Then
			Artist = Trim(Left(Music_Name, sub1 - 1))
			Title = Trim(Mid(Music_Name, sub1 + 3))
		Else
			Title = Trim(Music_Name)
		End If
		
		If (Param = 1) Then

			TitleN = FilterStr("([\x00-\x2f]|[\x3a-\x40]|[\x5b-\x60]|[\x7b-\xff]|《|》|＜｜＞)", Title)
			If (TitleN <> "") Then
				If (TitleN <> Title) Then
					Title = TitleN
				End If
				If (Lyrics = "") Then
					Title = TitleN
				End If
			End If
		
		End If

	End Sub
	
	'************************************************************************************************

	Function GetSql(Byval Artist, Byval Title)

		If (Title <> "") Then
			If (Artist = "") Then
				GetSql = "Select * From [music_song] Where name = '" & Title & "'"
			Else
				GetSql = "Select * From [music_song] Where name = '" & Title & "' And singer = '" & Artist & "'"
			End If
		Else
			GetSql = ""
		End If

	End Function
	
	'************************************************************************************************

	Function GetLyrics(Byval Music_Name)

		Dim LRCConn, LRCConnStr, DB
		Dim LRCRS, LRCSql

		DB = Server.MapPath("../23freeonline/#23#free#0773gl.asp")
		LRCConnStr = "Provider = Microsoft.Jet.OLEDB.4.0; Data Source = " & DB

		Set LRCConn = Server.CreateObject("ADODB.Connection")
		LRCConn.Open LRCConnStr

			Set LRCRS = Server.CreateObject("ADODB.RecordSet")

			Call InitMusicInfo(Music_Name, 0)
			LRCSql = GetSql(Artist, Title)
			If (LRCSql <> "") Then
				LRCRS.Open LRCSql, LRCConn, 3, 3
					If (Not LRCRS.Eof) Then GetLyrics = LRCRS("words")
				LRCRS.Close
			End If
			
			If (GetLyrics = "") Then
				If (LRCSql <> "") Then
					Call InitMusicInfo(Music_Name, 1)
					LRCSql = GetSql(Artist, Title)
					LRCRS.Open LRCSql, LRCConn, 3, 3
						If (Not LRCRS.Eof) Then GetLyrics = LRCRS("words")
					LRCRS.Close
				End If
			End If

			Set LRCRS = Nothing

		LRCConn.Close
		Set LRCConn = Nothing

	End Function

	'************************************************************************************************

	Function GetInfo(Byval Prefix, Byval Postfix, Byval SearchStr)	'获取两字符串间的字符
			
		Dim PrePos, PostPos, PreLen, PostLen

		PrePos = Instr(SearchStr, Prefix)
		PostPos = Instr(PrePos + 1, SearchStr, Postfix)

		If (PrePos = 0 Or PostPos = 0) Then
			GetInfo = ""
		Else
			PreLen = Len(Prefix)
			PostLen = Len(Postfix)
			GetInfo = Mid(SearchStr, PrePos + PreLen, PostPos - PrePos - PreLen)
		End If
		
	End Function

	'************************************************************************************************

	Sub GetArrayTxt(Byval Lrc)	'获取时间和歌词对应数组并排序
	
		Dim RegExp, Pattern
		Dim Match, Matches
		Dim i, MatchNum
		Dim CurTag, NextTag, CurLrc

		Set RegExp = New RegExp
		Pattern = "\[\d+:\d+(\.\d+)?\]"
		RegExp.Pattern = Pattern
		RegExp.IgnoreCase = True
		RegExp.Global = True

		Set Matches = RegExp.Execute(Lrc)
		MatchNum = Matches.Count
		For i = 1 To MatchNum
			CurTag = Matches.Item(i - 1).Value
			If (i <> MatchNum) Then
				NextTag = Matches.Item(i).Value
			Else
				NextTag = ""
			End If
			TagArrayTxt = TagArrayTxt & "|" & Tag2Num(CurTag)
			CurLrc = GetLrcTxt(CurTag, NextTag, Lrc)
			If (CurLrc <> "") Then LrcArrayTxt = LrcArrayTxt & CurLrc
		Next

		TagArrayTxt = Mid(TagArrayTxt, 2)
		LrcArrayTxt = Mid(LrcArrayTxt, 4)

		Call FormatArrayTxt()

	End Sub

	'************************************************************************************************

	Function Tag2Num(Byval TagStr)	'标签转换成数值

		Dim Pos1, Pos2
		Dim mi, se, ms

		TagStr = Replace(TagStr, "[", "")
		TagStr = Replace(TagStr, "]", "")
		Pos1 = Instr(TagStr, ":")
		Pos2 = Instr(TagStr, ".")
		mi = Left(TagStr, Pos1 - 1)
		If (Pos2 > 0) Then
			se = Mid(TagStr, Pos1 + 1, Pos2 - Pos1 - 1)
			ms = Mid(TagStr, Pos2 + 1)
			If (Len(ms) = 1) Then
 				ms = ms * 100
 			ElseIf (Len(ms) = 2) Then
			    ms = ms * 10
	   		End If
			Tag2Num = (mi * 60 + se) * 1000 + ms
		Else
			se = Mid(TagStr, Pos1 + 1)
			Tag2Num = (mi * 60 + se) * 1000
		End If

	End Function

	'************************************************************************************************

	Function GetLrcTxt(Byval CurTag, Byval NextTag, Byval Lrc)	'获取歌词单句
		
		Dim RegExp, Pattern
		Dim StrPre, StrPost
		Dim Match, Matches
		Dim LrcTxt, i

		Set RegExp = New RegExp
		StrPre = Replace(CurTag, "[", "\[")
		StrPre = Replace(StrPre, ".", "\.")
		StrPre = Replace(StrPre, "]", "\]")
		If (NextTag = CurTag) Then
			StrPost = ""
		Else
			StrPost = Replace(NextTag, "[", "\[")
			StrPost = Replace(StrPost, ".", "\.")
			StrPost = Replace(StrPost, "]", "\]")
		End If
		Pattern = StrPre & "(.|\n)*" & StrPost
		RegExp.Pattern = Pattern
		RegExp.IgnoreCase = True
		RegExp.Global = True
		
		Set Matches = RegExp.Execute(Lrc)
		For Each Match In Matches
			LrcTxt = LrcTxt & Match.Value
		Next

		LrcTxt = FilterStr("\[[^\:]*\:[^\]]*\]", LrcTxt)
		If (LrcTxt <> "" Or NextTag = "") Then
			LrcTxt = FilterStr("(\n|\r)+(.|\n)*", LrcTxt)
			GetLrcTxt = "[:]" & LrcTxt
			If (EmtyLrc > 0) Then
				For i = 1 To EmtyLrc
					GetLrcTxt = GetLrcTxt & "[:]" & LrcTxt
				Next
				EmtyLrc = 0
			End If
		Else
			EmtyLrc = EmtyLrc + 1
			GetLrcTxt = ""
		End If

	End Function

	'************************************************************************************************

	Function FilterStr(Byval Pattern, Byval Str)	'将无效标签[*:*]过滤掉
		
		Dim RegExp
		Dim Match, Matches
		Dim MatchStr

		Set RegExp = New RegExp
		RegExp.Pattern = Pattern
		RegExp.IgnoreCase = True
		RegExp.Global = True

		Str = RegExp.Replace(Str, "")

		FilterStr = Str

	End Function

	'************************************************************************************************

	Sub FormatArrayTxt()	'排序

		Dim i, j, n, TagT, LrcT
		Dim TagArray, LrcArray

		TagArray = Split(TagArrayTxt, "|")
		LrcArray = Split(LrcArrayTxt, "[:]")

		n = UBound(TagArray)

		For i = 0 To n - 1
			For j = 0 To n - i - 1
				If (TagArray(j) - TagArray(j + 1) > 0) Then
					TagT = TagArray(j)
					TagArray(j) = TagArray(j + 1)
					TagArray(j + 1) = TagT
					LrcT = LrcArray(j)
					LrcArray(j) = LrcArray(j + 1)
					LrcArray(j + 1) = LrcT
				End If
			Next
		Next

		TagArrayTxt = TagArray(0)
		LrcArrayTxt = LrcArray(0)
        For i = 1 To n
			TagArrayTxt = TagArrayTxt & "|" & TagArray(i)
            LrcArrayTxt = LrcArrayTxt & "[:]" & LrcArray(i)
		Next

	End Sub

	'************************************************************************************************

	Function XMLOut()	'XML输出

		Dim i, n
		Dim TagArray, LrcArray
		Dim XMLStr

		TagArray = Split(TagArrayTxt, "|")
		LrcArray = Split(LrcArrayTxt, "[:]")
		XMLStr = "<?xml version=""1.0"" encoding=""" & CharSet & """ standalone=""yes""?>" & VbCrLf
		XMLStr = XMLStr & "<!DOCTYPE MUSIC [" & VbCrLf
		XMLStr = XMLStr & "	<!ELEMENT MUSIC (ARTIST, TITLE, LANGUAGE, EDITER, OFFSET, LYRICS)>" & VbCrLf
		XMLStr = XMLStr & "	<!ELEMENT ARTIST (#PCDATA)>" & VbCrLf
		XMLStr = XMLStr & "	<!ELEMENT TITLE (#PCDATA)>" & VbCrLf
		XMLStr = XMLStr & "	<!ELEMENT LANGUAGE (#PCDATA)>" & VbCrLf
		XMLStr = XMLStr & "	<!ELEMENT EDITER (#PCDATA)>" & VbCrLf
		XMLStr = XMLStr & "	<!ELEMENT OFFSET (#PCDATA)>" & VbCrLf
		XMLStr = XMLStr & "	<!ELEMENT LYRICS (LRC)*>" & VbCrLf
		XMLStr = XMLStr & "	<!ELEMENT LRC (#PCDATA)>" & VbCrLf
		XMLStr = XMLStr & "	<!ATTLIST LRC" & VbCrLf
		XMLStr = XMLStr & "		TAG CDATA #REQUIRED>" & VbCrLf
		XMLStr = XMLStr & "]>" & VbCrLf
		XMLStr = XMLStr & "<MUSIC>" & VbCrLf

		n = UBound(TagArray)
		
		XMLStr = XMLStr & "	<ARTIST>" & ReplaceStr(GetInfo("[ar:", "]", Lyrics)) & "</ARTIST>" & VbCrLf
		XMLStr = XMLStr & "	<TITLE>" & ReplaceStr(GetInfo("[ti:", "]", Lyrics)) & "</TITLE>" & VbCrLf
		XMLStr = XMLStr & "	<LANGUAGE>" & ReplaceStr(GetInfo("[la:", "]", Lyrics)) & "</LANGUAGE>" & VbCrLf
		XMLStr = XMLStr & "	<EDITER>" & ReplaceStr(GetInfo("[by:", "]", Lyrics)) & "</EDITER>" & VbCrLf
		XMLStr = XMLStr & "	<OFFSET>" & ReplaceStr(GetInfo("[offset:", "]", Lyrics)) & "</OFFSET>" & VbCrLf
		XMLStr = XMLStr & "	<LYRICS>" & VbCrLf
		For i = 0 To n
			XMLStr = XMLStr & "		<LRC TAG=""" & TagArray(i) & """>" & ReplaceStr(LrcArray(i)) & "</LRC>" & VbCrLf
		Next
		XMLStr = XMLStr & "	</LYRICS>" & VbCrLf
		XMLStr = XMLStr & "</MUSIC>"

		XMLOut = XMLStr

	End Function

'************************************************************************************************

	Function NoExsits(Byval Music_Name)	'不存在输出

		Dim LrcNoExsitsXML

		LrcNoExsitsXML = "<?xml version=""1.0"" encoding=""" & CharSet & """ standalone=""yes""?>" & VbCrLf
		LrcNoExsitsXML = LrcNoExsitsXML & "<!DOCTYPE MUSIC [" & VbCrLf
		LrcNoExsitsXML = LrcNoExsitsXML & "	<!ELEMENT MUSIC (#PCDATA)>" & VbCrLf
		LrcNoExsitsXML = LrcNoExsitsXML & "]>" & VbCrLf
		LrcNoExsitsXML = LrcNoExsitsXML & "<MUSIC>" & VbCrLf
                LrcNoExsitsXML = LrcNoExsitsXML & "	未能找到歌词 """ & ReplaceStr(Music_Name) & """" & VbCrLf
		LrcNoExsitsXML = LrcNoExsitsXML & "</MUSIC>" & VbCrLf
		
		NoExsits = LrcNoExsitsXML
	
	End Function

'************************************************************************************************

	Function ReplaceStr(Byval Str)	'替换干扰特殊实体"&"和"<"

		Str = Replace(Str, "&", "&amp;")
		ReplaceStr = Replace(Str, "<", "&lt;")

	End Function

'************************************************************************************************
	'************* 自 ******* 定 ******* 义 ******* 函 ******* 数 ******* 结 ******* 束 *************
	'************************************************************************************************

%>