⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 admin_flash.asp

📁 这是一套基于WEB的网站管理系统
💻 ASP
📖 第 1 页 / 共 5 页
字号:
🔍
12345 
	ReadComeFrom = ""
	If IsNull(strContent) Then Exit Function
	If Trim(strContent) = "" Then Exit Function
	strContent = " " & strContent & " "
	Dim re
	Set re = New RegExp
        re.IgnoreCase = True
        re.Global = True
	re.Pattern = "^((http|https|ftp|rtsp|mms):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@[\]:+!]+([^<>""|'])+)"
	strContent = re.Replace(strContent,"<a target=""_blank"" href=$1>$1</a>")
	re.Pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@[\]:+!]+([^<>""])+)$([^\[|']*)"
	strContent = re.Replace(strContent,"<a target=""_blank"" href=$1>$1</a>")
	re.Pattern = "([^>=""])((http|https|ftp|rtsp|mms):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@[\]:+!]+([^<>""|'])+)"
	strContent = re.Replace(strContent,"$1<a target=""_blank"" href=$2>$2</a>")
	re.Pattern = "([\s])((www|cn)[.](\w)+[.]{1,}(net|com|cn|org|cc)(((\/[\~]*|\\[\~]*)(\w)+)|[.](\w)+)*(((([?](\w)+){1}[=]*))*((\w)+){1}([\&](\w)+[\=](\w)+)*)*)"
	strContent = re.Replace(strContent,"<a target=""_blank"" href=""http://$2"">$2</a>")
	Set re = Nothing
	ReadComeFrom = Trim(strContent)
End Function

Private Sub PreviewMode(url,modeid)
	If Len(url) < 3 Then Exit Sub
	Select Case CInt(modeid)
	Case 1
		Response.Write "<object codebase=""http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=4,0,0,0"" height=""400"" width=""550"" classid=""clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"">"& vbCrLf
		Response.Write "	<param name=""movie"" value=""" & url & """>"& vbCrLf
		Response.Write "	<param name=""quality"" value=""high"">"& vbCrLf
		Response.Write "	<param name=""SCALE"" value=""exactfit"">"& vbCrLf
		Response.Write "	<embed src=""" & url & """ quality=""high"" pluginspage=""http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash"" type=""application/x-shockwave-flash"" width=""550"" height=""400"">"& vbCrLf
		Response.Write "	</embed>"& vbCrLf
		Response.Write "</object>"& vbCrLf
	Case 2
		Response.Write "<img src=""" & url & """ border=""0"" onload=""return imgzoom(this,550)"">"
	Case 3
		Response.Write "<object classid=""CLSID:22D6F312-B0F6-11D0-94AB-0080C74C7E95"" class=""OBJECT"" id=""MediaPlayer"" width=""220"" height=""220"">"& vbCrLf
		Response.Write "	<param name= value=""-1"">"& vbCrLf
		Response.Write "	<param name=""CaptioningID"" value>"& vbCrLf
		Response.Write "	<param name=""ClickToPlay"" value=""-1"">"& vbCrLf
		Response.Write "	<param name=""Filename"" value=""" & url & """>"& vbCrLf
		Response.Write "	<embed src=""" & url & """  width= 220 height=""220"" type=""application/x-oleobject"" codebase=""http://activex.microFlash.com/activex/controls/mplayer/en/nsmp2inf.cab#Version=0,1,1,1"" flename=""mp""></embed>"& vbCrLf
		Response.Write "</object>"& vbCrLf
	Case 4
		Response.Write "<object classid=""clsid:CFCDAA03-8BE4-11cf-B84B-0020AFBBCCFA"" height=""288"" id=""video1"" width=""305"" VIEWASTEXT>"& vbCrLf
		Response.Write "	<param name=""_ExtentX"" value=""5503"">"& vbCrLf
		Response.Write "	<param name=""_ExtentY"" value=""1588"">"& vbCrLf
		Response.Write "	<param name=""AUTOSTART"" value=""-1"">"& vbCrLf
		Response.Write "	<param name=""SHUFFLE"" value=""0"">"& vbCrLf
		Response.Write "	<param name=""PREFETCH"" value=""0"">"& vbCrLf
		Response.Write "	<param name=""NOLABELS"" value=""0"">"& vbCrLf
		Response.Write "	<param name=""SRC"" value=""" & url & """>"& vbCrLf
		Response.Write "	<param name=""CONTROLS"" value=""Imagewindow,StatusBar,ControlPanel"">"& vbCrLf
		Response.Write "	<param name=""CONSOLE"" value=""RAPLAYER"">"& vbCrLf
		Response.Write "	<param name=""LOOP"" value=""0"">"& vbCrLf
		Response.Write "	<param name=""NUMLOOP"" value=""0"">"& vbCrLf
		Response.Write "	<param name=""CENTER"" value=""0"">"& vbCrLf
		Response.Write "	<param name=""MAINTAINASPECT"" value=""0"">"& vbCrLf
		Response.Write "	<param name=""BACKGROUNDCOLOR"" value=""#000000"">"& vbCrLf
		Response.Write "</object>"& vbCrLf
	Case 5
		Response.Write "<object classid=""clsid:166B1BCA-3F9C-11CF-8075-444553540000"" codebase=""http://download.macromedia.com/pub/shockwave/cabs/director/sw.cab#version=8,5,1,0"" width=""100%"" height=""100%"">"& vbCrLf
		Response.Write "	<param name=""src"" value=""" & url & """>"& vbCrLf
		Response.Write "	<param name=""swRemote"" value=""swSaveEnabled='false' swVolume='false' swRestart='false' swPausePlay='false' swFastForward='false' swContextMenu='false' "">"& vbCrLf
		Response.Write "	<param name=""swStretchStyle"" value=""fill"">"& vbCrLf
		Response.Write "	<PARAM name=""bgColor"" value=""#000000"">"& vbCrLf
		Response.Write "	<PARAM name=logo value=""false"">"& vbCrLf
		Response.Write "	<embed src=""" & url & """ bgColor=""#000000"" logo=""FALSE"" width=""550"" height=""400"" swRemote=""swSaveEnabled='false' swVolume='false' swRestart='false' swPausePlay='false' swFastForward='false' swContextMenu='false' "" swStretchStyle=""fill"" type=""application/x-director"" pluginspage=""http://www.macromedia.com/shockwave/download/""></embed>"& vbCrLf
		Response.Write "</object>"& vbCrLf
	

	End Select
End Sub

Private Function FrontFlash(flashid)
	Dim Rss, SQL
	SQL = "select Top 1 flashid,classid,title from NC_FlashList where ChannelID=" & ChannelID & " And isAccept <> 0 And flashid < " & flashid & " order by flashid desc"
	Set Rss = Newasp.Execute(SQL)
	If Rss.EOF And Rss.bof Then
		FrontFlash = "已经没有了"
	Else
		FrontFlash = "<a href=admin_flash.asp?action=view&ChannelID=" & ChannelID & "&flashid=" & Rss("flashid") & ">" & Rss("title") & "</a>"
	End If
	Rss.Close
	Set Rss = Nothing
End Function
Private Function NextFlash(flashid)
	Dim Rss, SQL
	SQL = "select Top 1 flashid,classid,title from NC_FlashList where ChannelID=" & ChannelID & " And isAccept <> 0 And flashid > " & flashid & " order by flashid asc"
	Set Rss = Newasp.Execute(SQL)
	If Rss.EOF And Rss.bof Then
		NextFlash = "已经没有了"
	Else
		NextFlash = "<a href=admin_flash.asp?action=view&ChannelID=" & ChannelID & "&flashid=" & Rss("flashid") & ">" & Rss("title") & "</a>"
	End If
	Rss.Close
	Set Rss = Nothing
End Function
Private Sub BatCreateHtml()
	Dim Allflashid,url
	Response.Write "<IE:Download ID=CreationID STYLE=""behavior:url(#default#download)"" />" & vbCrLf
	Response.Write "<ol>"
	Allflashid = Split(selflashid, ",")
	For i = 0 To UBound(Allflashid)
		flashid = CLng(Allflashid(i))
		url = "admin_makeflash.asp?ChannelID=" & ChannelID & "&flashid=" & flashid & "&showid=1"	
		Call ScriptCreation(url,flashid)
	Next
	Response.Write "</ol>"
	OutHintScript("开始生成HTML,共有" & i & "个HTML页面需要生成！")
End Sub
Private Function ClassUpdateCount(sortid,stype)
	Dim rscount,Parentstr
	On Error Resume Next
	Set rscount = Newasp.Execute("SELECT ClassID,Parentstr FROM [NC_Classify] WHERE ChannelID = " & ChannelID & " And ClassID=" & CLng(sortid))
	If Not (rscount.BOF And rscount.EOF) Then
		Parentstr = rscount("Parentstr") &","& rscount("ClassID")
		If CInt(stype) = 1 Then
			Newasp.Execute ("UPDATE [NC_Classify] SET ShowCount=ShowCount+1,isUpdate=1 WHERE ChannelID = "& ChannelID &" And ClassID in (" & Parentstr & ")")
		Else
			Newasp.Execute ("UPDATE [NC_Classify] SET ShowCount=ShowCount-1,isUpdate=1 WHERE ChannelID = "& ChannelID &" And ClassID in (" & Parentstr & ")")
		End If
	End If
	Set rscount = Nothing
End Function
Private Sub FlashDel()
	If Request("flashid") = "" Then
		ErrMsg = "<li>请选择正确的系统参数！</li>"
		Founderr = True
		Exit Sub
	End If
	On Error Resume Next
	Set Rs = Newasp.Execute("SELECT flashid,classid,username,HtmlFileDate FROM NC_FlashList WHERE ChannelID = "& ChannelID &" And flashid=" & Request("flashid"))
	If Not(Rs.BOF And Rs.EOF) Then
		ClassUpdateCount Rs("classid"),0
		AddUserPointNum Rs("username"),0
		DeleteHtmlFile Rs("classid"),Rs("flashid"),Rs("HtmlFileDate")
	End If
	Rs.Close:Set Rs = Nothing
	Conn.Execute("DELETE FROM NC_FlashList WHERE ChannelID = "& ChannelID &" And flashid=" & Request("flashid"))
	Conn.Execute ("DELETE FROM NC_Comment WHERE ChannelID = "& ChannelID &" And PostID=" & Request("flashid"))
	Call RemoveCache
	Response.redirect ("admin_flash.asp?ChannelID=" & ChannelID)
End Sub

Private Sub batdel()
	Set Rs = Newasp.Execute("SELECT flashid,classid,username,HtmlFileDate FROM NC_FlashList WHERE ChannelID = "& ChannelID &" And flashid in (" & selflashid & ")")
	Do While Not Rs.EOF
		ClassUpdateCount Rs("classid"),0
		AddUserPointNum Rs("username"),0
		DeleteHtmlFile Rs("classid"),Rs("flashid"),Rs("HtmlFileDate")
		Rs.movenext
	Loop
	Rs.Close:Set Rs = Nothing
	Conn.Execute ("DELETE FROM NC_FlashList WHERE ChannelID = "& ChannelID &" And flashid in (" & selflashid & ")")
	Conn.Execute ("DELETE FROM NC_Comment WHERE ChannelID = "& ChannelID &" And PostID in (" & selflashid & ")")
	Call RemoveCache
	Response.redirect (Request.ServerVariables("HTTP_REFERER"))
End Sub

Private Sub batmove()
	If Not IsNumeric(Request.Form("ClassID")) Then
		OutHintScript ("该一级分类已经有下属分类，请移动到其下属分类！")
		Exit Sub
	End If
	If Trim(Request.Form("classid")) <> "" Then
		Newasp.Execute ("update NC_FlashList set ClassID = " & Request.Form("ClassID") & ",isUpdate=1 where flashid in (" & selflashid & ")")
		OutHintScript ("批量移动操作成功")
	Else
		OutHintScript ("不能移动到外部分类！")
	End If
End Sub

Private Sub upindate()
	Newasp.Execute ("update [NC_FlashList] set addTime = " & NowString & " where flashid in (" & selflashid & ")")
	Call RemoveCache
	Response.redirect (Request.ServerVariables("HTTP_REFERER"))
End Sub


Private Sub isCommend()
	Newasp.Execute ("update NC_FlashList set isBest=1 where flashid in (" & selflashid & ")")
	Response.redirect (Request.ServerVariables("HTTP_REFERER"))
End Sub

Private Sub noCommend()
	Newasp.Execute ("update NC_FlashList set isBest=0 where flashid in (" & selflashid & ")")
	Response.redirect (Request.ServerVariables("HTTP_REFERER"))
End Sub

Private Sub isTop()
	Newasp.Execute ("update NC_FlashList set isTop=1 where flashid in (" & selflashid & ")")
	Response.redirect (Request.ServerVariables("HTTP_REFERER"))
End Sub

Private Sub noTop()
	Newasp.Execute ("update NC_FlashList set isTop=0 where flashid in (" & selflashid & ")")
	Response.redirect (Request.ServerVariables("HTTP_REFERER"))
End Sub

'----批量审核
Private Sub BatAccept()
	Set Rs = Newasp.Execute("SELECT username FROM NC_FlashList WHERE isAccept=0 And flashid in (" & selflashid & ")")
	Do While Not Rs.EOF
		AddUserPointNum Rs("username"),1
		Rs.movenext
	Loop
	Rs.Close:Set Rs = Nothing
	Newasp.Execute ("update NC_FlashList set isAccept=1 where flashid in (" & selflashid & ")")
	Response.redirect (Request.ServerVariables("HTTP_REFERER"))
End Sub
Private Sub NotAccept()
	Set Rs = Newasp.Execute("SELECT username FROM NC_FlashList WHERE isAccept>0 And flashid in (" & selflashid & ")")
	Do While Not Rs.EOF
		AddUserPointNum Rs("username"),0
		Rs.movenext
	Loop
	Rs.Close:Set Rs = Nothing
	Newasp.Execute ("update NC_FlashList set isAccept=0 where flashid in (" & selflashid & ")")
	Response.redirect (Request.ServerVariables("HTTP_REFERER"))
End Sub
Private Function AddUserPointNum(username,stype)
	On Error Resume Next
	Dim rsuser,GroupSetting,userpoint
	Set rsuser = Newasp.Execute("SELECT userid,UserGrade,userpoint FROM NC_User WHERE username='"& username &"'")
	If Not(rsuser.BOF And rsuser.EOF) Then
		GroupSetting = Split(Newasp.UserGroupSetting(rsuser("UserGrade")), "|||")(13)
		If CInt(stype) = 1 Then
			userpoint = CLng(rsuser("userpoint") + GroupSetting)
			Newasp.Execute ("UPDATE NC_User SET userpoint="& userpoint &",experience=experience+2,charm=charm+1 WHERE userid="& rsuser("userid"))
		Else
			userpoint = CLng(rsuser("userpoint") - GroupSetting)
			Newasp.Execute ("UPDATE NC_User SET userpoint="& userpoint &",experience=experience-2,charm=charm-1 WHERE userid="& rsuser("userid"))
		End If
	End If
	Set rsuser = Nothing
End Function

'--批量操作开始
Private Sub BatchSetting()
	If Not ChkAdmin("AdminFlash" & ChannelID) Then
		Server.Transfer("showerr.asp")
		Response.End
	End If
	Dim Channel_Setting
	Channel_Setting = Split(Newasp.Channel_Setting, "|||")
	Response.Write "<script src=""include/FlashJuge.Js"" type=""text/javascript""></script>" & vbNewLine
	Response.Write "<table cellspacing=1 align=center cellpadding=3 border=0 class=tableborder>"
	Response.Write "	<tr>"
	Response.Write "		<th colspan=4>" & sModuleName & "批量设置</th>"
	Response.Write "	</tr>"
	Response.Write "	<form name=myform method=post action=?action=saveset>"
	Response.Write "	<input type=hidden name=ChannelID value='"& ChannelID &"'>"
	Response.Write "	<tr>"
	Response.Write "		<td width=""20%"" rowspan=""18"" class=tablerow2 valign=""top"" id=choose2 style=""display:none""><b>请选择" & sModuleName & "分类</b><br>"
	Response.Write "<select name=""ClassID"" size='2' multiple style='height:420px;width:180px;'>"
	Dim strSelectClass,re
	strSelectClass = Newasp.LoadSelectClass(ChannelID)
	Set re = New RegExp
        re.IgnoreCase = True
        re.Global = True
	Re.Pattern="(value=)(.*)("" )"
	strSelectClass = Re.Replace(strSelectClass,"")
	Re.Pattern="({ClassID=)(.*)(}>)"
	strSelectClass = Re.Replace(strSelectClass,"value=""$2"">")
	Response.Write strSelectClass
	Set Re = Nothing
	Response.Write "<option value=""-1"">指定所有分类</option>"
	Response.Write "</select>"
	Response.Write "</td>"
	Response.Write "		<td class=tablerow1 colspan=2 align=right><b>设置选择：</b></td>"
	Response.Write "		<td class=tablerow1>"
	Response.Write "		<input type=radio name=choose value='0' checked onClick=""choose1.style.display='';choose2.style.display='none';""> 按" & sModuleName & "ID&nbsp;&nbsp;"
	Response.Write "		<input type=radio name=choose value='1' onClick=""choose2.style.display='';choose1.style.display='none';""> 按" & sModuleName & "分类</td>"
	Response.Write "	</tr>"
	Response.Write "	<tr id=choose1>"
	Response.Write "		<td class=tablerow1 colspan=2 align=right><b>" & sModuleName & "ID：</b>多个ID请用“,”分开</td>"
	Response.Write "		<td class=tablerow1><input type=""text"" name=""flashid"" size=70 value='"& Request("selflashid") &"'></td>"
	Response.Write "	</tr>"
	Response.Write "	<tr>"
	Response.Write "		<td class=tablerow1 width=""15%"" align=right><b>相关" & sModuleName & "：</b></td>"
	Response.Write "		<td class=tablerow1 width=""5%"" align=center><input type=checkbox name=selRelated value='1'></td>"
12345

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -