www.gusucode.com > 流光音乐建站系统 1.1码程序 > admin/ModFyLrc.asp

    <link href="Images/Admin_Style.Css" rel="stylesheet" type="text/css">
<!--#include file="Const.Asp"-->
<!--#include file="../inc/Function.asp"-->
<%
'===========================版权信息===============================
' 流光音乐系统 1.0
' Homepage  : http://www.ad968.cn
' E-Mail : 77280511@qq.com
' QQ : 77280511 
'请保留版权信息,以便我们更好的为您服务
'==================================================================
Act = Request("Act")

Select Case Act
	Case "GET"
	Call IDModfy()
	Case Else
	Call Main()
End Select 

Sub Main()
	Dim MusicCount
	MusicCount = Conn.Execute("Select Count(ID) From LrcWord")(0)
	Conn.Close
	Set Conn = Nothing
%>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>批量修改LRC歌词</title>
<link href="Images/Admin_Style.Css" rel="stylesheet" type="text/css">
</head>
<body>
<b>批量修改歌词<form name=pid method="GET" action="?"><input type="hidden" name="Act" value="GET">超始ID:<input size=8 name="ID" value='1'> 终止ID:<input size=8 name="EndID" value='<%=MusicCount%>'><input name="change" class="buttonface" value="确认生成" type="submit"></form>
</body>
</html>
<%
End Sub


Sub IDModfy()
	Server.ScriptTimeOut = 99999
	ID = CheckRequest("ID")
	EndID = CheckRequest("EndID")
	Dim DoGet,WDown,Rs
	Dim TexGeci,LrcGeci

	If CLng(ID) > CLng(EndID) Then
		Rw "修改完成!"
		Response.End
	End If

	Set Rs = Server.CreateObject("ADODB.RecordSet")
	mSql="Select top 2 MusicID,Singer,MusicName,SpecialName,Words From [LrcWord] Where MusicID >= " & Request("ID") & " Order By MusicID Asc"
	Rs.Open mSql,Conn,1,1
	Do While Not Rs.Eof

		If CLng(Rs("MusicID")) = Clng(ID) Then
			
			MusicID = Rs("MusicID")
			SinGer    = Rs("Singer")
			MusicName = Rs("MusicName")
			SpecialName = Rs("SpecialName")
			LrcGeci	= Rs("Words")

			Rw "[<b>" & Singer & " - " & MusicName & "</b>]<br>"

			Rw "<BR><BR>"

			If LrcGeci = "暂无LRC歌词" Then
				Rw LrcGeci
			Else
				If InStr(LrcGeci,"[type:emv]")>0 Then
					Response.Write "<Meta http-equiv=Refresh content='0;URL=?Act=GET&ID=" & Clng(Rs("MusicID"))+1 & "&EndID=" & EndID & "'>"
					Response.Flush
					Response.End
				End If
                                '//开始处理
                                Dim LrcType, LrcHead, InstrArr(3), HeadLength
                                
                                LrcType = "[type:emv]"
                                LrcHead = LrcType & vbCrLf
                                ti = RegContent(LrcGeci, "[ti:", "]", 1, "")
                                If Trim(ti) = "" Then
                                    ti = "[ti:" & MusicName & "]"
                                    LrcHead = LrcHead & ti & vbCrLf
                                    InstrArr(0) = 0
                                Else
                                    LrcHead = LrcHead & ti & vbCrLf
                                    InstrArr(0) = InStr(LrcGeci, ti) + Len(ti)
                                End If
                                ar = RegContent(LrcGeci, "[ar:", "]", 1, "")
                                If Trim(ar) = "" Then
                                    ar = "[ar:" & Singer & "]"
                                    LrcHead = LrcHead & ar & vbCrLf
                                    InstrArr(1) = 0
                                Else
                                    LrcHead = LrcHead & ar & vbCrLf
                                    InstrArr(1) = InStr(LrcGeci, ar) + Len(ar)
                                End If
                                al = RegContent(LrcGeci, "[al:", "]", 1, "")
                                If Trim(al) = "" Then
                                    al = "[al:" & SpecialName & "]"
                                    LrcHead = LrcHead & al & vbCrLf
                                    InstrArr(2) = 0
                                Else
                                    LrcHead = LrcHead & al & vbCrLf
                                    InstrArr(2) = InStr(LrcGeci, al) + Len(al)
                                End If
                                By = RegContent(LrcGeci, "[by:", "]", 1, "")
                                If InStr(By,"[by:") <= 0 Then
                                    InstrArr(3) = 0
				    By = "[by:流光音乐网 A306.Com]"
                                    LrcHead = LrcHead & By & vbCrLf
                                Else
                                    InstrArr(3) = InStr(LrcGeci, By) + Len(By)
                                    By = "[by:流光音乐网 A306.Com]"
                                    LrcHead = LrcHead & By & vbCrLf
                                End If
                                url = "[url:{Url}]"
                                LrcHead = LrcHead & url & vbCrLf
                                bg = "[bg:/EmvPlayer/Pics/"&RndNum(1,5)&".jpg]"
                                LrcHead = LrcHead & bg & vbCrLf
                    
                                HeadLength = InstrArr(0)
                                For i = 0 To UBound(InstrArr)
                                    If HeadLength < InstrArr(i) Then
                                        HeadLength = InstrArr(i)
                                    End If
                                Next
                    
                                If HeadLength <= 0 Then
                                    LrcGeci = LrcGeci
                                Else
                                    LrcGeci = Mid(LrcGeci, HeadLength, Len(LrcGeci))
                                End If
                                Dim LrcArr, TempLrc, LrcWord
                                LrcArr = Split(LrcGeci, vbCrLf)
                                For i = 0 To UBound(LrcArr)
                                    If (i Mod 2) = 0 Then
                                        len1 = InStrRev(LrcArr(i), "]")
                                        If len1 > 0 Then
                                            TempLrc = Mid(LrcArr(i),1,len1) & "<bg:/EmvPlayer/Pics/"&RndNum(1,5)&".jpg;>" & Mid(LrcArr(i),len1+1,Len(LrcArr(i))) & vbCrLf
                                        End If
                                    Else
                                        TempLrc = LrcArr(i) & vbCrLf
                                    End If
                                    If LrcWord = "" Then
                                        LrcWord = TempLrc
                                    Else
                                        LrcWord = LrcWord & TempLrc
                                    End If
                                Next
                                LrcGeci = LrcHead & LrcWord

				Rw "修改LRC歌词" & Len(LrcGeci) & "字"
			End If

			'Rw "<br>"
			'Rw LrcGeci
			'Response.End
			Call WriteText(MusicID,SinGer,MusicName,SpecialName,TexGeci)
			Call WriteLrc(MusicID,SinGer,MusicName,SpecialName,LrcGeci)
		Else
			Response.Write "<Meta http-equiv=Refresh content='0;URL=?Act=GET&ID=" & Rs("MusicID") & "&EndID=" & EndID & "'>"
			Response.Flush
			Response.End
		End If

		Rs.MoveNext
	Loop
	Rs.Close
	Set Rs = Nothing
	Conn.Close
	Set Conn = Nothing
