📄 collect_itemcollecfast.asp
字号:
NPsString = Arr_Item(50, ItemNumTemp) '文章分页代码开始
NPoString = Arr_Item(51, ItemNumTemp) '文章分页代码结束
NewsPageStr = Arr_Item(52, ItemNumTemp) '文章分页链接的开始标记
NewsPageEnd = Arr_Item(53, ItemNumTemp) '文章分页链接的结束标记
PaginationType = Arr_Item(55, ItemNumTemp)
MaxCharPerPage = Arr_Item(56, ItemNumTemp)
ReadLevel = Arr_Item(57, ItemNumTemp)
Stars = Arr_Item(58, ItemNumTemp)
ReadPoint = Arr_Item(59, ItemNumTemp)
Hits = Arr_Item(60, ItemNumTemp)
UpDateType = Arr_Item(61, ItemNumTemp)
UpDateTime = Arr_Item(62, ItemNumTemp)
Strip = Arr_Item(63, ItemNumTemp)
Rolls = Arr_Item(64, ItemNumTemp)
Comment = Arr_Item(65, ItemNumTemp)
Recommend = Arr_Item(66, ItemNumTemp)
Popular = Arr_Item(67, ItemNumTemp)
FnameType = Arr_Item(68, ItemNumTemp) '生成的扩展名
TemplateID = Arr_Item(69, ItemNumTemp) '生成的模板
Script_Iframe = Arr_Item(70, ItemNumTemp)
Script_Object = Arr_Item(71, ItemNumTemp)
Script_Script = Arr_Item(72, ItemNumTemp)
Script_Div = Arr_Item(73, ItemNumTemp)
Script_Class = Arr_Item(74, ItemNumTemp)
Script_Span = Arr_Item(75, ItemNumTemp)
Script_Img = Arr_Item(76, ItemNumTemp)
Script_Font = Arr_Item(77, ItemNumTemp)
Script_A = Arr_Item(78, ItemNumTemp)
Script_Html = Arr_Item(79, ItemNumTemp)
CollecListNum = Arr_Item(80, ItemNumTemp)
CollecNewsNum = Arr_Item(81, ItemNumTemp)
IntoBase = Arr_Item(82, ItemNumTemp)
BeyondSavePic = Arr_Item(83, ItemNumTemp)
CollecOrder = Arr_Item(84, ItemNumTemp)
Verific = Arr_Item(85, ItemNumTemp)
InputerType = Arr_Item(86, ItemNumTemp)
Inputer = Arr_Item(87, ItemNumTemp)
EditorType = Arr_Item(88, ItemNumTemp)
Editor = Arr_Item(89, ItemNumTemp)
ShowComment = Arr_Item(90, ItemNumTemp)
Script_Table = Arr_Item(91, ItemNumTemp)
Script_Tr = Arr_Item(92, ItemNumTemp)
Script_Td = Arr_Item(93, ItemNumTemp)
If InputerType = 1 Then
Inputer = KMCObj.FpHtmlEnCode(Inputer)
Else
Inputer = Request.Cookies(KSCMS.SiteSn)("AdminName")
End If
If EditorType = 1 Then
Editor = KMCObj.FpHtmlEnCode(Editor)
Else
Editor = Request.Cookies(KSCMS.SiteSn)("AdminName")
End If
End Sub
'==================================================
'过程名：GetListPage
'作 用：获取列表下一页
'参 数：无
'==================================================
Sub GetListPage()
If ListPageType = 1 Then
ListPageNext = KMCObj.GetPage(ListCode, LPsString, LPoString, False, False)
ListPageNext = KMCObj.FpHtmlEnCode(ListPageNext)
If ListPageNext <> "Error" And ListPageNext <> "" Then
If ListPageStr1 <> "" Then
ListPageNext = Replace(ListPageStr1, "{$ID}", ListPageNext)
Else
ListPageNext = KMCObj.DefiniteUrl(ListPageNext, ListUrl)
End If
ListPageNext = Replace(ListPageNext, "&", "{$ID}")
End If
Else
ListPageNext = "Error"
End If
End Sub
'==================================================
'过程名：SaveArticle
'作 用：保存文章
'参 数：无
'==================================================
Sub SaveArticle()
Dim ArticleFsoType
ArticleFsoType = conn.Execute("select ArticleFsoType from KS_class where id='" & ClassID & "'")(0)
ArticleID = KSCMS.GetInfoID(1) '取文章的唯一ID
Set Rs = Server.CreateObject("adodb.recordset")
Sql = "select top 1 * from KS_Article where Title='" & Title & "' and Tid='" & ClassID & "'"
If IntoBase = 1 Then '直接插入数据库
Rs.Open Sql, conn, 1, 3
Else
Rs.Open Sql, ConnItem, 1, 3
End If
If Rs.EOF Then
Rs.AddNew
Rs("NewsID") = ArticleID
Rs("Tid") = ClassID
Rs("Keywords") = Key
Rs("TitleType") = ""
Rs("Title") = Title
Rs("ShowComment") = ShowComment
Rs("TitleFontColor") = ""
Rs("TitleFontType") = ""
Rs("Subtitle") = ""
Rs("ArticleContent") = Content
Rs("Author") = Author
Rs("Origin") = CopyFrom
Rs("Editor") = Editor
Rs("Rank") = Stars '阅读星级
Rs("Hits") = Hits
Rs("AddDate") = UpDateTime '更新时间
Rs("SpecialID") = SpecialID
Rs("JSID") = ""
Rs("TemplateID") = TemplateID '模板
Rs("ArticleFsoType") = ArticleFsoType
Rs("Fname") = KSCMS.GetFileName(ArticleFsoType, UpDateTime, FnameType)
'rs("PicNews")=IncludePic '图片文章
Rs("ArticleInput") = Inputer
Rs("PicNews") = 0
Rs("Changes") = 0
Rs("Recommend") = Recommend
Rs("Rolls") = Rolls
Rs("strip") = Strip
Rs("Popular") = Popular
Rs("Verific") = Verific '审核与否
Rs("Slide") = 0
Rs("BeyondSavePic") = BeyondSavePic
Rs("Comment") = Comment
Rs("OrderID") = 1
Rs.Update
End If
Rs.Close
Set Rs = Nothing
End Sub
'==================================================
'过程名：Filters
'作 用：过滤
'==================================================
Sub Filters()
If IsNull(Arr_Filters) = True Or IsArray(Arr_Filters) = False Then
Exit Sub
End If
For Filteri = 0 To UBound(Arr_Filters, 2)
FilterStr = ""
If Arr_Filters(1, Filteri) = ItemID Or Arr_Filters(10, Filteri) = True Then
If Arr_Filters(3, Filteri) = 1 Then '标题过滤
If Arr_Filters(4, Filteri) = 1 Then
Title = Replace(Title, Arr_Filters(5, Filteri), Arr_Filters(8, Filteri))
ElseIf Arr_Filters(4, Filteri) = 2 Then
FilterStr = KMCObj.GetBody(Title, Arr_Filters(6, Filteri), Arr_Filters(7, Filteri), True, True)
Do While FilterStr <> "Error"
Title = Replace(Title, FilterStr, Arr_Filters(8, Filteri))
FilterStr = KMCObj.GetBody(Title, Arr_Filters(6, Filteri), Arr_Filters(7, Filteri), True, True)
Loop
End If
ElseIf Arr_Filters(3, Filteri) = 2 Then '正文过滤
If Arr_Filters(4, Filteri) = 1 Then
Content = Replace(Content, Arr_Filters(5, Filteri), Arr_Filters(8, Filteri))
ElseIf Arr_Filters(4, Filteri) = 2 Then
FilterStr = KMCObj.GetBody(Content, Arr_Filters(6, Filteri), Arr_Filters(7, Filteri), True, True)
Do While FilterStr <> "Error"
Content = Replace(Content, FilterStr, Arr_Filters(8, Filteri))
FilterStr = KMCObj.GetBody(Content, Arr_Filters(6, Filteri), Arr_Filters(7, Filteri), True, True)
Loop
End If
End If
End If
Next
End Sub
'==================================================
'过程名：FilterScript
'作 用：脚本过滤
'==================================================
Sub FilterScript()
If Script_Iframe = True Then
Content = KMCObj.ScriptHtml(Content, "Iframe", 1)
End If
If Script_Object = True Then
Content = KMCObj.ScriptHtml(Content, "Object", 2)
End If
If Script_Script = True Then
Content = KMCObj.ScriptHtml(Content, "Script", 2)
End If
If Script_Div = True Then
Content = KMCObj.ScriptHtml(Content, "Div", 3)
End If
If Script_Table = True Then
Content = KMCObj.ScriptHtml(Content, "table", 3)
End If
If Script_Tr = True Then
Content = KMCObj.ScriptHtml(Content, "tr", 3)
End If
If Script_Td = True Then
Content = KMCObj.ScriptHtml(Content, "td", 3)
End If
If Script_Span = True Then
Content = KMCObj.ScriptHtml(Content, "Span", 3)
End If
If Script_Img = True Then
Content = KMCObj.ScriptHtml(Content, "Img", 3)
End If
If Script_Font = True Then
Content = KMCObj.ScriptHtml(Content, "Font", 3)
End If
If Script_A = True Then
Content = KMCObj.ScriptHtml(Content, "A", 3)
End If
If Script_Html = True Then
Content = KMCObj.nohtml(Content)
End If
End Sub
'==================================================
'过程名：TopItem
'作 用：显示导航信息
'参 数：无
'==================================================
Sub TopItem()
Response.Write "<html>"
Response.Write "<head>"
Response.Write "<title>采集系统</title>"
Response.Write "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">"
Response.Write "<link rel=""stylesheet"" type=""text/css"" href=""../inc/Admin_Style.css"">"
Response.Write "</head>"
Response.Write "<body leftmargin=""0"" topmargin=""0"" marginwidth=""0"" marginheight=""0"">"
Response.Write "<table width=""100%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""1"" class=""sortbutton"">"
Response.Write " <tr>"
Response.Write " <td height=""22"" colspan=""2"" align=""center""><STRONG>采 集 系 统 采 集 管 理</STRONG></td>"
Response.Write " </tr>"
Response.Write "</table>"
End Sub
Sub TopItem2()
Response.Write "<br>"
Response.Write "<table width=""100%"" height=""20"" border=""0"" cellpadding=""0"" cellspacing=""0"">"
Response.Write " <tr>"
Response.Write " <td width=""50%;"" align=""right""><span style=""color:red;""><strong><font id=""CollectEndArea"">系统正在采集</font></strong></span></td>"
Response.Write " <td width=""50%;"" valign=""top""> <span style=""color:red;""><strong><font id=""ShowInfoArea""> </font></strong></span></td>"
Response.Write " </tr>"
Response.Write "</table>"
Response.Write "<table width=""98%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""1"">"
Response.Write " <tr>"
Response.Write " <td height=""45"" colspan=""2"" aling=""left"">本次运行：" & UBound(Arr_Item, 2) + 1 & " 个项目,正在采集第 <font color=red>" & ItemNum & "</font> 个项目 <font color=red>" & ItemName & "</font> 的第 <font color=red>" & ListNum & "</font> 页列表,该列表待采集文章 <font color=red>" & UBound(NewsArray) + 1 & "</font> 篇。"
If CollecNewsNum <> 0 Then Response.Write "限制 <font color=red>" & CollecNewsNum & "</font> 篇。"
Response.Write " <br>采集统计：成功采集--" & NewsSuccesNum & " 篇文章，失败--" & NewsFalseNum & " 篇，图片--" & ImagesNumAll & " 张。<a href=""Collect_ItemStart.asp"">停止采集</a>"
Response.Write " </td>"
Response.Write " </tr>"
Response.Write "</table>"
Response.Write "<script language=""JavaScript"">"
Response.Write "var ForwardShow=true;"
Response.Write "function ShowPromptInfo()"
Response.Write "{"
Response.Write " var TempStr=document.all.ShowInfoArea.innerText;"
Response.Write " if (ForwardShow==true)"
Response.Write " {"
Response.Write " if (TempStr.length>4) ForwardShow=false;"
Response.Write " document.all.ShowInfoArea.innerText=TempStr+'.';"
Response.Write " }"
Response.Write " else"
Response.Write " {"
Response.Write " if (TempStr.length==2) ForwardShow=true;"
Response.Write " document.all.ShowInfoArea.innerText=TempStr.substr(0,TempStr.length-1);"
Response.Write " }"
Response.Write "}"
Response.Write "window.setInterval('ShowPromptInfo()',200);</script>"
StartTime = Timer()
End Sub
'==================================================
'过程名：FootItem2
'作 用：显示该列表采集时间等信息
'参 数：无
'==================================================
Sub FootItem2()
Dim strTemp
OverTime = Timer()
strTemp = "<table width=""90%"" border=""0"" align=""center"" cellpadding=""2"" cellspacing=""1"">"
strTemp = strTemp & "<tr>"
strTemp = strTemp & "<td height=""22"" colspan=""2"" align=""left"">"
strTemp = strTemp & "执行时间：" & CStr(FormatNumber((OverTime - StartTime) * 1000, 2)) & " 毫秒"
strTemp = strTemp & "</td></tr><br>"
strTemp = strTemp & "</table>"
Response.Write strTemp
End Sub
'==================================================
'过程名：ShowMsg
'作 用：显示信息
'参 数：无
'==================================================
Sub ShowMsg(Msg)
Dim strTemp
strTemp = "<table width=""90%"" border=""0"" bgcolor=""#efefef"" align=""center"" cellpadding=""2"" cellspacing=""1"">"
strTemp = strTemp & " <tr>"
strTemp = strTemp & " <td height=""22"" colspan=""2"" bgcolor=""#ffffff"" align=""left"">"
strTemp = strTemp & Msg
strTemp = strTemp & " </td>"
strTemp = strTemp & " </tr><br>"
strTemp = strTemp & "</table>"
Response.Write strTemp
End Sub
Function CheckRepeat(strUrl)
CheckRepeat = False
If IsArray(Arr_Historys) = True Then
For His_i = 0 To UBound(Arr_Historys, 2)
If Arr_Historys(0, His_i) = strUrl Then
CheckRepeat = True
His_Title = Arr_Historys(1, His_i)
His_CollecDate = Arr_Historys(2, His_i)
His_Result = Arr_Historys(3, His_i)
Exit For
End If
Next
End If
End Function
Sub SetCache_His()
'历史记录
SqlItem = "select NewsUrl,Title,CollecDate,Result From KS_History"
Set RsItem = Server.CreateObject("adodb.recordset")
RsItem.Open SqlItem, ConnItem, 1, 1
If Not RsItem.EOF Then
Arr_Historys = RsItem.GetRows()
End If
RsItem.Close
Set RsItem = Nothing
Dim myCache
Set myCache = New ClsCache
myCache.name = CacheTemp & "Historys"
Call myCache.clean
If IsArray(Arr_Historys) = True Then
myCache.add Arr_Historys, DateAdd("n", 1000, Now)
End If
End Sub
End Class
%>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -