📄 admin_itemcollecnews.asp
字号:
'过滤信息
myCache.name=CacheTemp & "filters"
If myCache.valid then
Arr_Filters=myCache.value
End If
'历史记录
myCache.name=CacheTemp & "histrolys"
If myCache.valid then
Arr_Histrolys=myCache.value
End If
'其它信息
myCache.name=CacheTemp & "collectest"
If myCache.valid then
CollecTest=myCache.value
Else
CollecTest=False
End If
myCache.name=CacheTemp & "contentview"
If myCache.valid then
Content_View=myCache.value
Else
Content_View=False
End If
Set myCache=Nothing
End Sub
'==================================================
'过程名：GetNews
'作 用：获取变量
'参 数：无
'==================================================
Sub GetNews()
Dim myCache
Set myCache=new clsCache
'新闻信息
myCache.name=CacheTemp & "news"
If myCache.valid then
Arr_News=myCache.value
End If
If IsArray(Arr_News)=False Then
NewsEnd=True
End If
Set myCache=Nothing
End Sub
Sub DelCache()
Dim myCache
Set myCache=new clsCache
myCache.name=CacheTemp & "items"
Call myCache.clean()
myCache.name=CacheTemp & "filters"
Call myCache.clean()
myCache.name=CacheTemp & "histrolys"
Call myCache.clean()
myCache.name=CacheTemp & "collectest"
Call myCache.clean()
myCache.name=CacheTemp & "contentview"
Call myCache.clean()
myCache.name=CacheTemp & "news"
Call myCache.clean()
Set myCache=Nothing
End Sub
'==================================================
'过程名：SetItems
'作 用：获取项目信息
'参 数：无
'==================================================
Sub SetItems()
Dim ItemNumTemp
ItemNumTemp=ItemNum-1
ItemID=Arr_Item(0,ItemNumTemp)
ItemName=Arr_Item(1,ItemNumTemp)
ChannelID=Arr_Item(2,ItemNumTemp)'频道ID
strChannelDir=Arr_Item(3,ItemNumTemp)'频道目录
ClassID=Arr_Item(4,ItemNumTemp) '栏目
SpecialID=Arr_Item(5,ItemNumTemp) '专题
TsString=Arr_Item(30,ItemNumTemp) '标题
ToString=Arr_Item(31,ItemNumTemp)
CsString=Arr_Item(32,ItemNumTemp) '正文
CoString=Arr_Item(33,ItemNumTemp)
DateType=Arr_Item(34,ItemNumTemp) '作者
DsString=Arr_Item(35,ItemNumTemp)
DoString=Arr_Item(36,ItemNumTemp)
AuthorType=Arr_Item(37,ItemNumTemp) '作者
AsString=Arr_Item(38,ItemNumTemp)
AoString=Arr_Item(39,ItemNumTemp)
AuthorStr=Arr_Item(40,ItemNumTemp)
CopyFromType=Arr_Item(41,ItemNumTemp) '来源
FsString=Arr_Item(42,ItemNumTemp)
FoString=Arr_Item(43,ItemNumTemp)
CopyFromStr=Arr_Item(44,ItemNumTemp)
KeyType=Arr_Item(45,ItemNumTemp) '关键词
KsString=Arr_Item(46,ItemNumTemp)
KoString=Arr_Item(47,ItemNumTemp)
KeyStr=Arr_Item(48,ItemNumTemp)
NewsPaingType=Arr_Item(49,ItemNumTemp) '关键词
NPsString=Arr_Item(50,ItemNumTemp)
NPoString=Arr_Item(51,ItemNumTemp)
NewsPaingStr=Arr_Item(52,ItemNumTemp)
NewsPaingHtml=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)
IncludePicYn=Arr_Item(63,ItemNumTemp)
DefaultPicYn=Arr_Item(64,ItemNumTemp)
OnTop=Arr_Item(65,ItemNumTemp)
Elite=Arr_Item(66,ItemNumTemp)
Hot=Arr_Item(67,ItemNumTemp)
SkinID=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)
CollecNewsNum=Arr_Item(81,ItemNumTemp)
Passed=Arr_Item(82,ItemNumTemp)
SaveFiles=Arr_Item(83,ItemNumTemp)
CollecOrder=Arr_Item(84,ItemNumTemp)
LinkUrlYn=Arr_Item(85,ItemNumTemp)
InputerType=Arr_Item(86,ItemNumTemp)
Inputer=Arr_Item(87,ItemNumTemp)
EditorType=Arr_Item(88,ItemNumTemp)
Editor=Arr_Item(89,ItemNumTemp)
ShowCommentLink=Arr_Item(90,ItemNumTemp)
If InputerType=1 Then
Inputer=FpHtmlEnCode(Inputer)
Else
Inputer=session("AdminName")
End If
If EditorType=1 Then
Editor=FpHtmlEnCode(Editor)
Else
Editor=session("AdminName")
End If
If IsObjInstalled("Scripting.FileSystemObject")=False or strChannelDir="" Then
SaveFiles=False
End if
End Sub
Sub SetNews()
SqlItem ="select NewsUrl from NewsList where ItemID=" & ItemID
Set RsItem=Server.CreateObject("adodb.recordset")
RsItem.Open SqlItem,ConnItem,1,1
If Not RsItem.Eof Then
Arr_News=RsItem.GetRows()
End If
RsItem.Close
Set RsItem=Nothing
Dim myCache
Set myCache=new clsCache
myCache.name=CacheTemp & "news"
Call myCache.clean()
If IsArray(Arr_News)=True Then
myCache.add Arr_News,Dateadd("n",1000,now)
Else
NewsEnd=True
End If
Set myCache=Nothing
End Sub
Sub SetHistroly()
Dim myCache
Set myCache=new clsCache
'历史记录
SqlItem ="select NewsUrl,Title,CollecDate,Result from Histroly"
Set RsItem=Server.CreateObject("adodb.recordset")
RsItem.Open SqlItem,ConnItem,1,1
If Not RsItem.Eof Then
Arr_Histrolys=RsItem.GetRows()
myCache.name=CacheTemp & "histrolys"
Call myCache.clean()
myCache.add Arr_Histrolys,Dateadd("n",1000,now)
End If
RsItem.Close
Set RsItem=Nothing
Set myCache=Nothing
End Sub
'==================================================
'过程名：SaveArticle
'作 用：保存文章
'参 数：无
'==================================================
Sub SaveArticle
If ArticleID=0 Then
set rs=server.createobject("adodb.recordset")
sql="select top 1 ArticleID from PE_Article order by ArticleID desc"
rs.open sql,conn,1,1
If rs.eof and rs.bof then
ArticleID=1
Else
ArticleID=rs("ArticleID")+1
End If
rs.close
set rs=nothing
Else
ArticleID=ArticleID+1
End If
set rs=server.createobject("adodb.recordset")
sql="select top 1 * from PE_Article"
rs.open sql,conn,1,3
rs.addnew
rs("ArticleID")=ArticleID
rs("ChannelID")=ChannelID
rs("ClassID")=ClassID
rs("SpecialID")=SpecialID
rs("Title")=Title
rs("TitleFontType")=0
If LinkUrlYn=False Then
rs("Content")=Content
Else
rs("Content")=""
rs("LinkUrl")=NewsUrl
End If
rs("Keyword")=Key
rs("Hits")=Hits
rs("Author")=Author
rs("CopyFrom")=CopyFrom
rs("IncludePic")=IncludePic
rs("Passed")=0
rs("OnTop")=OnTop
rs("Hot")=Hot
rs("Elite")=Elite
rs("Stars")=Stars
rs("UpdateTime")=UpDateTime
rs("PaginationType")=PaginationType
rs("MaxCharPerPage")=MaxCharPerPage
rs("ReadLevel")=ReadLevel
rs("ReadPoint")=ReadPoint
rs("SkinID")=SkinID
rs("TemplateID")=TemplateID
rs("DefaultPicUrl")=DefaultPicUrl
rs("UploadFiles")=UploadFiles
rs("ShowCommentLink")=ShowCommentLink
rs("Inputer")=Inputer
if Editor="" then Editor="五月"
rs("Editor")=Editor
rs.update
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="$False$"
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=GetBody(Title,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri),True,True)
Do While FilterStr<>"$False$"
Title=Replace(Title,FilterStr,Arr_Filters(8,Filteri))
FilterStr=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=GetBody(Content,Arr_Filters(6,Filteri),Arr_Filters(7,Filteri),True,True)
Do While FilterStr<>"$False$"
Content=Replace(Content,FilterStr,Arr_Filters(8,Filteri))
FilterStr=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=ScriptHtml(Content,"Iframe",1)
End If
If Script_Object=True Then
Content=ScriptHtml(Content,"Object",2)
End If
If Script_Script=True Then
Content=ScriptHtml(Content,"Script",2)
End If
If Script_Div=True Then
Content=ScriptHtml(Content,"Div",3)
End If
If Script_Span=True Then
Content=ScriptHtml(Content,"Span",3)
End If
If Script_Img=True Then
Content=ScriptHtml(Content,"Img",3)
End If
If Script_Font=True Then
Content=ScriptHtml(Content,"Font",3)
End If
If Script_A=True Then
Content=ScriptHtml(Content,"A",3)
End If
If Script_Html=True Then
Content=noHtml(Content)
End If
End Sub
'==================================================
'过程名：TopItem
'作 用：显示导航信息
'参 数：无
'==================================================
Sub TopItem()%>
<html>
<head>
<title>新闻采集系统</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link rel="stylesheet" type="text/css" href="Admin_Style.css">
</head>
<body leftmargin="0" topmargin="0" marginwidth="0" marginheight="0">
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border">
<tr>
<td height="22" colspan="2" align="center" class="topbg"><strong>采 集 系 统 采 集 管 理</strong></td>
</tr>
</table>
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border">
<tr class="tdbg">
<td width="65" height="30"><strong>管理导航：</strong></td>
<td height="30"><a href="Admin_ItemStart.asp">管理首页</a> >> 新闻采集</td>
</tr>
</table>
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border">
<tr>
<td height="22" colspan="2" class="tdbg" aling="center">采集需要一定的时间，请耐心等待，如果网站出现暂时无法访问的情况这是正常的，采集正常结束后即可恢复。
</td>
</tr>
</table>
<%End Sub%>
<%
Sub TopItem2%>
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border">
<tr>
<td height="22" colspan="2" class="tdbg" aling="left">本次运行：<%=Ubound(Arr_Item,2)+1%> 个项目，正在采集第 <font color=red><%= ItemNum%></font> 个项目 <font color=red><%=ItemName%></font> 的第 <font color=red><%=NewsNum%></font> 条，该项目新闻 <%=Ubound(Arr_News,2)+1%> 条，全部新闻 <%=NewsNumAll%> 条。
<br>采集统计：成功采集--<%=NewsSuccesNum%> 条，失败--<%=NewsFalseNum%> 条，图片--<%=ImagesNumAll%> 张。<a href="Admin_ItemStart.asp"><font color=red>停止采集</font></a>
</td>
</tr>
</table>
<%StartTime=Timer()%>
<%End Sub%>
<%
Sub FootItem()%>
<!--#include file="Admin_ItemFoot.asp"-->
</body>
</html>
<%End Sub%>
<%
Sub FootItem2()
Dim strTemp
OverTime=Timer()
strTemp= "<table width=""100%"" border=""0"" align=""center"" cellpadding=""2"" cellspacing=""1"">"
strTemp=strTemp & "<tr>"
strTemp=strTemp & "<td height=""22"" colspan=""2"" align=""left"" class=""tdbg"">"
strTemp=strTemp & "执行时间：" & CStr(FormatNumber((OverTime-StartTime)*1000,2)) & " 毫秒"
strTemp=strTemp & "</td></tr><br>"
strTemp=strTemp & "</table>"
Response.write strTemp
End Sub
Sub ShowMsg(Msg)
Dim strTemp
strTemp= "<table width=""100%"" border=""0"" align=""center"" cellpadding=""2"" cellspacing=""1"">"
strTemp=strTemp & " <tr class='tdbg'>"
strTemp=strTemp & " <td height=""22"" colspan=""2"" 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_Histrolys)=True then
For His_i=0 to Ubound(Arr_Histrolys,2)
If Arr_Histrolys(0,His_i)=strUrl Then
CheckRepeat=True
His_Title=Arr_Histrolys(1,His_i)
His_CollecDate=Arr_Histrolys(2,His_i)
His_Result=Arr_Histrolys(3,His_i)
Exit For
End If
Next
End If
End Function
%>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -