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 + -
显示快捷键?