📄 nc_mailcls.asp
字号:
HtmlMenu = "<a href='" & SetupDir & "Sorting.asp?sortid=" & Rs("sortid") & "' class=""ToolBarLink"" title='" & Rs("Readme") & "'>" & Rs("SortName") & "</a>" & vbCrLf
End If
If (i Mod CInt(mainset(1))) = 0 And i <> totalnumber Then HtmlMenu = HtmlMenu & "<BR>"
HtmlString = Replace(HtmlString, "{$SoftMeun}", HtmlMenu)
Rs.movenext
i = i + 1
Loop
End If
Rs.Close
Set Rs = Nothing
HtmlString = HtmlString & mainset(5)
HtmlString = Replace(HtmlString, "{$SetupDir}", SetupDir)
HtmlString = Replace(HtmlString, "{$IndexPage}", Setting(6))
Value = HtmlString
End Sub
Public Sub ClassMenuToCache()
Dim SQL, Rs, HtmlString, HtmlMenu, i, totalnumber
If Not IsObject(Conn) Then ConnectionDatabase
SQL = "select * from [NC_Class] where depth=0 order by rootid"
Set Rs = CreateObject("adodb.recordset")
Rs.Open SQL, Conn, 1, 1
SqlQueryNum = SqlQueryNum + 1
HtmlString = mainset(6)
If Not (Rs.EOF And Rs.bof) Then
i = 1
totalnumber = Rs.recordcount
Do While Not Rs.EOF
HtmlString = HtmlString & mainset(7)
If CInt(Setting(5)) = 0 Then
HtmlMenu = "<a href='" & SetupDir & "Listing/Catalog" & Rs("classid") & "/Listing_Indate_Desc_1.html' class=""ToolBarLink"" title='" & Rs("Readme") & "'>" & Rs("ClassName") & "</a>" & vbCrLf
Else
HtmlMenu = "<a href='" & SetupDir & "Listing.asp?classid=" & Rs("classid") & "' class=""ToolBarLink"" title='" & Rs("Readme") & "'>" & Rs("ClassName") & "</a>" & vbCrLf
End If
If i Mod CInt(mainset(2)) = 0 And i <> totalnumber Then HtmlMenu = HtmlMenu & "<BR>"
HtmlString = Replace(HtmlString, "{$InfoMeun}", HtmlMenu)
Rs.movenext
i = i + 1
Loop
End If
Rs.Close
Set Rs = Nothing
HtmlString = HtmlString & mainset(8)
HtmlString = Replace(HtmlString, "{$SetupDir}", SetupDir)
HtmlString = Replace(HtmlString, "{$IndexPage}", Setting(6))
Value = HtmlString
End Sub
Property Get Get_ScriptNameUrl()
If Request.ServerVariables("SERVER_PORT") = "80" Then
Get_ScriptNameUrl = "http://" & Request.ServerVariables("server_name") & Replace(LCase(Request.ServerVariables("script_name")), ScriptName, "")
Else
Get_ScriptNameUrl = "http://" & Request.ServerVariables("server_name") & ":" & Request.ServerVariables("SERVER_PORT") & Replace(LCase(Request.ServerVariables("script_name")), ScriptName, "")
End If
End Property
Public Sub ConnectionDatabase()
Set Conn = Server.CreateObject("ADODB.Connection")
Conn.Open Connstr
End Sub
Public Function Execute(Command)
If Not IsObject(Conn) Then ConnectionDatabase
If InStr(LCase(Command), "nc_admin") > 0 And Left(ScriptName, 6) <> "admin_" Then
Command = Replace(LCase(Command), "nc_admin", "nc<i>"&Chr(95)&"</i>admin")
End If
On Error Resume Next
Set Execute = Conn.Execute(Command)
If Err Then
Err.Clear
Set Conn = Nothing
Response.Write "查询数据的时候发现错误，请检查您的查询代码是否正确。"
Response.End
End If
SqlQueryNum = SqlQueryNum + 1
End Function
'*************************************************************
'函数作用：IP地址限制
'*************************************************************
Public Function ChecKIPlock()
On Error Resume Next
ChecKIPlock = False
Dim locklist
Dim locklists
locklists = Trim(LockipList)
If Len(locklists) = 0 Then Exit Function
Dim i
Dim StrUserIP
Dim StrKillIP
StrUserIP = GetUserip
locklist = Split(locklists, "|")
If Len(StrUserIP) = 0 Then Exit Function
StrUserIP = Split(GetUserip, ".")
If UBound(StrUserIP) <> 3 Then Exit Function
For i = 0 To UBound(locklist)
locklist(i) = Trim(locklist(i))
If locklist(i) <> "" Then
StrKillIP = Split(locklist(i), ".")
If UBound(StrKillIP) <> 3 Then Exit For
ChecKIPlock = True
If (StrUserIP(0) <> StrKillIP(0)) And InStr(StrKillIP(0), "*") = 0 Then ChecKIPlock = False
If (StrUserIP(1) <> StrKillIP(1)) And InStr(StrKillIP(1), "*") = 0 Then ChecKIPlock = False
If (StrUserIP(2) <> StrKillIP(2)) And InStr(StrKillIP(2), "*") = 0 Then ChecKIPlock = False
If (StrUserIP(3) <> StrKillIP(3)) And InStr(StrKillIP(3), "*") = 0 Then ChecKIPlock = False
If ChecKIPlock Then Exit For
End If
Next
Response.Cookies(DownLoad_sn & "Kill").Expires = DateAdd("s", 3600, Now())
Response.Cookies(DownLoad_sn & "Kill").Path = SetupDir
If ChecKIPlock Then
Response.Cookies(DownLoad_sn & "Kill")("kill") = "1"
Response.redirect ("" & SetupDir & "showerr.asp?action=iplock")
Else
Response.Cookies(DownLoad_sn & "Kill")("kill") = "0"
End If
End Function
'*************************************************************
'函数作用：判断服务器是否支持FSO组件（FileSystemObject）
'*************************************************************
Public Function IsObjectFSO(ObjString)
On Error Resume Next
IsObjectFSO = False
Err = 0
Dim TestFSO
Set TestFSO = Server.CreateObject(ObjString)
If 0 = Err Then IsObjectFSO = True
Set TestFSO = Nothing
Err = 0
End Function
'*************************************************************
'函数名：ChkFormStr
'作 用：过滤表单字符
'参 数：str ----原字符串
'返回值：过滤后的字符串
'*************************************************************
Public Function ChkFormStr(str)
If IsNull(str) Then
ChkFormStr = ""
Exit Function
End If
str = Replace(str, Chr(39), "'")
str = Replace(str, Chr(34), """)
str = Replace(str, Chr(13), "")
str = Replace(str, Chr(10), "")
str = Replace(str, Chr(9), "")
str = Replace(str, " ", " ")
ChkFormStr = Trim(str)
End Function
'*************************************************************
'函数作用：过滤SQL非法字符
'*************************************************************
Public Function checkStr(Str)
If IsNull(Str) Then
checkStr = ""
Exit Function
End If
checkStr = Replace(Str, "'", "''")
End Function
'*************************************************************
'函数作用：过滤查询字符
'*************************************************************
Public Function ChkQueryStr(Str)
If IsNull(Str) Then
ChkQueryStr = ""
Exit Function
End If
Str = Replace(Str,"!"," ")
Str = Replace(Str,"]"," ")
Str = Replace(Str,"["," ")
Str = Replace(Str,")"," ")
Str = Replace(Str,"("," ")
Str = Replace(Str," "," ")
Str = Replace(Str,"-"," ")
Str = Replace(Str,"/"," ")
Str = Replace(Str,"+"," ")
Str = Replace(Str,"="," ")
Str = Replace(Str,","," ")
Str = Replace(Str,"'"," ")
Str = Replace(Str," "," ")
ChkQueryStr = Str
End Function
'*************************************************************
'函数作用：带脏话过滤
'*************************************************************
Public Function ChkBadWords(Str)
If IsNull(Str) Then Exit Function
Dim i, Bwords, Bwordr
Bwords = Split(Badwords, "|")
Bwordr = Split(Badwordr, "|")
For i = 0 To UBound(Bwords)
If i > UBound(Bwordr) Then
Str = Replace(Str, Bwords(i), "*")
Else
Str = Replace(Str, Bwords(i), Bwordr(i))
End If
Next
ChkBadWords = Str
End Function
'*************************************************************
'函数作用：过滤HTML代码，带脏话过滤
'*************************************************************
Public Function HTMLEncode(fString)
If Not IsNull(fString) Then
fString = Replace(fString, ">", ">")
fString = Replace(fString, "<", "<")
fString = Replace(fString, Chr(32), " ")
fString = Replace(fString, Chr(9), " ")
fString = Replace(fString, Chr(34), """)
fString = Replace(fString, Chr(39), "'")
fString = Replace(fString, Chr(13), "")
fString = Replace(fString, " ", " ")
fString = Replace(fString, Chr(10), "<BR> ")
fString = ChkBadWords(fString)
HTMLEncode = fString
End If
End Function
'*************************************************************
'函数作用：过滤HTML代码，不带脏话过滤
'*************************************************************
Public Function HTMLEncodes(fString)
If Not IsNull(fString) Then
fString = Replace(fString, "'", "'")
fString = Replace(fString, ">", ">")
fString = Replace(fString, "<", "<")
fString = Replace(fString, Chr(32), " ")
fString = Replace(fString, Chr(9), " ")
fString = Replace(fString, Chr(34), """)
fString = Replace(fString, Chr(39), "'")
fString = Replace(fString, Chr(13), "")
fString = Replace(fString, Chr(10), "<BR> ")
fString = Replace(fString, " ", " ")
HTMLEncodes = fString
End If
End Function
'*************************************************************
'函数作用：判断发言是否来自外部
'*************************************************************
Public Function CheckPost()
Dim server_v1, server_v2
CheckPost = False
server_v1 = CStr(Request.ServerVariables("HTTP_REFERER"))
server_v2 = CStr(Request.ServerVariables("SERVER_NAME"))
If Mid(server_v1, 8, Len(server_v2)) = server_v2 Then
CheckPost = True
End If
End Function
'*************************************************************
'函数作用：显示字符串长度
'*************************************************************
Public Function gotTopic(Str, strlen)
Dim l, T, c, i
Str = Replace(Str, " ", " ")
l = Len(Str)
T = 0
For i = 1 To l
c = Abs(Asc(Mid(Str, i, 1)))
If c > 255 Then
T = T + 2
Else
T = T + 1
End If
If T >= strlen Then
gotTopic = Left(Str, i) & "..."
Exit For
Else
gotTopic = Str & " "
End If
Next
End Function
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,"")
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -