📄 ks.publiccls.asp
字号:
GetMoreLink = "<tr><td colspan= """ & ColNum+1 & """ height=""" & RowHeight & """ align=""right""><a href=""" & LinkUrl & """" & OpenTypeStr & " > " & LinkNameStr & "</a></td></tr>"
ElseIf CStr(MoreLinkType) = "1" Then
GetMoreLink = "<tr><td colspan= """ & ColNum+1 & """ height=""" & RowHeight & """ align=""right""><a href=""" & LinkUrl & """" & OpenTypeStr & " > <img src=""" & LinkNameStr & """ border=""0"" align=""absmiddle""/></a></td></tr>"
Else
GetMoreLink = ""
End If
End If
End Function
'----------------------------------------------------------------------------------------------------------------------------
'函数名: GetSplitPic
'功 能:取得分隔图片
'参 数: ColSpanNum 列数, SplitPic 图片SRC '-------------------------------------------------------------------------------------------------------------------------------
Function GetSplitPic(SplitPic, ColSpanNum)
Dim ColStr
If SplitPic = "" Then
GetSplitPic = ""
Else
If ColSpanNum>=2 Then ColStr=" colspan=""" & ColSpanNum & """"
GetSplitPic = "<tr><td Height=""1""" & ColStr & """ background=""" & SplitPic & """ ></td></tr>" & vbcrlf
End If
End Function
'-------------------------------------------------------------------------------------------------------------------
'函数名:GetFolderTid
'功 能:取得子目录的ID集合
'参 数: FolderID父目录ID
'返回值: 形如 1255555,111111,4444的ID集合
'---------------------------------------------------------------------------------------------------------
Function GetFolderTid(FolderID)
Dim I,Tid,SQL
Dim RS:Set RS=Conn.Execute("Select ID From KS_Class Where DelTF=0 AND TS LIKE '%" & FolderID & "%'")
If RS.EOF Then GetFolderTid="'0'":RS.Close:Set RS=Nothing:Exit Function
SQL=RS.GetRows(-1):RS.Close:Set RS = Nothing
For I=0 To Ubound(SQL,2)
Tid = Tid & "'" & Trim(SQL(0,I)) & "',"
Next
Tid = Left(Trim(Tid), Len(Trim(Tid)) - 1) '去掉最后一个逗号
GetFolderTid = Tid
End Function
'取得专题查询参数,应用于Sql条件
Function GetSpecialPara(SpecialID)
If SpecialID = "-1" Then
If Application(SiteSN & "RefreshType") = "Special" Then
If DataBaseType=1 Then
GetSpecialPara = " charindex('" & Application(SiteSN & "CurrSpecialID") &"',SpecialID)>0"
Else
GetSpecialPara = " instr(SpecialID,'"& Application(SiteSN & "CurrSpecialID") &"')>0"
End If
Else
GetSpecialPara = " 1=1"
End If
ElseIf (SpecialID = "" Or SpecialID = "0") And (Application(SiteSN & "RefreshType") <> "Special") Then
GetSpecialPara = " 1=1"
Else
If DataBaseType=1 Then
GetSpecialPara = " charindex('" & Specialid &"',SpecialID)>0"
Else
GetSpecialPara = " instr(SpecialID,'"& SpecialID &"')>0"
End If
End If
End Function
'**************************************************
'函数名：ReturnChannelAllowUpFilesTF
'作 用：返回频道的是否允许上传文件
'参 数：ChannelID--频道ID
'**************************************************
Public Function ReturnChannelAllowUpFilesTF(ChannelID)
If ChannelID = "" Or Not IsNumeric(ChannelID) Then ChannelID = 0
Dim CRS:Set CRS=Server.CreateObject("ADODB.RECORDSET")
CRS.Open "Select UpFilesTF From KS_Channel Where ChannelID=" & ChannelID, Conn, 1, 1
If CInt(ChannelID) = 0 Or (CRS.EOF And CRS.BOF) Then '默认允许上传文件
ReturnChannelAllowUpFilesTF = True
Else
If CRS(0) = 1 Then ReturnChannelAllowUpFilesTF = True Else ReturnChannelAllowUpFilesTF = False
End If
CRS.Close:Set CRS = Nothing
End Function
'**************************************************
'函数名：ReturnChannelUpFilesDir
'作 用：返回频道后台的上传目录
'参 数：ChannelID--频道ID
'返回值：目录字符串
'**************************************************
Public Function ReturnChannelUpFilesDir(ChannelID)
If ChannelID = "" Or Not IsNumeric(ChannelID) Then
ReturnChannelUpFilesDir = Setting(91)
Exit Function
End If
ReturnChannelUpFilesDir = replace(Setting(3) & C_S(ChannelID,24),"//","/")
ReturnChannelUpFilesDir = Left(ReturnChannelUpFilesDir, Len(ReturnChannelUpFilesDir) - 1)
End Function
'**************************************************
'函数名：ReturnChannelAllowUserUpFilesTF
'作 用：返回频道是否允许会员上传文件
'参 数：ChannelID--频道ID
'**************************************************
Public Function ReturnChannelAllowUserUpFilesTF(ChannelID)
If ChannelID = "" Or Not IsNumeric(ChannelID) Then '默认允许上传文件
ReturnChannelAllowUserUpFilesTF = True:Exit Function
End If
If C_S(ChannelID,26) = 1 Then
ReturnChannelAllowUserUpFilesTF = True
Else
ReturnChannelAllowUserUpFilesTF = False
End If
End Function
'**************************************************
'函数名：ReturnChannelUserUpFilesDir
'作 用：返回频道前台会员的上传目录
'参 数：ChannelID--频道ID,UserFolder-按用户名生成的目录
'返回值：目录字符串
'**************************************************
Public Function ReturnChannelUserUpFilesDir(ChannelID,UserFolder)
Dim Ce:Set Ce=new CtoeCls
UserFolder=Ce.CTOE(R(UserFolder))
Set Ce=Nothing
ChannelID = ChkCLng(ChannelID)
Select Case ChannelID
Case 9999 '用户头像
ReturnChannelUserUpFilesDir=Setting(3)&Setting(91)&"User/" & UserFolder &"/upface/"
Case 9998 '相册封面
ReturnChannelUserUpFilesDir=Setting(3)&Setting(91)&"User/" & UserFolder &"/xc/"
Case 9997 '照片
ReturnChannelUserUpFilesDir=Setting(3)&Setting(91)&"User/" & UserFolder &"/xc/"
Case 9996 '圈子图片
ReturnChannelUserUpFilesDir=Setting(3)&Setting(91)&"User/" & UserFolder &"/team/"
Case Else
ReturnChannelUserUpFilesDir = C_S(ChannelID,27)
ReturnChannelUserUpFilesDir = Setting(3) & Setting(91)&"User/" & UserFolder &"/"& ReturnChannelUserUpFilesDir
End Select
End Function
'**************************************************
'函数名：ReturnChannelAllowUpFilesSize
'作 用：返回频道的最大允许上传文件大小
'参 数：ChannelID--频道ID
'**************************************************
Public Function ReturnChannelAllowUpFilesSize(ChannelID)
ChannelID = ChkClng(ChannelID)
Dim CRS:Set CRS=conn.execute("Select UpFilesSize From KS_Channel Where ChannelID=" & ChannelID)
If CInt(ChannelID) = 0 Or (CRS.EOF And CRS.BOF) Then
ReturnChannelAllowUpFilesSize = Setting(6)
Else
ReturnChannelAllowUpFilesSize = CRS(0)
End If
CRS.Close:Set CRS = Nothing
End Function
'**************************************************
'函数名：ReturnChannelAllowUpFilesType
'作 用：返回频道的允许上传的文件类型
'参 数：ChannelID--频道ID,TypeFlag 0-取全部 1-图片类型 2-flash 类型 3-Windows 媒体类型 4-Real 类型 5-其它类型
'**************************************************
Public Function ReturnChannelAllowUpFilesType(ChannelID, TypeFlag)
If ChkClng(ChannelID) = 0 Then ReturnChannelAllowUpFilesType = Setting(7):Exit Function
If Not IsNumeric(TypeFlag) Then TypeFlag = 0
If TypeFlag = 0 Then '所有允许的类型
ReturnChannelAllowUpFilesType = C_S(ChannelID,28) & "|" & C_S(ChannelID,29) & "|" & C_S(ChannelID,30) & "|" & C_S(ChannelID,31) & "|" & C_S(ChannelID,32)
Else
ReturnChannelAllowUpFilesType = C_S(ChannelID,27+TypeFlag)
End If
End Function
'返回付款方式名称,参数TypeID,0名称 1折扣率
Function ReturnPayment(ID,TypeID)
If Application(SiteSn &"Payment_" & ID&TypeID)="" Then
Dim RS:Set RS=Server.CreateObject("ADODB.RECORDSET")
RS.Open "Select TypeName,Discount From KS_PaymentType Where TypeID=" & ID,conn,1,1
If Not RS.Eof Then
If TypeID=0 Then
ReturnPayment=rs(0)
If RS(1)<100 Then ReturnPayment=ReturnPayment & " <font color=red>折扣率:" & RS(1) & "%"
Else
ReturnPayment=rs(1)
End if
End iF
Application(SiteSn &"Payment_" & ID&TypeID)=ReturnPayment
Else
ReturnPayment=Application(SiteSn &"Payment_" & ID&TypeID)
End If
End Function
'返回收货方式名称,参数TypeID,0名称 1费用
Function ReturnDelivery(ID,TypeID)
If Application(SiteSn &"Delivery_" & ID&TypeID)="" Then
Dim RS:Set RS=Server.CreateObject("ADODB.RECORDSET")
RS.Open "Select TypeName,fee From KS_Delivery Where TypeID=" & ID,conn,1,1
If Not RS.Eof Then
If TypeID=0 Then
ReturnDelivery=rs(0)
If RS(1)=0 Then ReturnDelivery=ReturnDelivery & " <font color=blue>免费</font>" Else ReturnDelivery=ReturnDelivery & " <font color=red>加收 " & RS(1) & "元"
Else
ReturnDelivery=rs(1)
End iF
End iF
Application(SiteSn &"Delivery_" & ID&TypeID)=ReturnDelivery
Else
ReturnDelivery=Application(SiteSn &"Delivery_" & ID&TypeID)
End If
End Function
'**********************************************************************
'函数名：ReturnSpecial
'作 用：返回专题名称
'参 数：Selected-预选中项 ,ChannelID--频道ID,FolderID ---目录ID
'返回值：专题名称
'**********************************************************************
Public Function ReturnSpecial(SelectID, ChannelID, FolderID)
Dim RS:Set RS=Server.CreateObject("ADODB.RECORDSET")
Dim ParaStr,SpecialChannelStr
If ChannelID="" Then ChannelID=0
If ChannelID <> 0 Then
ParaStr = ParaStr & " And ChannelID=" & ChannelID
End If
RS.Open "Select SpecialName,SpecialID,FolderID From KS_Special Where 1=1 " & ParaStr, Conn, 1, 1
If Not RS.EOF Then
Do While Not RS.EOF
If FolderID=RS(2) Then SpecialChannelStr="（本频道）" Else SpecialChannelStr=""
If Trim(SelectID) = Trim(RS(1)) Then
ReturnSpecial = ReturnSpecial & "<Option value=" & RS(1) & " Selected>" & Trim(RS("SpecialName")) & SpecialChannelStr & "</Option>"
Else
ReturnSpecial = ReturnSpecial & "<Option value=" & RS(1) & ">" & Trim(RS("SpecialName")) & SpecialChannelStr & "</Option>"
End If
RS.MoveNext
Loop
End If
RS.Close:Set RS = Nothing
End Function
'**************************************************
'函数：FoundInArr
'作 用：检查一个数组中所有元素是否包含指定字符串
'参 数：strArr ----字符串
' strToFind ----要查找的字符串
' strSplit ----数组的分隔符
'返回值：True,False
'**************************************************
Public Function FoundInArr(strArr, strToFind, strSplit)
Dim arrTemp, i
FoundInArr = False
If InStr(strArr, strSplit) > 0 Then
arrTemp = Split(strArr, strSplit)
For i = 0 To UBound(arrTemp)
If LCase(Trim(arrTemp(i))) = LCase(Trim(strToFind)) Then
FoundInArr = True:Exit For
End If
Next
Else
If LCase(Trim(strArr)) = LCase(Trim(strToFind)) Then FoundInArr = True
End If
End Function
'检查是否是数字 ，并转换为长整型
Public Function ChkClng(ByVal str)
On error resume next
If IsNumeric(str) Then
ChkClng = CLng(str)
Else
ChkClng = 0
End If
If Err Then ChkClng=0
End Function
'**************************************************
'函数名：ShowPage
'作 用：显示“上一页 下一页”等信息
'参 数：filename ----链接地址
' TotalNumber ----总数量
' MaxPerPage ----每页数量
' ShowAllPages ---是否用下拉列表显示所有页面以供跳转。
' strUnit ----计数单位,CurrentPage--当前页
'返回值：无返回值
'**************************************************
Sub ShowPage(totalnumber, MaxPerPage, FileName, ShowAllPages, strUnit, CurrentPage)
Dim N, I, PageStr
Const Btn_First = "<font face='webdings' size='2' title='第一页'>9</font>" '定义第一页按钮显示样式
Const Btn_Prev = "<font face='webdings' size='2' title='上一页'>3</font>" '定义前一页按钮显示样式
Const Btn_Next = "<font face='webdings' size='2' title='下一页'>4</font>" '定义下一页按钮显示样式
Const Btn_Last = "<font face='webdings' size='2' title='最后一页'>:</font>" '定义最后一页按钮显示样式
PageStr = ""
If totalnumber Mod MaxPerPage = 0 Then
N = totalnumber \ MaxPerPage
Else
N = totalnumber \ MaxPerPage + 1
End If
If N > 1 Then
PageStr = PageStr & ("页次：<font color=red>" & CurrentPage & "</font>/" & N & "页 共有:" & totalnumber & strUnit & " 每页:" & MaxPerPage & strUnit & " ")
If CurrentPage < 2 Then
PageStr = PageStr & Btn_First & " " & Btn_Prev & " "
Else
PageStr = PageStr & ("<a href=" & FileName & "?page=1>" & Btn_First & "</a> <a href=" & FileName & "?page=" & CurrentPage - 1 & ">" & Btn_Prev & "</a> ")
End If
If N - CurrentPage < 1 Then
PageStr = PageStr & " " & Btn_Next & " " & Btn_Last & " "
Else
PageStr = PageStr & (" <a href=" & FileName & "?page=" & (CurrentPage + 1) & ">" & Btn_Next & "</a> <a href=" & FileName & "?page=" & N & ">" & Btn_Last & "</a> ")
End If
If ShowAllPages = True Then
PageStr = PageStr & "GO:<select onChange='location.href=this.value;' style='width:55;' name='select'>"
For I = 1 To N
If CurrentPage = I Then
PageStr = PageStr & ("<option value=" & FileName & "?page=" & I & " selected>NO." & I & "</option>")
Else
PageStr = PageStr & ("<option value=" & FileName & "?page=" & I & ">NO." & I & "</opt⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -