📄 ks_collectcommoncls.asp
字号:
<%
'===================================================================================================================
'软件名称：科汛网站管理系统
'当前版本：科汛网站管理系统 V2.2 SP2 Free
'Copyright (C) 2006-2008 Kesion.Com All rights reserved.
'产品咨询QQ：9537636,41904294
'技术支持QQ：111394
'程序版权： 科汛网络
'E-Mail :kesioncms@hotmail.com webmaster@kesion.com
'官方网站：http://www.kesion.com
'演示站点：http://test.kesion.com
'郑重声明:
' ①、免费版本请在程序首页保留版权信息，并做上本站LOGO友情连接,商业版本无此要求;
' ②、任何个人或组织不得在授权允许的情况下删除、修改、拷贝本软件及其他副本上一切关于版权的信息；
' ③、科汛网络保留此软件的法律追究权利
'====================================================================================================================
'-----------------------------------------------------------------------------------------------
'科汛网站管理系统,采集通用类
'开发:林文仲 版本 V 2.2
'-----------------------------------------------------------------------------------------------
Class CollectCommonCls
Private KSCMS
Private Sub Class_Initialize()
Set KSCMS=New CommonCls
End Sub
Private Sub Class_Terminate()
Call KSCMS.CloseConn()
Set KSCMS=Nothing
End Sub
'==================================================
'函数名：GetTemplate
'作 用：显示可用模板列表
'参 数：ChannelID ------频道ID,TemplateID----已选的模板ID
'==================================================
Function GetTemplate(ChannelID, TemplateID)
Dim TemplateSql, TemplateRS
TemplateSql = "Select TemplateName,TemplateID,IsDefault From KS_Template Where ChannelID=" & ChannelID & " And TemplateType=3 Order By TemplateID" ' 3文章内容页模板
Set TemplateRS = conn.Execute(TemplateSql)
If TemplateRS.EOF And TemplateRS.BOF Then
GetTemplate = "<option value=0>请先添加模板</option>"
Else
Do While Not TemplateRS.EOF
If CInt(TemplateRS("TemplateID")) = CInt(TemplateID) Then
GetTemplate = GetTemplate & "<option value=" & TemplateRS("TemplateID") & " selected>" & TemplateRS("TemplateName") & "</option>"
Else
GetTemplate = GetTemplate & "<option value=" & TemplateRS("TemplateID") & ">" & TemplateRS("TemplateName") & "</option>"
End If
TemplateRS.MoveNext
Loop
End If
TemplateRS.Close
Set TemplateRS = Nothing
End Function
'==================================================
'过程名：GetSpecialList
'作 用：显示频道下的专题,结合所属频道使用
'参 数：ChannelID ------频道ID
'==================================================
Sub GetSpecialList()
Dim Rs, i, SpecialOpStr
Set Rs = conn.Execute("Select * From KS_Class Where ChannelID=1 And TN='0'")
Response.Write ("<Script language=""Javascript"">") & vbCrLf
Response.Write "var SpecialArr = new Array();" & vbCrLf
Do While Not Rs.EOF
i = i + 1
SpecialOpStr = "<option value='0'>---不属于任何专题---</option>" & KSCMS.ReturnSpecial(0, 1, Rs("ID"))
Response.Write "SpecialArr[" & Rs("ID") & "] =new Array(""" & SpecialOpStr & """)" & vbCrLf
Rs.MoveNext
Loop
Response.Write ("</Script>")
Rs.Close
Set Rs = Nothing
End Sub
'==================================================
'过程名：GetClassList
'作 用：显示频道下的目录,结合所属系统使用
'参 数：ChannelID ------频道ID
'==================================================
Sub GetClassList()
Dim Rs
Set Rs = conn.Execute("Select * From KS_Channel Where ChannelStatus=1 And CollectTF=1")
Response.Write ("<Script language=""Javascript"">") & vbCrLf
Response.Write "var ClassArr = new Array();" & vbCrLf
Do While Not Rs.EOF
Response.Write "ClassArr[" & Rs("ChannelID") & "] =new Array(""" & KSCMS.ReturnTree(0, Rs("ChannelID")) & """)" & vbCrLf
Rs.MoveNext
Loop
Response.Write ("</Script>")
Rs.Close
Set Rs = Nothing
End Sub
'==================================================
'过程名：Collect_ShowChannel_Name
'作 用：显示频道名称
'参 数：ChannelID ------频道ID
'==================================================
Function Collect_ShowChannel_Name(ChannelID)
Dim Sqlc, Rsc, TempStr
ChannelID = CLng(ChannelID)
Sqlc = "select top 1 ChannelName from KS_Channel Where ChannelID=" & ChannelID
Set Rsc = Server.CreateObject("adodb.recordset")
Rsc.Open Sqlc, conn, 1, 1
If Rsc.EOF And Rsc.BOF Then
TempStr = "无指定系统模块"
Else
TempStr = Rsc("ChannelName")
End If
Rsc.Close
Set Rsc = Nothing
Collect_ShowChannel_Name = TempStr
End Function
'==================================================
'过程名：Collect_ShowChannel_Option
'作 用：显示频道选项
'参 数：ChannelID ------频道ID
'==================================================
Function Collect_ShowChannel_Option(ChannelID)
Dim Sqlc, Rsc, ChannelName, TempStr
ChannelID = CLng(ChannelID)
Sqlc = "select ChannelID,ChannelName from KS_Channel where CollectTF=1 And ChannelStatus=1 order by ChannelID asc"
Set Rsc = Server.CreateObject("adodb.recordset")
Rsc.Open Sqlc, conn, 1, 1
TempStr = "<option value=""0"" selected>---请选择系统模块---</option>"
If Rsc.EOF And Rsc.BOF Then
TempStr = TempStr & "<option value=""0"">-------</option>"
Else
Do While Not Rsc.EOF
TempStr = TempStr & "<option value=" & """" & Rsc("ChannelID") & """" & ""
If ChannelID = Rsc("ChannelID") Then
TempStr = TempStr & " selected"
End If
TempStr = TempStr & ">" & Rsc("ChannelName")
TempStr = TempStr & "</option>"
Rsc.MoveNext
Loop
End If
Rsc.Close
Set Rsc = Nothing
Collect_ShowChannel_Option = TempStr
End Function
'==================================================
'过程名：Collect_ShowClass_Name
'作 用：显示栏目名称
'参 数：ChannelID ------频道ID
'参 数：ClassID ------栏目ID
'==================================================
Function Collect_ShowClass_Name(ChannelID, ClassID)
Dim Sqlc, Rsc, TempStr
ChannelID = CLng(ChannelID)
ClassID = ClassID
Sqlc = "Select top 1 FolderName from KS_Class Where ChannelID=" & ChannelID & " and ID='" & ClassID & "'"
Set Rsc = Server.CreateObject("adodb.recordset")
Rsc.Open Sqlc, conn, 1, 1
If Rsc.EOF And Rsc.BOF Then
TempStr = "无指定栏目"
Else
TempStr = Rsc("FolderName")
End If
Rsc.Close
Set Rsc = Nothing
Collect_ShowClass_Name = TempStr
End Function
'==================================================
'过程名：Collect_ShowSpecial_Name
'作 用：显示专题名称
'参 数：ChannelID ------频道ID
'参 数：SpecialID ------专题ID
'==================================================
Sub Collect_ShowSpecial_Name(ChannelID, SpecialID)
Dim Sqlc, Rsc, TempStr
ChannelID = CLng(ChannelID)
Sqlc = "select top 1 SpecialName from KS_Special Where ChannelID=" & ChannelID & " and ID='" & SpecialID & "'"
Set Rsc = Server.CreateObject("adodb.recordset")
Rsc.Open Sqlc, conn, 1, 1
If Rsc.EOF And Rsc.BOF Then
TempStr = "无指定专题"
Else
TempStr = Rsc("SpecialName")
End If
Rsc.Close
Set Rsc = Nothing
Response.Write TempStr
End Sub
'==================================================
'过程名：Collect_ShowClass_Option
'作 用：显示栏目选项
'参 数：ChannelID ------频道ID
'参 数：ClassID ------栏目ID
'==================================================
Sub Collect_ShowClass_Option(ChannelID, ClassID)
Dim rsClass, sqlClass, strTempC, tmpTJ, i
Dim arrShowLine(20)
ChannelID = CLng(ChannelID)
ClassID = ClassID
For i = 0 To UBound(arrShowLine)
arrShowLine(i) = False
Next
strTempC = ""
sqlClass = "Select * From KS_Class where channelid=" & ChannelID & " order by OrderID"
Set rsClass = conn.Execute(sqlClass)
If rsClass.BOF And rsClass.EOF Then
strTempC = "<option value=''>请先添加栏目</option>"
Else
Do While Not rsClass.EOF
tmpTJ = rsClass("TJ")
If rsClass("NextID") > 0 Then
arrShowLine(tmpTJ) = True
Else
arrShowLine(tmpTJ) = False
End If
strTempC = strTempC & "<option value='" & rsClass("ClassID") & "'"
If rsClass("ID") = ClassID Then
strTempC = strTempC & ""
End If
strTempC = strTempC & rsClass("FolderName")
strTempC = strTempC & "</option>"
rsClass.MoveNext
Loop
End If
rsClass.Close
Set rsClass = Nothing
Response.Write strTempC
End Sub
'==================================================
'过程名：Collect_ShowSpecial_Option
'作 用：显示专题选项
'参 数：ChannelID ------频道ID
'参 数：SpecialID ------专题ID
'==================================================
Sub Collect_ShowSpecial_Option(ChannelID, SpecialID)
ChannelID = CLng(ChannelID)
SpecialID = SpecialID
Dim TempStr
TempStr = "<select name='SpecialID' id='SpecialID'><option value=''"
If SpecialID = 0 Then
TempStr = TempStr & " selected"
End If
TempStr = TempStr & ">不属于任何专题</option>"
Dim sqlSpecial, rsSpecial
sqlSpecial = "select * from KS_Special where ChannelID=" & ChannelID
Set rsSpecial = Server.CreateObject("adodb.recordset")
rsSpecial.Open sqlSpecial, conn, 1, 1
Do While Not rsSpecial.EOF
If rsSpecial("ID") = SpecialID Then
TempStr = TempStr & "<option value='" & rsSpecial("ID") & "' selected>" & rsSpecial("SpecialName") & "</option>"
Else
TempStr = TempStr & "<option value='" & rsSpecial("ID") & "'>" & rsSpecial("SpecialName") & "</option>"
End If
rsSpecial.MoveNext
Loop
rsSpecial.Close
Set rsSpecial = Nothing
Response.Write TempStr
End Sub
'==================================================
'函数名：Collect_ShowItem_Name
'作 用：显示项目名称
'参 数：ItemID ------项目ID
'==================================================
Function Collect_ShowItem_Name(ItemID, ConnItem)
Dim Sqlc, Rsc, TempStr
ItemID = CLng(ItemID)
Sqlc = "select top 1 ItemName From KS_CollectItem Where ItemID=" & ItemID
Set Rsc = Server.CreateObject("adodb.recordset")
Rsc.Open Sqlc, ConnItem, 1, 1
If Rsc.EOF And Rsc.BOF Then
TempStr = "无指定项目"
Else
TempStr = Rsc("ItemName")
End If
Rsc.Close
Set Rsc = Nothing
Collect_ShowItem_Name = TempStr
End Function
'==================================================
'函数名：Collect_ShowItem_Option
'作 用：显示项目选项
'参 数：ItemID ------项目ID
'==================================================
Function Collect_ShowItem_Option(ItemID, ConnItem)
Dim SqlI, RsI, TempStr
ItemID = CLng(ItemID)
SqlI = "select ItemID,ItemName From KS_CollectItem order by ItemID desc"
Set RsI = Server.CreateObject("adodb.recordset")
RsI.Open SqlI, ConnItem, 1, 1
TempStr = "<select Name=""ItemID"" ID=""ItemID"">"
If RsI.EOF And RsI.BOF Then
TempStr = TempStr & "<option value="""">请添加项目</option>"
Else
TempStr = TempStr & "<option value="""">请选择项目</option>"
Do While Not RsI.EOF
TempStr = TempStr & "<option value=" & """" & RsI("ItemID") & """" & ""
If ItemID = RsI("ItemID") Then
TempStr = TempStr & " Selected"
End If
TempStr = TempStr & ">" & RsI("ItemName")
TempStr = TempStr & "</option>"
RsI.MoveNext
Loop
End If
RsI.Close
Set RsI = Nothing
TempStr = TempStr & "</select>"
Collect_ShowItem_Option = TempStr
End Function
'==================================================
'函数名：SplitNewsPage
'作 用：获取自动分页
'参 数：Content--内容 MaxPerChar--每页最多字符
'==================================================
Function SplitNewsPage(Content,MaxPerChar)
SplitNewsPage=Content
End Function
'==================================================
'函数名：GetHttpPage
'作 用：获取网页源码
'参 数：HttpUrl ------网页地址
'==================================================
Function GetHttpPage(HttpUrl)
If IsNull(HttpUrl) = True Or Len(HttpUrl) < 18 Or HttpUrl = "Error" Then
GetHttpPage = "Error"
Exit Function
End If
Dim Http
Set Http = Server.CreateObject("MSXML2.XMLHTTP")
Http.Open "GET", HttpUrl, False
on error resume next
Http.Send
If Http.Readystate <> 4 Then
Set Http = Nothing
GetHttpPage = "Error"
Exit Function
End If
GetHttpPage = BytesToBstr(Http.ResponseBody, "GB2312")
Set Http = Nothing
If Err.Number <> 0 Then
Err.Clear
End If
End Function
'==================================================
'函数名：BytesToBstr
'作 用：将获取的源码转换为中文
'参 数：Body ------要转换的变量
'参 数：Cset ------要转换的类型
'==================================================
Function BytesToBstr(Body, Cset)
Dim Objstream
Set Objstream = Server.CreateObject("adodb.stream")
Objstream.Type = 1
Objstream.Mode = 3
Objstream.Open
Objstream.Write Body
Objstream.Position = 0
Objstream.Type = 2
Objstream.Charset = Cset
BytesToBstr = Objstream.ReadText
Objstream.Close
Set Objstream = Nothing
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -