www.gusucode.com > 星云DJ舞曲 4.5a源码程序 > admin/admin_fso.asp
<!--#include file="checkadmin.inc"-->
<!--#include file="const.asp"-->
<LINK href="admin_style.css" type=text/css rel=stylesheet>
<%
Select Case Request.QueryString("SenFe")
Case "Main":SenFe_Main
Case "Main":SenFe_Zzgood
Case "DJTop":SenFe_DJTop
Case "SpecialList":SenFe_SpecialList
Case "ShowSpecial":SenFe_ShowSpecial
Case "Play":SenFe_Play
Case "PlayDjList":SenFe_PlayDjList
Case "Listen":SenFe_Listen
Case Else:Response.Write "非法访问!"
End Select
%>
</td>
</tr>
</table>
</center>
</div>
<%
Sub SenFe_Main()
sUrl = Request.ServerVariables("URL")
sUrl = Left(sUrl,InStrRev(sUrl,"/")-1)
sUrl = Left(sUrl,InStrRev(sUrl,"/"))
sUrl = "http://" & Request.ServerVariables("SERVER_NAME") & sUrl & "mb/mb_IndexNew.asp"
Const FileName = "../index.html" '首页文件名
'If Request.Form("content")<>"" Then
If Request("senfe")<>"" Then
Set Fso = Server.CreateObject("Scripting.FileSystemObject")
Set Fout = Fso.CreateTextFile(Server.Mappath(FileName))
Fout.Write GetData(sUrl,1)
'Fout.Write Request.Form("content")
Fout.Close
Set Fout = Nothing
Set Fso = Nothing
%>
<table border="0" cellspacing="0" style="border-collapse: collapse" width="100%" cellpadding="0">
<tr>
<td width="100%"><font color="#FF0000">·</font>操作成功,生成时间在<%=Now()%><br><font color="#FF0000">·</font>点击浏览<a target="_blank" href="<%=filename%>"><%=filename%></a></td>
</tr>
</table>
<%
end if
End Sub
Sub SenFe_Play()
On Error Resume Next
PageSize = 100 '每次生成100条记录
Set Fso = Server.CreateObject("Scripting.FileSystemObject")
sId = Request("sId")
oId = Request("oId")
PageNo = Request("PageNo")
set rs=server.createobject("adodb.recordset")
sql="select * from Musiclist order by id asc"
rs.Open sql,conn,1,1
kaishiid=rs("id")
rs.close
sql="select * from Musiclist order by id desc"
rs.Open sql,conn,1,1
jieshuid=rs("id")
rs.close
If PageNo="" And sId="" And oId="" Then
Response.Write "<form name='form1' action='?SenFe=Play'>请输入要生成的开始ID和结束ID，若不设置则生成全部。<input type='hidden' value='Play' name='SenFe'><input type='hidden' value='1' name='PageNo'><br />开始ID：<input type='text' name='sId' value='"&kaishiid&"'><br />结束ID：<input type='text' name='oId' value='"&jieshuid&"'><br /><input type='submit' name='change' value='开始生成'></form>"
Else
If PageNo="" Then
PageNo = 1
Else
PageNo = CInt(PageNo)
End If
If sId<>"" And oId<>"" Then
sId = CInt(sId)
oId = CInt(oId)
Sql = "Select * From [MusicList] Where [Id]>" & sId-1 & " And [Id]<" & oId+1
Else
Sql = "Select * From [MusicList]"
End If
Set Rs = Server.Createobject("Adodb.Recordset")
Rs.Open Sql,Conn,1,1
If Rs.Eof Then
Response.Write "该ID段没有舞曲记录，请重新输入；你输入的开始ID是：" & sId & "结束ID是：" & oId & vbcrlf
Response.Flush
Else
Dim DjCount,PageNum,PageNo
DjCount = Rs.RecordCount
PageNum = DjCount\PageSize
If DjCount/PageSize > PageNum Then PageNum = PageNum+1
If PageNo<1 Then PageNo = 1
If PageNo>PageNum Then PageNo = PageNum
Response.Write "本次预计生成[" & DjCount & "]条记录，当前正在生成第[" & (PageNo-1)*PageSize+1 & "]条至第[" & PageNo*PageSize & "]条记录……<br /><br />" & vbcrlf
Response.Flush
Dim M
Rs.MoveFirst
Rs.Move (PageNo-1) * PageSize
M = 0
Do While Not(Rs.Eof) And M < PageSize
M = M+1
SenFe_Id = Rs("Id")
If Rs("MusicType")=1 Then
Content = SenFe_MB("../mb/mb_djplay_rm.Html")
ElseIf Rs("MusicType")=2 Then
Content = SenFe_MB("../mb/mb_djplay_mtv.Html")
ElseIf Rs("MusicType")=3 Then
Content = SenFe_MB("../mb/mb_djplay_wmv.Html")
ElseIf Rs("MusicType")=4 Then
Content = SenFe_MB("../mb/mb_djplay_flash.Html")
ElseIf Rs("MusicType")=5 Then
Content = SenFe_MB("../mb/mb_djplay_5rm.Html")
SenFe_Id = Conn.Execute("Select [ListenServerUrl] From [DJServer] where [LServerID]=" & Rs("LS_ID"))(0) & Rs("LF_Path")
Else
Content = SenFe_MB("../mb/mb_djplay_flash.Html")
SenFe_Id = Conn.Execute("Select [ListenServerUrl] From [DJServer] where [LServerID]=" & Rs("LS_ID"))(0) & Rs("LF_Path")
End If
SenFe_Url = Conn.Execute("Select [ListenServerUrl] From [DJServer] where [LServerID]=" & Rs("LS_ID"))(0)
SenFe_Url = SenFe_Url & Rs("ListenUrl")
Content = Replace(Content,"$SenFe_Title$",Rs("MusicName"))
Content = Replace(Content,"$SenFe_Id$",SenFe_Id)
'==========南极（dj235.com）于2007年2月15日晚增加修改开始，替换上一下、下一首==========
Set Rs1 = Conn.Execute("Select Top 1 [Id],[MusicName] From [MusicList] Where [Id]<" & Rs("Id") & " Order By [Id] Desc")
If Rs1.Eof Then
Content = Replace(Content,"$NextId$",SenFe_Id)
Content = Replace(Content,"$Next$","已经是第一首啦")
Else
Content = Replace(Content,"$NextId$",Rs1(0))
Content = Replace(Content,"$Next$",Rs1(1))
End If
Set Rs1 = Nothing
Set Rs1 = Conn.Execute("Select top 1 [Id],[MusicName] From [MusicList] Where [Id]>" & Rs("Id"))
If Rs1.Eof Then
Content = Replace(Content,"$PreId$",SenFe_Id)
Content = Replace(Content,"$Pre$","已经是最后一首啦")
Else
Content = Replace(Content,"$PreId$",Rs1(0))
Content = Replace(Content,"$Pre$",Rs1(1))
End If
Set Rs1 = Nothing
'==========南极（dj235.com）于2007年2月15日晚增加修改结束，替换上一下、下一首==========
Content = Replace(Content,"$SenFe_Url$",SenFe_Url)
Content = Replace(Content,"$SenFe_time$",Rs("dateandtime"))
Content = Replace(Content,"$ListenUrl$",Rs("ListenUrl"))
Content = Replace(Content,"$Hotb$",Rs("ClassId"))
Set Fout = Fso.CreateTextFile(Server.Mappath("../p/" & Rs("Id") & ".Html"))
Fout.Write Content
Fout.Close
Set Fout = Nothing
Response.Write M & "-舞曲《<a href='../p/" & Rs("Id") & ".Html' target='xydj'>" & Rs("MusicName") & "</a>》生成成功！<br />" & vbcrlf
Response.Flush
Rs.MoveNext
Loop
End If
If PageNo=PageNum Then
Response.Write "<br><span style='color:red;'>全部生成成功！</span>"
Response.Flush
Else
Response.Write "<script>setTimeout(""window.location.href='?SenFe=Play&PageNo=" & PageNo+1 & "&sId=" & sId & "&oId=" & oId & "'"",1000);</script>"
Response.Flush
End If
Rs.Close
Set Rs = Nothing
End If
Set Fso = Nothing
End Sub
Sub SenFe_Listen()
On Error Resume Next
PageSize = 100 '每次生成100条记录
Set Fso = Server.CreateObject("Scripting.FileSystemObject")
sId = Request("sId")
oId = Request("oId")
PageNo = Request("PageNo")
If PageNo="" And sId="" And oId="" Then
Response.Write "<form name='form1' action='?SenFe=Listen'>请输入要生成的开始ID和结束ID，若不设置则生成全部。<input type='hidden' value='Listen' name='SenFe'><input type='hidden' value='1' name='PageNo'><br />开始ID：<input type='text' name='sId'><br />结束ID：<input type='text' name='oId'><br /><input type='submit' name='change' value='开始生成'></form>"
Else
If PageNo="" Then
PageNo = 1
Else
PageNo = CInt(PageNo)
End If
If sId<>"" And oId<>"" Then
sId = CInt(sId)
oId = CInt(oId)
Sql = "Select * From [MusicList] Where [Id]>" & sId-1 & " And [Id]<" & oId+1
Else
Sql = "Select * From [MusicList]"
End If
Set Rs = Server.Createobject("Adodb.Recordset")
Rs.Open Sql,Conn,1,1
If Rs.Eof Then
Response.Write "该ID段没有舞曲记录，请重新输入；你输入的开始ID是：" & sId & "结束ID是：" & oId & vbcrlf
Response.Flush
Else
Dim DjCount,PageNum,PageNo
DjCount = Rs.RecordCount
PageNum = DjCount\PageSize
If DjCount/PageSize > PageNum Then PageNum = PageNum+1
If PageNo<1 Then PageNo = 1
If PageNo>PageNum Then PageNo = PageNum
Response.Write "本次预计生成[" & DjCount & "]条记录，当前正在生成第[" & (PageNo-1)*PageSize+1 & "]条至第[" & PageNo*PageSize & "]条记录……<br /><br />" & vbcrlf
Response.Flush
Dim M
Rs.MoveFirst
Rs.Move (PageNo-1) * PageSize
M = 0
Do While Not(Rs.Eof) And M < PageSize
M = M+1
SenFe_Id = Rs("Id")
If Rs("MusicType")=1 Then
Content = SenFe_MB("../mb/Mb_djplay_rm.html")
ElseIf Rs("MusicType")=2 Then
Content = SenFe_MB("../mb/Mb_djplayrm.html")
ElseIf Rs("MusicType")=3 Then
Content = SenFe_MB("../mb/Mb_djplay_wmv.html")
SenFe_Id = Conn.Execute("Select [ListenServerUrl] From [DJServer] where [LServerID]=" & Rs("LS_ID"))(0) & Rs("LF_Path")
Else
Content = SenFe_MB("../mb/Mb_djplay_flash.html")
SenFe_Id = Conn.Execute("Select [ListenServerUrl] From [DJServer] where [LServerID]=" & Rs("LS_ID"))(0) & Rs("LF_Path")
End If
Content = Replace(Content,"$SenFe_Title$",Rs("MusicName"))
Content = Replace(Content,"$SenFe_Id$",SenFe_Id)
Content = Replace(Content,"$SenFe_I$",Rs(0))
Content = Replace(Content,"$LF_Path$",Rs("ListenUrl"))
Content = Replace(Content,"$SenFe_ds$",Rs("hits"))
Content = Replace(Content,"$SenFe_rq$",Rs("DateAndTime"))
Content = Replace(Content,"$SenFe_zj$",Rs("specialid"))
Content = Replace(Content,"$SenFe_Url$",SenFe_Url)
'==========（SenFe）增加修改开始，替换上一下、下一首==========
Set Rs1 = Conn.Execute("Select Top 1 [Id],[MusicName] From [MusicList] Where [Id]<" & Rs("Id") & " Order By [Id] Desc")
If Rs1.Eof Then
Content = Replace(Content,"$NextId$",SenFe_Id)
Content = Replace(Content,"$Next$","已经是第一首啦")
Else
Content = Replace(Content,"$NextId$",Rs1(0))
Content = Replace(Content,"$Next$",Rs1(1))
End If
Set Rs1 = Nothing
Set Rs1 = Conn.Execute("Select top 1 [Id],[MusicName] From [MusicList] Where [Id]>" & Rs("Id"))
If Rs1.Eof Then
Content = Replace(Content,"$PreId$",SenFe_Id)
Content = Replace(Content,"$Pre$","已经是最后一首啦")
Else
Content = Replace(Content,"$PreId$",Rs1(0))
Content = Replace(Content,"$Pre$",Rs1(1))
End If
Set Rs1 = Nothing
'==========（SenFe）增加修改结束，替换上一下、下一首==========
Dim objFSO '声明一个名称为 objFSO 的变量以存放对象实例
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(Server.MapPath("../Listen/"&SenFe_Id&"")) Then
Response.Write Server.MapPath("../Listen/"&SenFe_Id&"")&"文件夹是存在的，不需要新建！"
Else
objFSO.CreateFolder(Server.MapPath("../Listen/"&SenFe_Id&""))
Response.Write "新建文件夹的位置为"&Server.MapPath("../Listen/"&SenFe_Id&"")
End If
Set objFSO = Nothing '释放 FileSystemObject 对象实例内存空间
Set Fout = Fso.CreateTextFile(Server.Mappath("../Listen/"&SenFe_Id&"/index.Html"))
Fout.Write Content
Fout.Close
Set Fout = Nothing
Response.Write M & "-舞曲《<a href='../Listen/" & Rs("Id") & "/index.Html' target='xydj'>" & Rs("MusicName") & "</a>》生成成功！<br />" & vbcrlf
Response.Flush
Rs.MoveNext
Loop
End If
If PageNo=PageNum Then
Response.Write "<br><span style='color:red;'>全部生成成功！</span>"
Response.Flush
Else
Response.Write "<script>setTimeout(""window.location.href='?SenFe=2t&PageNo=" & PageNo+1 & "&sId=" & sId & "&oId=" & oId & "'"",1000);</script>"
Response.Flush
End If
Rs.Close
Set Rs = Nothing
End If
Set Fso = Nothing
End Sub
Sub SenFe_DJTop()
'==========以下代码由七情于2007-6-25日晚修改过==========
PageSize = 100
Set Fso = Server.CreateObject("Scripting.FileSystemObject")
DJTop_Type = Split(",h,d1,d2,w1,w2,m1,m2,good,down",",")
DJTop_Name = Split("最新更新,试听总排行,今日视听排行,昨日视听排行,本周试听排行,上周试听排行,本月试听排行,上月试听排行,推荐舞曲,下载排行",",")
Set Fout = Fso.OpenTextFile(Server.Mappath("../mb/mb_djtop.Html"),1,False)
Content = Fout.ReadAll()
Fout.Close
Set Fout = Nothing
For M=0 To UBound(DJTop_Type)
sTypeName = ""
If DJTop_Type(M)="h" Then
By = "Hits"
sTypeName = "总"
ElseIf DJTop_Type(M)="d1" Then
By = "Hits_Today"
sTypeName = "今日"
ElseIf DJTop_Type(M)="d2" Then
By = "Hits_Yesterday"
sTypeName = "昨日"
ElseIf DJTop_Type(M)="w1" Then
By = "Hits_Weekday"
sTypeName = "本周"
ElseIf DJTop_Type(M)="w2" Then
By = "Hits_Weekday_1"
sTypeName = "上周"
ElseIf DJTop_Type(M)="m1" Then
By = "Hits_Month"
sTypeName = "本月"
ElseIf DJTop_Type(M)="m2" Then
By = "Hits_Month_1"
sTypeName = "上月"
ElseIf DJTop_Type(M)="down" Then
By = "DownHits"
sTypeName = "下载"
Else
By = "Id"
End If
Set Rs = Server.Createobject("Adodb.Recordset")
Sql = "Select Top " & PageSize & " * From [MusicList]"
If DJTop_Type(M)="good" Then Sql = Sql & " Where [IsGood]"
Sql = Sql & " Order By " & By & " Desc"
Rs.Open Sql,Conn,1,1
SenFe_List = ""
If Rs.Eof Then
SenFe_List = SenFe_List & "还未收录任何舞曲！"
Else
N = 0
Do While Not Rs.Eof And N<PageSize
'输出舞曲列表
n = n +1
SenFe_List = SenFe_List & "<td width='30pt'><span class='anlan'><input type=checkbox name=id value=" & Rs(0) & "></span></td><td width='248pt' align=left> <a href='../P/" & Rs(0) & ".html' target='xydj' title='" & musicname & "'"
If RS("IsGood") Then SenFe_List = SenFe_List & " style='color:red;'"
SenFe_List = SenFe_List & ">" & n &"." & Left(Rs("MusicName"),17)
If Len(Rs("MusicName"))>28 Then SenFe_List = SenFe_List & "..."
SenFe_List = SenFe_List & "</a>"
SenFe_List = SenFe_List & "</td><td width='35pt'><a href='../P/" & Rs(0) & ".html' target='xydj'><img src='../images/music.gif' border='0' /></a></td><td width='35pt'>"& (Rs("hits")) &"</td><td width='35pt'><a href='../User/UserCollect.asp?action=add&id=" & Rs(0) & "' target='shoucang'>收藏</a></td><td width='30pt'><a href='../D/?id=" & rs(0) & "' target='xz'><img src='../images/down.jpg' border='0' /></a></td><td width='65pt'>" & DateValue(Rs("DateAndTime")) & "</td>"
if n mod 2 =0 then
SenFe_List = SenFe_List & "</tr>" & VbCrLf
SenFe_List = SenFe_List & "<tr>"
end if
if n mod 100 =0 then
SenFe_List = SenFe_List & "</tr>" & VbCrLf
end if
Rs.MoveNext
Loop
End If
Rs.Close
Set Rs = Nothing
FileName = "../djtop/index.Html"
If DJTop_Type(M)<>"" Then FileName = "../djtop/" & DJTop_Type(M) & ".Html"
Set Fout = Fso.CreateTextFile(Server.Mappath(FileName))
Fout.Write Replace(Replace(Content,"$SenFe_Title$",DJTop_Name(M)),"$SenFe_List$",SenFe_List)
Fout.Close
Set Fout = Nothing
Response.Write "生成[<a href='" & FileName & "' target='djtop' style='color:red;'>" & DJTop_Name(M) & "</a>]成功<br>" & Vbcrlf
Response.Flush
Next
Set Fso = Nothing
Response.Write "<br><span style='color:red;'>全部生成成功！</span>"
End Sub
Sub SenFe_SpecialList()
Dim FileName,HtmlName,Fso,Fout,PageSize
PageSize = 14 '每页显示专集数量
FileName = Server.Mappath("../mb/mb_ListDj.Html")
Set Fso = Server.CreateObject("Scripting.FileSystemObject")
If (Fso.FileExists(FileName)) Then '当文件存在时
End If
Dim sIdList,Content
sIdList = Application("SenFe_Admin_sIdList")
Content = Application("SenFe_Admin_Content")
If IsEmpty(Content) Then
Set Rs = Server.Createobject("Adodb.Recordset")
Rs.Open "Select * From [Class] Order By [ClassId]",Conn,1,1
sIdList = ""
Do While Not Rs.Eof
sIdList = sIdList & "@@" & Rs("ClassId") & "``" & Rs("Class")
Rs.MoveNext
Loop
sIdList = Mid(sIdList,3)
Rs.Close
Set Rs = Nothing
Application.Lock
Application("SenFe_Admin_sIdList") = sIdList
Application.UnLock
End If
If IsEmpty(Content) And (Fso.FileExists(FileName)) Then
Set Fout = Fso.OpenTextFile(FileName,1,False)
Content = Fout.ReadAll()
Fout.Close
Set Fout = Nothing
Application.Lock
Application("SenFe_Admin_Content") = Content
Application.UnLock
End If
Dim PId,CId,CName
PId = Request.QueryString("PId")
If PId="" Then
PId = 0
Else
PId = CInt(PId)
End If
sIdList = Split(sIdList,"@@")
CId = CInt(Split(sIdList(PId),"``")(0)) '分类ID
CName = Split(sIdList(PId),"``")(1) '分类名
Content = Replace(Content,"$SenFe_Title$",CName) '替换分类名
Content = Replace(Content,"$SenFe_sType$","classid=" & CId) '调用分类排行
Response.Write "<span style='color:red;'>正在生成分类[" & CName & "]，请稍候……</span><br><br>" & VbCrlf
Response.Flush
Dim SenFe_List
Set Rs = Server.Createobject("Adodb.Recordset")
Rs.Open "Select * From [Special] Where [ClassId]=" & CId & " Order By SpecialId Desc",Conn,1,1
If Rs.Eof Then
Response.Write "分类[" & CName & "]中没有任何专集！<br>"
Else
Dim SpecialCount,PageNum,PageNo
SpecialCount = Rs.RecordCount
PageNum = SpecialCount\PageSize
If SpecialCount/PageSize > PageNum Then PageNum = PageNum+1
Dim M
PageNo = 0
Do While PageNo<PageNum '循环生成每一页
PageNo = PageNo+1
SenFe_List = "<div class='Zjk'>" & VbCrlf
Rs.MoveFirst
Rs.Move (PageNo-1) * PageSize
M = 0
Do While Not Rs.Eof And M < PageSize
'输出专集列表
If M Mod 2=0 Then SenFe_List = SenFe_List & "" & VbCrlf
M = M +1
SenFe_List = SenFe_List & " <div class='ZjPic'><a href='../Zj/dj_" & Rs("SpecialId") & "_1.Html'>"
If Rs("Pic")="" Then
SenFe_List = SenFe_List & "<img src='../images/nopic.gIf' width=80 height=80 border=0>"
Else
SenFe_List = SenFe_List & "<img src='../" & Rs("Pic") & "' width=80 height=80 border=0>"
End If
SenFe_List = SenFe_List & "</a></div><div class='Zjjs'><ul><li><a href='../Zj/dj_" & Rs("SpecialId") & "_1.Html' title='点击进入'><b>" & Rs("Name") & "</b></a></li><li>专辑点击:" & Rs("Hits") & "次</li><li>添加时间:" & Mid(DateValue(Rs("DateAndTime")),3) & "</li><li>发布公司:七情DJ舞曲网</li></ul></div>" & VbCrlf
If M Mod 2=0 Then SenFe_List = SenFe_List & "" & VbCrlf
Rs.MoveNext
Loop
M = 0
SenFe_List = SenFe_List & "</div>" & VbCrlf
'显示分页
SenFe_List = SenFe_List & "<div id='Zjdx'>共有<b>" & SpecialCount & "</b>个专辑 当前第<b>" & PageNo & "</b>页 共<b>" & PageNum & "</b>页 <b>" & PageSize & "</b>个专辑为一页</td><td align=center> <b>[" & PageNo & "]</b>"
If PageNo>1 Then
SenFe_List = SenFe_List & "<A href='../List/dj_" & CId & "_1.Html'>首页</a> <A href='../List/dj_" & CId & "_" & PageNo-1 & ".Html'>上一页</a> "
Else
SenFe_List = SenFe_List & "首页 上一页 "
End If
If PageNo<PageNum Then
SenFe_List = SenFe_List & "<A href='../List/dj_" & CId & "_" & PageNo+1 & ".Html'>下一页</a> <A href='../List/dj_" & CId & "_" & PageNum & ".Html'>尾页</a> "
Else
SenFe_List = SenFe_List & "下一页 尾页 "
End If
SenFe_List = SenFe_List & "</div>"
'生成页面
'Content = Replace(Content,"$SenFe_List$",SenFe_List)
HtmlName = "../List/dj_" & CId & "_" & PageNo & ".Html"
Set Fout = Fso.CreateTextFile(Server.Mappath(HtmlName))
Fout.Write Replace(Content,"$SenFe_List$",SenFe_List)
Fout.Close
Set Fout = Nothing
Response.Write "分类[" & CName & "]第[" & PageNo & "/" & PageNum & "]页生成成功！<br>"
Response.Flush
Loop
End If
Rs.Close
Set Rs = Nothing
Set Fso = Nothing
If PId<UBound(sIdList) Then
Response.Write "<br /><br />本分类生成完毕，正在生成下一分类，请稍候……！"
Response.Flush
Response.Write "<script>setTimeout(""window.location.href='?SenFe=SpecialList&PId=" & PId+1 & "'"",1000);</script>"
Else
Application.Lock
Application("SenFe_Admin_sIdList") = Empty
Application("SenFe_Admin_Content") = Empty
Application.UnLock
Response.Write "<br /><br /><span style='color: red;'>分类块列表全部生成完毕！</span>"
End If
End Sub
Sub SenFe_ShowSpecial()
Dim FileName,HtmlName,Fso,Fout,PageSize
PageSize = 50 '每页显示舞曲数量
Set Fso = Server.CreateObject("Scripting.FileSystemObject")
'==========以下代码由七情于2007-6-25日晚修改过==========
Dim sIdList,Content,sType,sType1
sType = LCase(Request.QueryString("stype"))
If sType="class" Then
sType1 = "分类"
FileName = Server.Mappath("../mb/Mb_DjList.html")
Else
sType1 = "专辑"
FileName = Server.Mappath("../mb/Mb_ShowDjNew.html")
End If
sIdList = Application("SenFe_Admin_ssIdList")
Content = Application("SenFe_Admin_sContent")
If IsEmpty(Content) Then
Set Rs = Server.Createobject("Adodb.Recordset")
If sType="class" Then
Sql = "Select * From [Class]"
Else
Sql = "Select * From [Special] Order By [SpecialID]"
End If
Rs.Open Sql,Conn,1,1
sIdList = ""
Do While Not Rs.Eof
If sType="class" Then
sIdList = sIdList & "@@" & Rs("classid") & "``" & Rs("class")
Else
sIdList = sIdList & "@@" & Rs("SpecialId") & "``" & Rs("name")
End If
Rs.MoveNext
Loop
sIdList = Mid(sIdList,3)
Rs.Close
Set Rs = Nothing
Application.Lock
Application("SenFe_Admin_ssIdList") = sIdList
Application.UnLock
End If
If IsEmpty(Content) And (Fso.FileExists(FileName)) Then
Set Fout = Fso.OpenTextFile(FileName,1,False)
Content = Fout.ReadAll()
Fout.Close
Set Fout = Nothing
Application.Lock
Application("SenFe_Admin_sContent") = Content
Application.UnLock
End If
Dim P,PId,CId,CName
PId = Request.QueryString("PId")
P = LCase(Request.QueryString("P"))
By = " Order By id Desc"
sPage = ""
If P="h" Then
By = " Order By hits Desc"
sPage = "_H"
ElseIf P="id" Then
By = ""
sPage = "_Id"
End If
If PId="" Then
PId = 0
Else
PId = CInt(PId)
End If
sIdList = Split(sIdList,"@@")
CId = CInt(Split(sIdList(PId),"``")(0)) '分类ID
CName = Split(sIdList(PId),"``")(1) '分类名
Content = Replace(Content,"$SenFe_Title$",CName) '替换分类名
If sType="class" Then
Content = Replace(Content,"$SenFe_sType$","classid=" & CId) '调用分类排行
Else
Content = Replace(Content,"$SenFe_sType$","specialid=" & CId) '调用分类排行
End If
Response.Write "<span style='color:red;'>正在生成" & sType1 & "[" & CName & "]，请稍候……</span><br><br>" & VbCrlf
Response.Flush
SenFe_By = "<a href='dj_" & CId & "_1.Html'>"
If P="" Then
SenFe_By = SenFe_By & "<b>默认排列</b>"
Else
SenFe_By = SenFe_By & "默认排列"
End If
SenFe_By = SenFe_By & "</a> | <a href='dj_H_" & CId & "_1.Html'>"
If P="h" Then
SenFe_By = SenFe_By & "<b>人气排列</b>"
Else
SenFe_By = SenFe_By & "人气排列"
End If
SenFe_By = SenFe_By & "</a> | <a href='dj_Id_" & CId & "_1.Html'>"
If P="id" Then
SenFe_By = SenFe_By & "<b>先后排列</b>"
Else
SenFe_By = SenFe_By & "先后排列"
End If
SenFe_By = SenFe_By & "</a>"
Content = Replace(Content,"$SenFe_By$",SenFe_By)
Dim SenFe_List
Set Rs = Server.Createobject("Adodb.Recordset")
If sType="class" Then
Sql = "Select * From [MusicList] Where [ClassID]=" & CId & By
Else
Sql = "Select * From [MusicList] Where [SpecialId]=" & CId & By
End If
Rs.Open Sql,Conn,1,1
If Rs.Eof Then
Response.Write "" & sType1 & "[" & CName & "]中没有任何舞曲！<br>"
Else
Dim DjCount,PageNum,PageNo
DjCount = Rs.RecordCount
PageNum = DjCount\PageSize
If DjCount/PageSize > PageNum Then PageNum = PageNum+1
Dim M
PageNo = 0
Do While PageNo<PageNum '循环生成每一页
PageNo = PageNo+1
SenFe_List = "<tr>"
Rs.MoveFirst
Rs.Move (PageNo-1) * PageSize
M = 0
Do While Not Rs.Eof And M < PageSize
'输出舞曲列表
M = M +1
SenFe_List = SenFe_List & "<td width='30pt'><span class='anlan'><input type=checkbox name=id value=" & Rs(0) & "></span></td><td width='248pt' align=left> <a href='../P/" & Rs(0) & ".html' target='xydj' title='" & musicname & "'"
If RS("IsGood") Then SenFe_List = SenFe_List & " style='color:red;'"
SenFe_List = SenFe_List & ">" & m &"." & Left(Rs("MusicName"),18)
If Len(Rs("MusicName"))>30 Then SenFe_List = SenFe_List & "..."
SenFe_List = SenFe_List & "</a>"
SenFe_List = SenFe_List & "</td><td width='35pt'><a href='../P/" & Rs(0) & ".html' target='xydj'><img src='../images/music.gif' border='0' /></a></td><td width='35pt'>"& (Rs("hits")) &"</td><td width='35pt'><a href='../User/UserCollect.asp?action=add&id=" & Rs(0) & "' target='shoucang'>收藏</a></td><td width='30pt'><a href='../D/?id=" & rs(0) & "' target='xz'><img src='../images/down.jpg' border='0' /></a></td><td width='65pt'>" & DateValue(Rs("DateAndTime")) & "</td>"
if m mod 2 =0 then
SenFe_List = SenFe_List & "</tr>" & VbCrLf
SenFe_List = SenFe_List & "<tr>"
end if
if m mod 50 =0 then
SenFe_List = SenFe_List & "</tr>" & VbCrLf
end if
Rs.MoveNext
Loop
M = 0
'显示分页
SenFe_Page = "<table width=100% align=center border=0 cellPadding=0 cellSpacing=1><tr><td align=center>共<b>" & DjCount & "</b>首舞曲 共<b>" & PageNum & "</b>页</td><td align=center>"
If PageNo>1 Then
SenFe_Page = SenFe_Page & "<a href='dj" & sPage & "_" & CId & "_1.Html' title='最前页'><font face='Webdings'>7</font></a> <a href='dj" & sPage & "_" & CId & "_" & PageNo-1 & ".Html' title='上一页'><font face='Webdings'>9</font></a> "
Else
SenFe_Page = SenFe_Page & "<font face='Webdings'>7</font> <font face='Webdings'>9</font> "
End If
PageS = PageNo-2
PageO = PageNo+7
If PageNo<=2 Or PageNum<=10 Then PageS=1
If PageNum-PageNo<=7 Or PageNum<=10 Then PageO=PageNum
For I=PageS To PageO
If PageNo=I Then
SenFe_Page = SenFe_Page & "<b>[" & I & "]</b> "
Else
SenFe_Page = SenFe_Page & "<a href='dj" & sPage & "_" & CId & "_" & I & ".Html'>[" & I & "]</a> "
End If
Next
If PageNo<PageNum Then
SenFe_Page = SenFe_Page & "<a href='dj" & sPage & "_" & CId & "_" & PageNo+1 & ".Html' title='下一页'><font face='Webdings'>8</font></a> <a href='dj" & sPage & "_" & CId & "_" & PageNum & ".Html' title='最后页'><font face='Webdings'>:</font></a>"
Else
SenFe_Page = SenFe_Page & "<font face='Webdings'>8</font> <font face='Webdings'>:</a>"
End If
SenFe_Page = SenFe_Page & "</td><td><table border=0 cellpadding=0 cellspacing=0><form onsubmit='window.location=this.KKK2.options[this.KKK2.selectedIndex].value; return false;'><tr><select name=select onchange='javascript:window.location.href=this.options[this.selectedIndex].value'>"
For I=1 To PageNum
If PageNo=I Then
SenFe_Page = SenFe_Page & "<option value='dj" & sPage & "_" & CId & "_" & I & ".html' selected>"&I&"</option>"
Else
SenFe_Page = SenFe_Page & "<option value='dj" & sPage & "_" & CId & "_" & I & ".html'>"&I&"</option>"
End If
Next
SenFe_Page = SenFe_Page & "</td></tr></form></table></td></tr></table><script src=""../djshow.asp?SenFe=Special&Id=" & CId & """></script>"
'生成页面
'Content = Replace(Content,"$SenFe_List$",SenFe_List)
'Content = Replace(Content,"$SenFe_Page$",SenFe_Page)
If sType<>"class" Then Content = Replace(Content,"$SenFe_zjJJ$",Conn.Execute("Select [intro] From [Special] Where [SpecialID]=" & CId)(0))
If sType<>"class" Then Content = Replace(Content,"$SenFe_zuozhe$",Conn.Execute("Select [zuozhe] From [Special] Where [SpecialID]=" & CId)(0))
If sType<>"class" Then Content = Replace(Content,"$SenFe_zhuangtai$",Conn.Execute("Select [zhuangtai] From [Special] Where [SpecialID]=" & CId)(0))
If sType<>"class" Then Content = Replace(Content,"$SenFe_djqq$",Conn.Execute("Select [djqq] From [Special] Where [SpecialID]=" & CId)(0))
If sType<>"class" Then Content = Replace(Content,"$SenFe_classname$",Conn.Execute("Select [classname] From [Special] Where [SpecialID]=" & CId)(0))
If sType<>"class" Then Content = Replace(Content,"$SenFe_pic$",Conn.Execute("Select [pic] From [Special] Where [SpecialID]=" & CId)(0))
If sType<>"class" Then Content = Replace(Content,"$SenFe_time$",Conn.Execute("Select [dateandtime] From [Special] Where [SpecialID]=" & CId)(0))
If sType<>"class" Then Content = Replace(Content,"$SenFe_hits$",Conn.Execute("Select [hits] From [Special] Where [SpecialID]=" & CId)(0))
If sType<>"class" Then Content = Replace(Content,"$SenFe_gongsi$",Conn.Execute("Select [gongsi] From [Special] Where [SpecialID]=" & CId)(0))
If sType="class" Then
HtmlName = "../List/dj" & sPage & "_" & CId & "_" & PageNo & ".Html"
Else
HtmlName = "../Zj/dj" & sPage & "_" & CId & "_" & PageNo & ".Html"
End If
Set Fout = Fso.CreateTextFile(Server.Mappath(HtmlName))
Fout.Write Replace(Replace(Content,"$SenFe_List$",SenFe_List),"$SenFe_Page$",SenFe_Page)
Fout.Close
Set Fout = Nothing
Response.Write sType1 & "[" & CName & "]第[" & PageNo & "/" & PageNum & "]页生成成功！<br>"
Response.Flush
Loop
End If
Rs.Close
Set Rs = Nothing
Set Fso = Nothing
If PId<UBound(sIdList) Then
Response.Write "<br /><br />本" & sType1 & "生成完毕，正在生成下一张专集，请稍候……！"
Response.Flush
Response.Write "<script>setTimeout(""window.location.href='?SenFe=ShowSpecial&PId=" & PId+1 & "&P=" & P & "&stype=" & sType & "'"",1000);</script>"
Else
Application.Lock
Application("SenFe_Admin_ssIdList") = Empty
Application("SenFe_Admin_sContent") = Empty
Application.UnLock
Response.Write "<br /><br /><span style='color: red;'>所有舞曲全部生成完毕！</span>"
End If
End Sub
Sub SenFe_PlayDjList()
Dim sTemplate,sNewDjList,sGoodDjList,I
Dim oFso,oFout
sTemplate = SenFe_MB("../mb/Mb_Playhot.html")
'最新31首舞曲
Set Rs = Server.Createobject("Adodb.Recordset")
Rs.Open "Select * From [MusicList] Order By [Id] Desc",Conn,1,1
I = 0
sNewDjList = ""
Do While Not Rs.Eof And I < 19
I = I + 1
sNewDjList = sNewDjList & "<li class='left'><span class='juhuang'>" & Rs(0) & "</span> <a href='../P/" & Rs(0) & ".html' target='xydj' title='" & musicname & "'"
If RS("IsGood") Then sNewDjList = sNewDjList & " style='color:red;'"
sNewDjList = sNewDjList & ">" & Left(Rs("MusicName"),12)
If Len(Rs("MusicName"))>12 Then sNewDjList = sNewDjList & "..."
sNewDjList = sNewDjList & "</a></li>" & VbCrLf
Rs.MoveNext
Loop
Rs.Close
Set Rs = Nothing
sTemplate = Replace(sTemplate,"{$SenFe_最新更新舞曲}",sNewDjList)
Set Rs = Server.Createobject("Adodb.Recordset")
Rs.Open "Select * From [Class]",Conn,1,1
Do While Not Rs.Eof
'本类最新推荐舞曲
Set Rs1 = Server.Createobject("Adodb.Recordset")
Rs1.Open "Select * From [MusicList] Where [ClassID]=" & Rs("ClassId") & " Order By hits Desc",Conn,1,1
sGoodDjList = ""
I = 0
Do While Not Rs1.Eof And I < 19
I = I + 1
sGoodDjList = sGoodDjList & "<li class='left'><span class='juhuang'>" & Rs1(0) & "</span> <a href='../P/" & Rs1(0) & ".html' target='xydj' title='" & musicname & "'"
If RS1("IsGood") Then sGoodDjList = sGoodDjList & " style='color:red;'"
sGoodDjList = sGoodDjList & ">" & Left(Rs1("MusicName"),12)
If Len(Rs1("MusicName"))>12 Then sGoodDjList = sGoodDjList & "..."
sGoodDjList = sGoodDjList & "</a></li>" & VbCrLf
Rs1.MoveNext
Loop
Rs1.Close
Set Rs1 = Nothing
Set oFso = Server.CreateObject("Scripting.FileSystemObject")
Set oFout = oFso.CreateTextFile(Server.Mappath("../good/hot_" & Rs("ClassId") & ".html"))
oFout.Write Replace(sTemplate,"{$SenFe_分类最新推荐舞曲}",sGoodDjList)
oFout.Close
Set oFout = Nothing
Set oFso = Nothing
Response.Write "<a href='../good/hot_" & Rs("ClassId") & ".html' target='_blank'><span style='color: red;'>" & Rs("class") & "生成成功！</span></a><br>" & VbCrLf
Response.Flush
Rs.MoveNext
Loop
Rs.Close
Set Rs = Nothing
Response.Write "<br /><br /><span style='color: red;'>全部生成完毕！</span>"
End Sub
Function GetData(GetUrl,GetMode)
Dim Http
'Set Http = Server.CreateObject("msxml2.XMLHTTP")
Set Http = Server.CreateObject("Msxml2.ServerXMLHTTP")
With Http
.Open "GET",GetUrl,False
.SetRequestHeader "Referer",GetUrl
.Send
If GetMode = 0 Then
GetData = .ResponseBody
Else
GetData = BytesToBstr(.ResponseBody,"GB2312")
End If
End With
Set Http = Nothing
End Function
Function BytesToBstr(Body,Cset)
Dim ADOS
Set ADOS = Server.CreateObject("Adodb.Stream")
With ADOS
.Type = 1
.Mode = 3
.Open
.Write Body
.Position = 0
.Type = 2
.Charset = Cset
BytesToBstr = .ReadText
.Close
End With
Set ADOS = Nothing
End Function
Function SenFe_MB(FileName)
Set Fso = Server.CreateObject("Scripting.FileSystemObject")
Set Fout = Fso.OpenTextFile(Server.Mappath(FileName),1,False)
SenFe_MB = Fout.ReadAll()
Fout.Close
Set Fout = Nothing
Set Fso = Nothing
End Function
%>