End Sub

'取得专辑ID
Function GetSpecialName(SpecialID)
    'On Error Resume Next
    If SpecialID < 1 Then
        GetSpecialName = ""
        Exit Function
    End If
    Sql = "Select * From [Special] Where SpecialID=" & SpecialID
    Set Rs1 = Conn.Execute(Sql)
    If Not Rs1.Eof Then
    	GetSpecialName = Rs1("name")
    Else
	GetSpecialName = ""
    End If	
    Rs1.Close
    Set Rs1 = Nothing
End Function


'写入文本歌词
Sub WriteText(MusicID,SinGer,MusicName,SpecialName,Words)
	Set RsText = Server.CreateObject("ADODB.RecordSet")
    	Sql = "Select * From TextWord Where MusicID=" & MusicID
    	RsText.Open Sql,Conn,1,3
    	If RsText.BOF Or RsText.EOF Then
        	RsText.AddNew
    	End If
	RsText("MusicID")     = MusicID
	RsText("SinGer")      = SinGer
	RsText("MusicName")   = MusicName
	RsText("SpecialName") = SpecialName
	RsText("Words")       = Words
    	If Words = "暂无歌词" Then
        	RsText("Flag") = False
    	Else
        	RsText("Flag") = True
		RsText("ErrNum") = 0
    	End If
	RsText("AddUser")     = "admin"
	RsText("AddTime")     = Now()
    	RsText.Update
    	RsText.Close
    	Set RsText = Nothing
End Sub

'写入LRC歌词
Sub WriteLrc(MusicID,SinGer,MusicName,SpecialName,Words)
	Set RsLrc = Server.CreateObject("ADODB.RecordSet")
    	Sql = "Select * From LrcWord Where MusicID=" & MusicID
    	RsLrc.Open Sql,Conn,1,3
    	If RsLrc.BOF Or RsLrc.EOF Then
        	RsLrc.AddNew
    	End If
	RsLrc("MusicID")     = MusicID
	RsLrc("SinGer")      = SinGer
	RsLrc("MusicName")   = MusicName
	RsLrc("SpecialName") = SpecialName
	RsLrc("Words")       = Words
    	If Words = "暂无LRC歌词" Then
        	RsLrc("Flag") = False
    	Else
        	RsLrc("Flag") = True
		RsLrc("ErrNum") = 0
    	End If
	RsLrc("AddUser")     = "admin"
	RsLrc("AddTime")     = Now()
    	RsLrc.Update
    	RsLrc.Close
    	Set RsLrc = Nothing
End Sub

Function RndNum(ByVal StartNum,ByVal EndNum)
	Randomize
	RndNum = Int((EndNum-StartNum) * Rnd) + StartNum
End Function
%>