📄 ks_commoncls.asp
字号:
'********************************************
'函数名：IsValidEmail
'作 用：检查Email地址合法性
'参 数：email ----要检查的Email地址
'返回值：True ----Email地址合法
' False ----Email地址不合法
'********************************************
Public Function IsValidEmail(Email)
Dim names, name, I, c
IsValidEmail = True
names = Split(Email, "@")
If UBound(names) <> 1 Then IsValidEmail = False: Exit Function
For Each name In names
If Len(name) <= 0 Then IsValidEmail = False:Exit Function
For I = 1 To Len(name)
c = LCase(Mid(name, I, 1))
If InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 And Not IsNumeric(c) Then IsValidEmail = False:Exit Function
Next
If Left(name, 1) = "." Or Right(name, 1) = "." Then IsValidEmail = False:Exit Function
Next
If InStr(names(1), ".") <= 0 Then IsValidEmail = False:Exit Function
I = Len(names(1)) - InStrRev(names(1), ".")
If I <> 2 And I <> 3 Then IsValidEmail = False:Exit Function
If InStr(Email, "..") > 0 Then IsValidEmail = False
End Function
'**************************************************
'函数名：strLength
'作 用：求字符串长度。汉字算两个字符，英文算一个字符。
'参 数：str ----要求长度的字符串
'返回值：字符串长度
'**************************************************
Public Function strLength(Str)
On Error Resume Next
Dim WINNT_CHINESE
WINNT_CHINESE = (Len("中国") = 2)
If WINNT_CHINESE Then
Dim l, T, c
Dim I
l = Len(Str)
T = l
For I = 1 To l
c = Asc(Mid(Str, I, 1))
If c < 0 Then c = c + 65536
If c > 255 Then
T = T + 1
End If
Next
strLength = T
Else
strLength = Len(Str)
End If
If Err.Number <> 0 Then Err.Clear
End Function
'**************************************************
'函数名：ReturnChannelList
'作 用：显示频道列表。
'参 数：SelectChannelID ----选择频道ID号
' Disabled ---------是否允许用户重新改变选项值,True不允许,False允许
'返回值：频道列表
'**************************************************
Public Function ReturnChannelList(SelectChannelID, Disabled)
Dim ChannelRS:Set ChannelRS=Server.CreateObject("ADODB.Recordset")
Dim ChannelStr:ChannelStr = ""
ChannelRS.Open "Select * From [KS_Channel] Where ChannelStatus=1", Conn, 1, 1
If ChannelRS.EOF And ChannelRS.BOF Then
ChannelRS.Close:Set ChannelRS = Nothing:Exit Function
Else
If Disabled <> True Then
ChannelStr = "<select name=""ChannelID"" style=""width:200;border-style: solid; border-width: 1"">"
End If
Do While Not ChannelRS.EOF
If ChannelRS("ChannelID") = SelectChannelID Then
If Disabled <> True Then
ChannelStr = ChannelStr & "<option selected value=" & ChannelRS("ChannelID") & ">" & ChannelRS("ChannelName") & "</option>"
Else
ChannelStr = ChannelStr & "<input type=""text"" value=""" & ChannelRS("ChannelName") & """ name=""ChannelValue"" disabled=true style=""width:200;border-style: solid; border-width: 1"">"
ChannelStr = ChannelStr & "<input type=""hidden"" value=""" & ChannelRS("ChannelID") & """ name=""ChannelID"">"
End If
Else
If Disabled <> True Then
ChannelStr = ChannelStr & "<option value=" & ChannelRS("ChannelID") & ">" & ChannelRS("ChannelName") & "</option>"
End If
End If
ChannelRS.MoveNext
Loop
ChannelRS.Close:Set ChannelRS = Nothing
End If
If Disabled <> True Then
ChannelStr = ChannelStr & "</Select>"
End If
ReturnChannelList = ChannelStr
End Function
'**************************************************
'函数名：ReturnAllowTree
'作 用：返回允许投稿的目录树。
'参 数：FolderID ----选择项ID, ChannelID-----返回频道目录树
'返回值：整棵树
'**************************************************
Public Function ReturnAllowTree(FolderID, ChannelID)
KSCache.name=Cstr(SiteSN & "ClassAllowTree" &ChannelID&FolderID)
IF KSCache.valid and KSCache.value<>"" Then
ReturnAllowTree=KSCache.value
Else
Call KSCache.clean
Dim RS,FolderName,TreeStr,ID
Set RS=Server.CreateObject("ADODB.Recordset")
FolderID = Trim(FolderID)
If Not IsNumeric(ChannelID) Then Return
RS.Open ("select ID,FolderName from KS_Class Where ChannelID=" & ChannelID & " AND tj=1 And CommentTF=1 Order BY FolderOrder ASC"), Conn, 1, 1
Do While Not RS.EOF
ID = Trim(RS(0))
FolderName = Trim(RS(1))
If FolderID = ID Then
TreeStr = TreeStr & "<option selected value='" & ID & "'>" & FolderName & "</option>"
Else
TreeStr = TreeStr & "<option value='" & ID & "'>" & FolderName & " </option>"
End If
TreeStr = TreeStr & ReturnAllowSubList(ID, FolderID)
RS.MoveNext
Loop
RS.Close:Set RS = Nothing
ReturnAllowTree = TreeStr
KSCache.add ReturnAllowTree,dateadd("n",1000000,now)
End If
End Function
'**************************************************
'函数名：ReturnAllowSubList
'作 用：查找并返子树数据。
'参 数：ParentID ----父节点ID, FolderID ----选择项ID
'返回值：子树
'**************************************************
Public Function ReturnAllowSubList(ParentID, FolderID)
Dim SubTypeList, SubRS, SpaceStr, k, Total, Num,FolderName, ID,TJ
Set SubRS = Server.CreateObject("ADODB.RECORDSET")
SubRS.Open ("Select count(ID) AS total from KS_Class Where CommentTF=1 And TN='" & ParentID & "'"), Conn, 1, 1
Total = SubRS("Total")
SubRS.Close
SubRS.Open ("Select ID,FolderName,TJ from KS_Class Where CommentTF=1 And TN='" & ParentID & "' Order BY FolderOrder ASC"), Conn, 1, 1
Num = 0
Do While Not SubRS.EOF
Num = Num + 1
SpaceStr = ""
TJ = CInt(SubRS(2))
For k = 1 To TJ - 1
If k = 1 And k <> TJ - 1 Then
SpaceStr = SpaceStr & " │"
ElseIf k = TJ - 1 Then
If Num = Total Then
SpaceStr = SpaceStr & " └ "
Else
SpaceStr = SpaceStr & " ├ "
End If
Else
SpaceStr = SpaceStr & " │"
End If
Next
ID = Trim(SubRS(0))
FolderName = Trim(SubRS(1))
If FolderID = ID Then
SubTypeList = SubTypeList & "<option selected value='" & ID & "'>" & SpaceStr & FolderName & "</option>"
Else
SubTypeList = SubTypeList & "<option value='" & ID & "'>" & SpaceStr & FolderName & "</option>"
End If
SubTypeList = SubTypeList & ReturnAllowSubList(ID, FolderID)
SubRS.MoveNext
Loop
SubRS.Close:Set SubRS = Nothing
ReturnAllowSubList = SubTypeList
End Function
'**************************************************
'函数名：ReturnTree
'作 用：返回目录树。
'参 数：FolderID ----选择项ID, ChannelID-----返回频道目录树
'返回值：整棵树
'**************************************************
Public Function ReturnTree(FolderID, ChannelID)
KSCache.name=Cstr(SiteSN & "ClassTree" &ChannelID&FolderID)
IF KSCache.valid and KSCache.value<>"" Then
ReturnTree=KSCache.value
Else
Call KSCache.clean
Dim RS,FolderName,TreeStr,ID
Set RS=Server.CreateObject("ADODB.Recordset")
FolderID = Trim(FolderID)
If Not IsNumeric(ChannelID) Then Return
RS.Open ("select ID,FolderName from KS_Class Where ChannelID=" & ChannelID & " AND tj=1 Order BY FolderOrder ASC"), Conn, 1, 1
Do While Not RS.EOF
ID = Trim(RS(0))
FolderName = Trim(RS(1))
If FolderID = ID Then
TreeStr = TreeStr & "<option selected value='" & ID & "'>" & FolderName & "</option>"
Else
TreeStr = TreeStr & "<option value='" & ID & "'>" & FolderName & " </option>"
End If
TreeStr = TreeStr & ReturnSubList(ID, FolderID)
RS.MoveNext
Loop
RS.Close:Set RS = Nothing
ReturnTree = TreeStr
KSCache.add ReturnTree,dateadd("n",1000000,now)
End If
End Function
'**************************************************
'函数名：ReturnSubList
'作 用：查找并返子树数据。
'参 数：ParentID ----父节点ID, FolderID ----选择项ID
'返回值：子树
'**************************************************
Public Function ReturnSubList(ParentID, FolderID)
Dim SubTypeList, SubRS, SpaceStr, k, Total, Num,FolderName, ID,TJ
Set SubRS = Server.CreateObject("ADODB.RECORDSET")
SubRS.Open ("Select count(ID) AS total from KS_Class Where TN='" & ParentID & "'"), Conn, 1, 1
Total = SubRS("Total")
SubRS.Close
SubRS.Open ("Select ID,FolderName,TJ from KS_Class Where TN='" & ParentID & "' Order BY FolderOrder ASC"), Conn, 1, 1
Num = 0
Do While Not SubRS.EOF
Num = Num + 1
SpaceStr = ""
TJ = CInt(SubRS(2))
For k = 1 To TJ - 1
If k = 1 And k <> TJ - 1 Then
SpaceStr = SpaceStr & " │"
ElseIf k = TJ - 1 Then
If Num = Total Then
SpaceStr = SpaceStr & " └ "
Else
SpaceStr = SpaceStr & " ├ "
End If
Else
SpaceStr = SpaceStr & " │"
End If
Next
ID = Trim(SubRS(0))
FolderName = Trim(SubRS(1))
If FolderID = ID Then
SubTypeList = SubTypeList & "<option selected value='" & ID & "'>" & SpaceStr & FolderName & "</option>"
Else
SubTypeList = SubTypeList & "<option value='" & ID & "'>" & SpaceStr & FolderName & "</option>"
End If
SubTypeList = SubTypeList & ReturnSubList(ID, FolderID)
SubRS.MoveNext
Loop
SubRS.Close:Set SubRS = Nothing
ReturnSubList = SubTypeList
End Function
'**************************************************
'函数名：ReturnClassName
'作 用：返回栏目（频道）名称
'参 数：ID--ID号
'返回值：栏目或频道的名称
'**************************************************
Public Function ReturnClassName(ID)
If ID = "" Then ReturnClassName = "": Exit Function
Dim RS:Set RS=Server.CreateObject("ADODB.Recordset")
RS.Open "SELECT FolderName FROM [KS_Class] WHERE ID='" & ID & "'", Conn, 1, 1
If Not RS.EOF Then
ReturnClassName = RS(0)
Else
ReturnClassName = " "
End If
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -