📄 collect_collectstable.asp
字号:
UpDateTime = Now()
End If
'作者
If AuthorType = 1 Then
Author = KMCObj.GetBody(NewsCode, AsString, AoString, False, False)
ElseIf AuthorType = 2 Then
Author = AuthorStr
Else
Author = "佚名"
End If
Author = KMCObj.FpHtmlEnCode(Author)
If Author = "" Or Author = "Error" Then
Author = "佚名"
Else
If Len(Author) > 255 Then
Author = Left(Author, 255)
End If
End If
'来源
If CopyFromType = 1 Then
CopyFrom = KMCObj.GetBody(NewsCode, FsString, FoString, False, False)
ElseIf CopyFromType = 2 Then
CopyFrom = CopyFromStr
Else
CopyFrom = "不详"
End If
CopyFrom = KMCObj.FpHtmlEnCode(CopyFrom)
If CopyFrom = "" Or CopyFrom = "Error" Then
CopyFrom = "不详"
Else
If Len(CopyFrom) > 255 Then
CopyFrom = Left(CopyFrom, 255)
End If
End If
'关键字
If KeyType = 0 Then
Key = Title
Key = KMCObj.CreateKeyWord(Key, 2)
ElseIf KeyType = 1 Then
Key = KMCObj.GetBody(NewsCode, KsString, KoString, False, False)
Key = KMCObj.FpHtmlEnCode(Key)
Key = KMCObj.CreateKeyWord(Key)
ElseIf KeyType = 2 Then
Key = KeyStr
Key = KMCObj.FpHtmlEnCode(Key)
If Len(Key) > 253 Then
Key = "|" & Left(Key, 253) & "|"
Else
Key = "|" & Key & "|"
End If
End If
If Key = "" Or Key = "Error" Then
Key = ""
End If
End If
If FoundErr <> True Then
'转换图片相对地址为绝对地址/保存
If CollecTest = False And BeyondSavePic = 1 Then
Content = KMCObj.ReplaceSaveRemoteFile(UploadFiles, Content, strInstallDir, strChannelDir, True, NewsUrl)
Else
Content = KMCObj.ReplaceSaveRemoteFile(UploadFiles, Content, strInstallDir, strChannelDir, False, NewsUrl)
End If
'转换swf文件地址
Content = KMCObj.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 BeyondSavePic <> 1 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 KS_History(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 & "其它信息：分页--" & PageNum & " 页，图片--" & 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 KS_History(ItemID,ChannelID,ClassID,SpecialID,Title,CollecDate,NewsUrl,Result) VALUES ('" & ItemID & "','" & ChannelID & "','" & ClassID & "','" & SpecialID & "','" & Title & "','" & Now() & "','" & NewsUrl & "',False)"
ConnItem.Execute (SqlItem)
End If
End If
ErrMsg = ErrMsg & "<table width=""90%"" border=""0"" align=""center"" cellpadding=""2"" cellspacing=""1"">"
ErrMsg = ErrMsg & "<tr>"
ErrMsg = ErrMsg & "<td height=""22"" colspan=""2"" align=""left"">"
ErrMsg = ErrMsg & "数据整理中，3秒后继续......3秒后如果还没反应请点击 <a href='Collect_CollectStable.asp?ItemNum=" & ItemNum & "&NewsNum=" & NewsNum + 1 & "&NewsSuccesNum=" & NewsSuccesNum & "&NewsFalseNum=" & NewsFalseNum & "&ImagesNumAll=" & ImagesNumAll & "&ArticleID=" & ArticleID & "&NewsNumAll=" & NewsNumAll & "'><font color=red>这里</font></a> 继续<br>"
ErrMsg = ErrMsg & "<meta http-equiv=""refresh"" content=""3;url=Collect_CollectStable.asp?ItemNum=" & ItemNum & "&NewsNum=" & NewsNum + 1 & "&NewsSuccesNum=" & NewsSuccesNum & "&NewsFalseNum=" & NewsFalseNum & "&ImagesNumAll=" & ImagesNumAll & "&ArticleID=" & ArticleID & "&NewsNumAll=" & NewsNumAll & """>"
ErrMsg = ErrMsg & "</td></tr>"
ErrMsg = ErrMsg & "</table>"
Call ShowMsg(ErrMsg)
Response.Flush '刷新
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
ErrMsg = "<br><li>参数错误，请重新运行！</li>"
End If
'过滤信息
myCache.name = CacheTemp & "filters"
If myCache.valid Then
Arr_Filters = myCache.value
End If
'历史记录
myCache.name = CacheTemp & "Historys"
If myCache.valid Then
Arr_Historys = 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 & "Historys"
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) '专题
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)
ListPageType = Arr_Item(18, ItemNumTemp)
LPsString = Arr_Item(19, ItemNumTemp)
LPoString = Arr_Item(20, ItemNumTemp)
ListPageStr1 = Arr_Item(21, ItemNumTemp)
ListPageStr2 = Arr_Item(22, ItemNumTemp)
ListPageID1 = Arr_Item(23, ItemNumTemp)
ListPageID2 = Arr_Item(24, ItemNumTemp)
ListPageStr3 = 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)
NewsPageType = Arr_Item(49, ItemNumTemp) '关键词
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)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -