📄 admin_itemcollecfast.asp
字号:
If DateType=0 then
UpDateTime=Now()
Else
UpDateTime=GetBody(NewsCode,DsString,DoString,False,False)
UpDateTime=FpHtmlEncode(UpDateTime)
UpDateTime=Trim(Replace(UpDateTime," "," "))
If IsDate(UpDateTime)=True Then
UpDateTime=CDate(UpDateTime)
Else
UpDateTime=Now()
End If
End If
ElseIf UpDateType=2 Then
Else
UpDateTime=Now()
End If
'作者
If AuthorType=1 Then
Author=GetBody(NewsCode,AsString,AoString,False,False)
ElseIf AuthorType=2 Then
Author=AuthorStr
Else
Author="佚名"
End If
Author=FpHtmlEncode(Author)
If Author="" or Author="$False$" then
Author="佚名"
Else
If Len(Author)>255 then
Author=Left(Author,255)
End If
End If
'来源
If CopyFromType=1 Then
CopyFrom=GetBody(NewsCode,FsString,FoString,False,False)
ElseIf CopyFromType=2 Then
CopyFrom=CopyFromStr
Else
CopyFrom="不详"
End If
CopyFrom=FpHtmlEncode(CopyFrom)
If CopyFrom="" or CopyFrom="$False$" Then
CopyFrom="不详"
Else
If Len(CopyFrom)>255 Then
CopyFrom=Left(CopyFrom,255)
End If
End If
'关键字
If KeyType=0 Then
Key=Title
Key=CreateKeyWord(Key,2)
ElseIf KeyType=1 Then
Key=GetBody(NewsCode,KsString,KoString,False,False)
Key=FpHtmlEncode(Key)
Key=CreateKeyWord(Key,2)
ElseIf KeyType=2 Then
Key=KeyStr
Key=FpHtmlEncode(Key)
If Len(Key)>253 Then
Key="|" & Left(Key,253) & "|"
Else
Key="|" & Key & "|"
End If
End If
If Key="" or Key="$False$" Then
Key="|新闻|"
End If
'转换图片相对地址为绝对地址/保存
If CollecTest=False And SaveFiles=True then
Content=ReplaceSaveRemoteFile(Content,strInstallDir,strChannelDir,True,NewsUrl)
Else
Content=ReplaceSaveRemoteFile(Content,strInstallDir,strChannelDir,False,NewsUrl)
End If
'转换swf文件地址
Content=ReplaceSwfFile(Content,NewsUrl)
'图片统计、文章图片属性设置
If UploadFiles<>"" Then
If Instr(UploadFiles,"|")>0 Then
Arr_Images=Split(UploadFiles,"|")
ImagesNum=Ubound(Arr_Images)+1
DefaultPicUrl=Arr_Images(0)
Else
ImagesNum=1
DefaultPicUrl=UploadFiles
End If
If DefaultPicYn=False then
DefaultPicUrl=""
End If
If IncludePicYn=True Then
IncludePic=-1
Else
IncludePic=0
End If
If SaveFiles<>True Then
UploadFiles=""
End If
Else
ImagesNum=0
DefaultPicUrl=""
IncludePic=0
End If
ImagesNumAll=ImagesNumAll+ImagesNum
End If
If FoundErr<>True Then
If CollecTest=False Then
Call SaveArticle
SqlItem="INSERT INTO Histroly(ItemID,ChannelID,ClassID,SpecialID,ArticleID,Title,CollecDate,NewsUrl,Result) VALUES ('" & ItemID & "','" & ChannelID & "','" & ClassID & "','" & SpecialID & "','" & ArticleID & "','" & Title & "','" & Now() & "','" & NewsUrl & "',True)"
ConnItem.Execute(SqlItem)
Content=Replace(Content,"[InstallDir_ChannelDir]",strInstallDir & strChannelDir & "/")
End If
NewsSuccesNum=NewsSuccesNum+1
ErrMsg=ErrMsg & "No:<font color=red>" & NewsSuccesNum+NewsFalseNum & "</font><br>"
ErrMsg=ErrMsg & "新闻标题："
ErrMsg=ErrMsg & "<font color=red>" & Title & "</font><br>"
ErrMsg=ErrMsg & "更新时间：" & UpDateTime & "<br>"
ErrMsg=ErrMsg & "新闻作者：" & Author & "<br>"
ErrMsg=ErrMsg & "新闻来源：" & CopyFrom & "<br>"
ErrMsg=ErrMsg & "采集页面：<a href=" & NewsUrl & " target=_blank>" & NewsUrl & "</a><br>"
ErrMsg=ErrMsg & "其它信息：分页--" & PaingNum & " 页，图片--" & ImagesNum & " 张<br>"
ErrMsg=ErrMsg & "正文预览："
If Content_View=True Then
ErrMsg=ErrMsg & "<br>" & Content
Else
ErrMsg=ErrMsg & "您没有启用正文预览功能"
End If
ErrMsg=ErrMsg & "<br><br>关 键 字：" & Key & ""
Else
NewsFalseNum=NewsFalseNum+1
If His_Repeat=True Then
ErrMsg=ErrMsg & "No:<font color=red>" & NewsSuccesNum+NewsFalseNum & "</font><br>"
ErrMsg=ErrMsg & "目标新闻：<font color=red>"
If His_Result=True Then
ErrMsg=ErrMsg & His_Title
Else
ErrMsg=ErrMsg & NewsUrl
End If
ErrMsg=ErrMsg & "</font> 的记录已存在，不给予采集。<br>"
ErrMsg=ErrMsg & "采集时间：" & His_CollecDate & "<br>"
ErrMsg=ErrMsg & "新闻来源：<a href='" & NewsUrl & "' target=_blank>"&NewsUrl&"</a><br>"
ErrMsg=ErrMsg & "采集结果："
If His_Result=False Then
ErrMsg=ErrMsg & "失败"
ErrMsg=ErrMsg & "<br>失败原因：" & Title
Else
ErrMsg=ErrMsg & "成功"
End If
ErrMsg=ErrMsg & "<br>提示信息：如想再次采集，请先将该新闻的历史记录<font color=red>删除</font><br>"
End If
If CollecTest=False And His_Repeat=False Then
SqlItem="INSERT INTO Histroly(ItemID,ChannelID,ClassID,SpecialID,Title,CollecDate,NewsUrl,Result) VALUES ('" & ItemID & "','" & ChannelID & "','" & ClassID & "','" & SpecialID & "','" & Title & "','" & Now() & "','" & NewsUrl & "',False)"
ConnItem.Execute(SqlItem)
End If
End If
Call ShowMsg(ErrMsg)
Response.Flush()'刷新
Next
Else
Call ShowMsg(ErrMsg)
End If
Response.Write "<table width=""100%"" border=""0"" align=""center"" cellpadding=""2"" cellspacing=""1"">"
Response.Write "<tr>"
Response.write "<td height=""22"" colspan=""2"" align=""left"" class=""tdbg"">"
If CollecTest=False Then
Response.Write "数据整理中，5秒后继续......5秒后如果还没反应请点击 <a href='Admin_ItemCollecFast.asp?ItemNum=" & ItemNum & "&ListNum=" & ListNum+1 & "&NewsSuccesNum=" & NewsSuccesNum & "&NewsFalseNum=" & NewsFalseNum & "&ImagesNumAll=" & ImagesNumAll & "&ListPaingNext=" & ListPaingNext & "'><font color=red>这里</font></a> 继续<br>"
Response.Write "<meta http-equiv=""refresh"" content=""5;url=Admin_ItemCollecFast.asp?ItemNum=" & ItemNum & "&ListNum=" & ListNum+1 & "&NewsSuccesNum=" & NewsSuccesNum & "&NewsFalseNum=" & NewsFalseNum & "&ImagesNumAll=" & ImagesNumAll & "&ListPaingNext=" & ListPaingNext & """>"
Else
Response.Write "<a href='Admin_ItemCollecFast.asp?ItemNum=" & ItemNum & "&ListNum=" & ListNum+1 & "&NewsSuccesNum=" & NewsSuccesNum & "&NewsFalseNum=" & NewsFalseNum & "&ImagesNumAll=" & ImagesNumAll & "&ListPaingNext=" & ListPaingNext & "'><font color=red>请 继 续</font></a>"
End If
Response.Write "</td></tr>"
Response.Write "</table>"
End Sub
'==================================================
'过程名：SetCache
'作 用：存取缓存
'参 数：无
'==================================================
Sub SetCache()
Dim myCache
Set myCache=new clsCache
'项目信息
myCache.name=CacheTemp & "items"
If myCache.valid then
Arr_Item=myCache.value
Else
ItemEnd=True
End If
'过滤信息
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
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()
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) '专题
LoginType=Arr_Item(9,ItemNumTemp)
LoginUrl=Arr_Item(10,ItemNumTemp) '登录
LoginPostUrl=Arr_Item(11,ItemNumTemp)
LoginUser=Arr_Item(12,ItemNumTemp)
LoginPass=Arr_Item(13,ItemNumTemp)
LoginFalse=Arr_Item(14,ItemNumTemp)
ListStr=Arr_Item(15,ItemNumTemp) '列表地址
LsString=Arr_Item(16,ItemNumTemp) '列表
LoString=Arr_Item(17,ItemNumTemp)
ListPaingType=Arr_Item(18,ItemNumTemp)
LPsString=Arr_Item(19,ItemNumTemp)
LPoString=Arr_Item(20,ItemNumTemp)
ListPaingStr1=Arr_Item(21,ItemNumTemp)
ListPaingStr2=Arr_Item(22,ItemNumTemp)
ListPaingID1=Arr_Item(23,ItemNumTemp)
ListPaingID2=Arr_Item(24,ItemNumTemp)
ListPaingStr3=Arr_Item(25,ItemNumTemp)
HsString=Arr_Item(26,ItemNumTemp)
HoString=Arr_Item(27,ItemNumTemp)
HttpUrlType=Arr_Item(28,ItemNumTemp)
HttpUrlStr=Arr_Item(29,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)
CollecListNum=Arr_Item(80,ItemNumTemp)
CollecNewsNum=Arr_Item(81,ItemNumTemp)
Passed=Arr_Item(82,ItemNumTemp)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -