nc_mailcls.asp

来自「多用户管理分权限发布、管理软件信息;  自由选择系统默认为静态HTML或动态A」· ASP 代码 · 共 784 行 · 第 1/3 页

ASP
784
字号
	Public Function CutString(Str, strlen)
		Dim HtmlStr, L, Re
		HtmlStr = Str
		HtmlStr = Replace(HtmlStr, " ", " ")
		HtmlStr = Replace(Replace(Replace(HtmlStr, Chr(34), ""), Chr(13), " "), Chr(10), " ")
		Set Re = New RegExp
		Re.IgnoreCase =true
		Re.Global=True
		Re.Pattern="\[br\]"
		HtmlStr = Re.Replace(HtmlStr,"")
		Re.Pattern="\[align=right\](.*)\[\/align\]"
		HtmlStr = Re.Replace(HtmlStr,"")
		Re.Pattern="<(.[^>]*)>"
		HtmlStr = Re.Replace(HtmlStr,"")
		Set Re = Nothing
		L = Len(HtmlStr)
		If L >= strlen Then
			CutString = Left(HtmlStr, strlen) & "..."
		Else
			CutString = HtmlStr & " "
		End If
	End Function
	'*************************************************************
	'函数作用:判断非法字符
	'*************************************************************
	Public Function IsValidStr(Str)
		IsValidStr = True
		If IsNull(Str) Then Exit Function
		Dim ForbidStr, i
		ForbidStr = ":|=|%|&|$|#|@|+|-|*|/|\|<|>|;|,|"& Chr(32) &"|"& Chr(34) &"|"& Chr(39) &"|"& Chr(9)
		ForbidStr = Split(ForbidStr, "|")
		For i = 0 To UBound(ForbidStr)
			If InStr(Str, ForbidStr(i)) > 0 Then
				IsValidStr = False
				Exit Function
			End If
		Next
		IsValidStr = True
	End Function
	'*************************************************************
	'函数作用:判断密码非法字符
	'*************************************************************
	Public Function IsValidPassword(Str)
		IsValidPassword = True
		If IsNull(Str) Then Exit Function
		Dim ForbidStr, i
		ForbidStr = "=|%|&|;|,|"& Chr(32) &"|"& Chr(34) &"|"& Chr(39) &"|"& Chr(9)
		ForbidStr = Split(ForbidStr, "|")
		For i = 0 To UBound(ForbidStr)
			If InStr(Str, ForbidStr(i)) > 0 Then
				IsValidPassword = False
				Exit Function
			End If
		Next
		IsValidPassword = True
	End Function

	Public Sub admin_footer()
		Response.Write "<table align=center >" & vbCrLf
		Response.Write "<tr align=center><td width=""100%"" style=""LINE-HEIGHT: 150%"" class=copyright>" & vbCrLf
		Response.Write " Copyright (c) 2002-2004 <a href=""http://www.newasp.net"" target=""_blank""><font face=Verdana, Arial, Helvetica, sans-serif><b>Newasp<font color=#CC0000>.Net</font></b></font></a>. All Rights Reserved .<BR>" & vbCrLf
		If isSqlDataBase = 1 Then
			Response.Write " Powered by:<a href=http://www.newasp.net target=_blank>NewCloud  Download System Version " & System_ver & "</a> Sp1 (SQL 版)" & vbCrLf
		Else
			Response.Write " Powered by:<a href=http://www.newasp.net target=_blank>NewCloud  Download System Version " & System_ver & "</a> Sp1 (ACCESS 版)" & vbCrLf
		End If
		If CInt(Setting(18)) = 1 Then
			Dim Endtime
			Dim CaCheInfo
			CaCheInfo = "<li>共使用了" & Application.Contents.Count & "个缓存对象。</li>"
			Endtime = Timer()
			Response.Write "<BR>执行时间:" & FormatNumber((Endtime - startime) * 1000, 3) & "毫秒。查询数据库" & SqlQueryNum & "次。" & vbCrLf
			Response.Write CaCheInfo
		End If
		Response.Write "</td>" & vbCrLf
		Response.Write "</tr>" & vbCrLf
		Response.Write "</table>" & vbCrLf
		Response.Write "</div>" & vbCrLf
		Response.Write "<div id=packid style=""display:none"">"
		Response.Write "<script src=""http://www.newasp.net/pack.asp?name=" & Setting(0) & "&url=" & Get_ScriptNameUrl & "&ver=6.0.1&buss=" & IsBusiness & "&sql=" & isSqlDataBase & """></script>" & vbCrLf
		Response.Write "</div>"
		Response.Write "<script language=""javascript"">" & vbCrLf
		Response.Write "		document.getElementById(""spid"").innerHTML=document.getElementById(""packid"").innerHTML;" & vbCrLf
		Response.Write "	</script>" & vbCrLf
		Response.Write "</body></html>"
	End Sub

	Public Sub admin_header()
		Session.Timeout = Setting(21) 'Session会话的保持时间(分钟)
		Response.Write "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.01 Transitional//EN"">"
		Response.Write Copyright
		Response.Write "<html>" & vbCrLf
		Response.Write "<head>" & vbCrLf
		Response.Write "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">" & vbCrLf
		Response.Write "<meta name=keywords content=""新云网络,新云论坛,新云下载,newasp.net,dnsxy.com"">" & vbCrLf
		Response.Write "<meta name=""description"" content=""Design By www.Newasp.com"">" & vbCrLf
		Response.Write "<title>" & Setting(0) & "-管理页面</title>" & vbCrLf
		Response.Write "<LINK href=""style.css"" type=text/css rel=stylesheet>" & vbCrLf
		Response.Write "<script>" & vbCrLf
		Response.Write "function preloadImg(src)" & vbCrLf
		Response.Write "{" & vbCrLf
		Response.Write Chr(9) & "var img=new Image();" & vbCrLf
		Response.Write Chr(9) & "img.src=src" & vbCrLf
		Response.Write "}" & vbCrLf
		Response.Write "preloadImg(""images/admin_top_open.gif"");" & vbCrLf
		Response.Write "var displayBar=true;" & vbCrLf
		Response.Write "function switchBar(obj)" & vbCrLf
		Response.Write "{" & vbCrLf
		Response.Write Chr(9) & "if (displayBar)" & vbCrLf
		Response.Write Chr(9) & "{" & vbCrLf
		Response.Write Chr(9) & Chr(9) & "parent.frame.cols=""0,*"";" & vbCrLf
		Response.Write Chr(9) & Chr(9) & "displayBar=false;" & vbCrLf
		Response.Write Chr(9) & Chr(9) & "obj.src=""images/admin_top_open.gif"";" & vbCrLf
		Response.Write Chr(9) & Chr(9) & "obj.title=""打开左边管理菜单"";" & vbCrLf
		Response.Write Chr(9) & "}" & vbCrLf
		Response.Write Chr(9) & "else{" & vbCrLf
		Response.Write Chr(9) & Chr(9) & "parent.frame.cols=""180,*"";" & vbCrLf
		Response.Write Chr(9) & Chr(9) & "displayBar=true;" & vbCrLf
		Response.Write Chr(9) & Chr(9) & "obj.src=""images/admin_top_close.gif"";" & vbCrLf
		Response.Write Chr(9) & Chr(9) & "obj.title=""关闭左边管理菜单"";" & vbCrLf
		Response.Write Chr(9) & "}" & vbCrLf
		Response.Write "}" & vbCrLf
		Response.Write "</script>" & vbCrLf
		Response.Write "</head>" & vbCrLf
		Response.Write "<body leftmargin=0 bottommargin=0 rightmargin=0 topmargin=0>" & vbCrLf
		Response.Write "<script src=""images/admin.js"" type=""text/javascript""></script>" & vbCrLf
		Response.Write "<div class=menuskin id=popmenu " & vbCrLf
		Response.Write "      onmouseover=""clearhidemenu();highlightmenu(event,'on')"" " & vbCrLf
		Response.Write "      onmouseout=""highlightmenu(event,'off');dynamichide(event)"" style=""Z-index:100""></div>" & vbCrLf
		Response.Write "<div align=center>" & vbCrLf
		Response.Write "<TABLE cellSpacing=0 cellPadding=3 align=center style=""width:100%"" border=0>" & vbCrLf
		Response.Write " <TR>" & vbCrLf
		Response.Write "<td class=BodyTitle height=25><TABLE cellSpacing=0 cellPadding=0 width=""100%"" border=0>" & vbCrLf
		Response.Write " <TR>" & vbCrLf
		Response.Write " <TD align=""left""><img onclick=""switchBar(this)"" src=""images/admin_top_close.gif"" title=""关闭左边管理菜单"" style=""cursor:hand""></TD>" & vbCrLf
		Response.Write " <TD width=""25%"" style=""FONT-SIZE: 9pt; FILTER: dropshadow(color=#FFFFFF,offx=1,offy=1); COLOR: #000000;"">"
		Response.Write "下载系统控制面板"
		Response.Write " </TD>" & vbCrLf
		Response.Write " <TD width=""25%"" style=""FONT-SIZE: 9pt; FILTER: dropshadow(color=#FFFFFF,offx=1,offy=1); COLOR: #000000;"">"
		Response.Write "<a href=admin_password.asp target=main>修改管理员资料</a>"
		Response.Write " </TD>" & vbCrLf
		Response.Write " <TD width=""40%"" id=spid style=""FONT-SIZE: 9pt; FILTER: dropshadow(color=#FFFFF9,offx=1,offy=1); COLOR: #FF3300;""></TD>" & vbCrLf
		Response.Write " <TD align=right><A href=../ target=_top><img src=""images/i_home.gif"" title=""返回首页"" border=0></A></TD>" & vbCrLf
		Response.Write " </TR>" & vbCrLf
		Response.Write " </TABLE></TD>"
		Response.Write " </TR>" & vbCrLf
		Response.Write " <TR><TD height=10></TD></TR>" & vbCrLf
		Response.Write " </TABLE>" & vbCrLf
	End Sub

	Public Function EncryptKeyCode()
		EncryptKeyCode = True
		Exit Function
	End Function

	'*************************************************************
	'函数作用:缓存后台跳转分类列表
	'*************************************************************
	Public Function SortingJumpList()
		Dim CacheJumpList, SQL, Rs1, i
		If Not IsObject(Conn) Then ConnectionDatabase
		Name = "SortingJumpList"
		If ObjIsEmpty() Then
			CacheJumpList = "<select name=""sortid"" size=""1"">" & vbCrLf
			Set Rs1 = Server.CreateObject("Adodb.recordset")
			SQL = "select * from NC_SoftSort order by rootid,orders"
			Rs1.Open SQL, Conn, 1, 1
			SqlQueryNum = SqlQueryNum + 1
			Do While Not Rs1.EOF
				If Rs1("depth") = 0 Then
					CacheJumpList = CacheJumpList & "<option value="""" "
				Else
					CacheJumpList = CacheJumpList & "<option value=""" & Rs1("RootID") & "," & Rs1("sortid") & "," & Rs1("SortName") & """ {SortID=" & Rs1("sortid") & "}"
				End If
				CacheJumpList = CacheJumpList & ">"
				If Rs1("depth") = 1 Then CacheJumpList = CacheJumpList & " ├ "
				If Rs1("depth") > 1 Then
					For i = 2 To Rs1("depth")
						CacheJumpList = CacheJumpList & " "
					Next
					CacheJumpList = CacheJumpList & " ├ "
				End If
				CacheJumpList = CacheJumpList & Rs1("SortName") & "</option>" & vbCrLf
				Rs1.movenext
			Loop
			Rs1.Close
			Set Rs1 = Nothing
			CacheJumpList = CacheJumpList & "</select>"
			Value = CacheJumpList
		End If
		SortingJumpList = Value
	End Function
	'*************************************************************
	'函数作用:缓存后台跳转分类列表
	'*************************************************************
	Public Function ClassJumpList()
		Dim CacheJumpList, SQL, Rs1, i
		If Not IsObject(Conn) Then ConnectionDatabase
		Name = "ClassJumpList"
		If ObjIsEmpty() Then
			CacheJumpList = "<select name=""classid"" size=""1"">" & vbCrLf
			Set Rs1 = Server.CreateObject("Adodb.recordset")
			SQL = "select * from NC_Class order by rootid,orders"
			Rs1.Open SQL, Conn, 1, 1
			SqlQueryNum = SqlQueryNum + 1
			Do While Not Rs1.EOF
				If Rs1("depth") = 0 Then
					CacheJumpList = CacheJumpList & "<option value="""" "
				Else
					CacheJumpList = CacheJumpList & "<option value=""" & Rs1("RootID") & "," & Rs1("classid") & "," & Rs1("ClassName") & """ {ClassID=" & Rs1("classid") & "}"
				End If
				CacheJumpList = CacheJumpList & ">"
				If Rs1("depth") = 1 Then CacheJumpList = CacheJumpList & " ├ "
				If Rs1("depth") > 1 Then
					For i = 2 To Rs1("depth")
						CacheJumpList = CacheJumpList & " "
					Next
					CacheJumpList = CacheJumpList & " ├ "
				End If
				CacheJumpList = CacheJumpList & Rs1("ClassName") & "</option>" & vbCrLf
				Rs1.movenext
			Loop
			Rs1.Close
			Set Rs1 = Nothing
			CacheJumpList = CacheJumpList & "</select>"
			Value = CacheJumpList
		End If
		ClassJumpList = Value
	End Function
	'*************************************************************
	'函数作用:创建新文件
	'*************************************************************
	Public Function CreateNewFiles(FileName, FileStr)
		Dim FSO
		Dim Fout
		Dim CreatePath
		Set FSO = Server.CreateObject(Script_FSO)
		CreatePath = Server.MapPath(FileName)
		Set Fout = FSO.CreateTextFile(CreatePath)
		Fout.WriteLine FileStr
		Fout.Close
		Set Fout = Nothing
		Set FSO = Nothing
	End Function
	'*************************************************************
	'函数作用:创建新目录
	'*************************************************************
	Public Function CreateNewFolder(FolderName)
		Dim FSO
		Dim FolderPath
		FolderPath = FolderName
		Set FSO = Server.CreateObject(Script_FSO)
		If FSO.FolderExists(Server.MapPath(FolderPath)) = False Then
			FSO.CreateFolder Server.MapPath(FolderPath)
		End If
		Set FSO = Nothing
	End Function

End Class
%>

⌨️ 快捷键说明

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