📄 collect_collectstable.asp
字号:
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%option explicit%>
<!--#include file="../../Conn.asp"-->
<!--#include file="../../SysCls/KS_CommonCls.asp"-->
<!--#include file="../../SysCls/KS_CollectCommonCls.asp"-->
<!--#include file="../Inc/Session.asp"-->
<%
'===================================================================================================================
'软件名称：科汛网站管理系统
'当前版本：科汛网站管理系统 V2.2 0628个人Access版
'Copyright (C) 2006-2008 Kesion.Com All rights reserved.
'产品咨询QQ：9537636,41904294
'技术支持QQ：111394,54004407
'程序版权：科汛网络
'程序开发：科汛网络开发组（总策划：林文仲）
'E-Mail :kesioncms@hotmail.com webmaster@kesion.com
'官方网站：http://www.kesion.com
'演示站点：http://test.kesion.com
'郑重声明:
' ①、免费版本请在程序首页保留版权信息，并做上本站LOGO友情连接,商业版本无此要求;
' ②、任何个人或组织不得在授权允许的情况下删除、修改、拷贝本软件及其他副本上一切关于版权的信息；
' ③、科汛网络保留此软件的法律追究权利
'===================================================================================================================
Response.Buffer = True
Server.ScriptTimeout = 999
Response.Expires = -1
Response.ExpiresAbsolute = Now() - 1
Response.Expires = 0
Response.CacheControl = "no-cache"
Dim KSCls
Set KSCls = New Collect_ItemCollecStable
KSCls.Execute()
Set KSCls = Nothing
Class Collect_ItemCollecStable
Private KSCMS
Private KMCObj
Private ConnItem
Private ItemNum, ListNum, PageNum, NewsSuccesNum, NewsFalseNum
Private Rs, Sql, RsItem, SqlItem, FoundErr, ErrMsg, ItemEnd, ListEnd
'项目变量
Private ItemID, ItemName, ChannelID, strChannelDir, ClassID, SpecialID, LoginType, LoginUrl, LoginPostUrl, LoginUser, LoginPass, LoginFalse
Private ListStr, LsString, LoString, ListPageType, LPsString, LPoString, ListPageStr1, ListPageStr2, ListPageID1, ListPageID2, ListPageStr3, HsString, HoString, HttpUrlType, HttpUrlStr
Private TsString, ToString, CsString, CoString, DateType, DsString, DoString, AuthorType, AsString, AoString, AuthorStr, CopyFromType, FsString, FoString
Private CopyFromStr, KeyType, KsString, KoString, KeyStr, NewsPageType, NPsString, NPoString, NewsPageStr, NewsPageEnd
Private ItemCollecDate, PaginationType, MaxCharPerPage, ReadLevel, Stars, ReadPoint, Hits, UpDateType, UpDateTime, Strip, Rolls, Comment, Recommend, Popular
Private FnameType, TemplateID, Script_Iframe, Script_Object, Script_Script, Script_Div, Script_Class, Script_Span, Script_Img, Script_Font, Script_A, Script_Html, CollecListNum, CollecNewsNum, IntoBase, BeyondSavePic, CollecOrder, Verific, InputerType, Inputer, EditorType, Editor, ShowComment, Script_Table, Script_Tr, Script_Td
Private InfoPageArrayCode ,InfoPageArray,Testi,NewsNextPageStr
'过滤变量
Private Arr_Filters, FilterStr, Filteri
'采集相关的变量
Private ContentTemp, NewsPageNext, NewsPageNextCode, Arr_i, NewsUrl, NewsCode
'文章保存变量
Private ArticleID, Title, Content, Author, CopyFrom, Key, IncludePic, UploadFiles, DefaultPicUrl, NewsNum, NewsNumAll, NewsEnd, Arr_News
'其它变量
Private LoginData, LoginResult, OrderTemp
Private Arr_Item, CollecTest, Content_View, CollecNewsAll
Private StepID
'历史记录
Private Arr_Historys, His_Title, His_CollecDate, His_Result, His_Repeat, His_i
'执行时间变量
Private StartTime, OverTime
'图片统计
Private Arr_Images, ImagesNum, ImagesNumAll
Private strInstallDir, CacheTemp
Private Sub Class_Initialize()
Set KSCMS=New CommonCls
Set KMCObj=New CollectCommonCls
Set ConnItem = KSCMS.ConnItem()
End Sub
Private Sub Class_Terminate()
Call KSCMS.CloseConnItem()
Call KSCMS.Closeconn
Set KSCMS=Nothing
Set KMCObj=Nothing
End Sub
Sub Execute()
strInstallDir = Trim(Request.ServerVariables("SCRIPT_NAME"))
strInstallDir = Left(strInstallDir, InStrRev(LCase(strInstallDir), "/") - 1)
strInstallDir = Left(strInstallDir, InStrRev(LCase(strInstallDir), "/"))
CacheTemp = LCase(Trim(Request.ServerVariables("SCRIPT_NAME")))
CacheTemp = Left(CacheTemp, InStrRev(CacheTemp, "/"))
CacheTemp = Replace(CacheTemp, "\", "_")
CacheTemp = Replace(CacheTemp, "/", "_")
CacheTemp = "ansir" & CacheTemp
ItemNum = CLng(Trim(Request("ItemNum")))
NewsNum = CLng(Trim(Request("NewsNum")))
NewsSuccesNum = CLng(Trim(Request("NewsSuccesNum")))
NewsFalseNum = CLng(Trim(Request("NewsFalseNum")))
ImagesNumAll = CLng(Trim(Request("ImagesNumAll")))
NewsPageNext = Trim(Request("NewsPageNext"))
ArticleID = Trim(Request("ArticleID"))
NewsNumAll = Trim(Request("NewsNumAll"))
If ArticleID = "" Then
ArticleID = 0
Else
ArticleID = ArticleID
End If
If NewsNumAll = "" Then
NewsNumAll = 0
Else
NewsNumAll = CLng(NewsNumAll)
End If
FoundErr = False
ItemEnd = False
NewsEnd = False
Call SetCache
If ItemEnd <> True Then
If (ItemNum - 1) > UBound(Arr_Item, 2) Then
ItemEnd = True
Else
Call SetItems
End If
If ItemEnd <> True Then
If NewsNum = 1 Then
Call SetNews
Else
Call GetNews
End If
If NewsEnd <> True Then
If (NewsNum - 1) > UBound(Arr_News, 2) Then
NewsEnd = True
Else
NewsUrl = Arr_News(0, NewsNum - 1)
End If
End If
End If
End If
If ItemEnd = True Then
ErrMsg = "<br>采集任务全部完成"
ErrMsg = ErrMsg & "<br>全部文章：" & NewsNumAll & " 篇，成功采集： " & NewsSuccesNum & " 篇文章，失败： " & NewsFalseNum & " 篇，图片： " & ImagesNumAll & " 张"
Call DelCache
Else
If NewsEnd = True Then
ItemNum = ItemNum + 1
NewsNum = 1
Call SetHistory
ErrMsg = "<br>" & ItemName & " 项目所有列表采集完成，正在整理数据请稍后..."
ErrMsg = ErrMsg & "<meta http-equiv=""refresh"" content=""3;url=Collect_CollectStable.asp?ItemNum=" & ItemNum & "&NewsNum=" & NewsNum & "&NewsSuccesNum=" & NewsSuccesNum & "&NewsFalseNum=" & NewsFalseNum & "&ImagesNumAll=" & ImagesNumAll & "&NewsNumAll=" & NewsNumAll & """>"
End If
End If
Call TopItem
Response.Flush
If ItemEnd = True Or NewsEnd = True Then
Call KMCObj.WriteCollectSucced(ErrMsg)
Else
FoundErr = False
ErrMsg = ""
Call TopItem2
Response.Flush
Call StartCollection
Call FootItem2
End If
Response.Flush
'关闭数据库链接
Call KSCMS.CloseConn
End Sub
'==================================================
'过程名：StartCollection
'作 用：开始采集
'参 数：无
'==================================================
Sub StartCollection()
'变量初始化
UploadFiles = ""
DefaultPicUrl = ""
IncludePic = 0
ImagesNum = 0
NewsCode = ""
FoundErr = False
ErrMsg = ""
His_Repeat = False
Title = ""
PageNum = 1
'………………………………………………
If Response.IsClientConnected Then
Response.Flush
Else
Response.End
End If
'………………………………………………
If CollecTest = False Then
His_Repeat = CheckRepeat(NewsUrl)
Else
His_Repeat = False
End If
If His_Repeat = True Then
FoundErr = True
End If
If FoundErr <> True Then
NewsCode = KMCObj.GetHttpPage(NewsUrl)
If NewsCode = "Error" Then
FoundErr = True
ErrMsg = ErrMsg & "<br>在获取：" & NewsUrl & "文章源码时发生错误！"
Title = "分析源码错误"
End If
End If
If FoundErr <> True Then
Title = KMCObj.GetBody(NewsCode, TsString, ToString, False, False)
If Title = "Error" Or Title = "" Then
FoundErr = True
ErrMsg = ErrMsg & "<br>在分析：" & NewsUrl & "的文章标题时发生错误"
Title = "<br>标题分析错误"
End If
If FoundErr <> True Then
Content = KMCObj.GetBody(NewsCode, CsString, CoString, False, False)
If Content = "Error" Or Content = "" Then
FoundErr = True
ErrMsg = ErrMsg & "<br>在分析：" & NewsUrl & "的文章正文时发生错误"
Title = Title & "<br>正文分析错误"
End If
End If
End If
If FoundErr <> True Then
'正文分页
If NewsPageType = 1 Then
NewsPageNext = KMCObj.GetBody(NewsCode, NPsString, NPoString, False, False)
If NewsPageNext = "Error" Then '正文没有分页
Else
InfoPageArrayCode = KMCObj.GetArray(NewsPageNext, NewsPageStr, NewsPageEnd, False, False)
If InfoPageArrayCode = "Error" Then
FoundErr = True
ErrMsg = ErrMsg & "<br><li>在分析：新闻正文分页时发生错误，请检查分页链接的开始代码和结束代码！</li>"
Else
InfoPageArray = Split(InfoPageArrayCode, "$Array$")
If IsArray(InfoPageArray) = True Then
For Testi = 0 To UBound(InfoPageArray)
InfoPageArray(Testi) = KMCObj.DefiniteUrl(InfoPageArray(Testi), NewsUrl)
NewsPageNextCode = KMCObj.GetHttpPage(InfoPageArray(Testi))
ContentTemp=KMCObj.GetBody(NewsPageNextCode, CsString, CoString, False, False)
NewsNextPageStr = KMCObj.GetBody(NewsPageNextCode, NPsString, NPoString, False, False)
if NewsNextPageStr="Error" Then '载取分页字符串没成功时，改变结束标记重新载取
NewsNextPageStr=KMCObj.GetBody(ContentTemp, NPsString, CoString, False, False)
End IF
IF NewsPageNext<>"Error" Then
ContentTemp=Replace(ContentTemp,NewsNextPageStr,"") '替换分页部分
End IF
If ContentTemp = "Error" Then
Exit For
Else
PageNum = PageNum + 1
IF PaginationType=0 Then ' 不分页
Content=Content&ContentTemp
ElseIF PaginationType=1 Then '自动分页
Content=Content&ContentTemp
ElseIf PaginationType=2 Then '原文分页方式
Content = Content & "[NextPage]" & ContentTemp
End IF
End If
Next
IF PaginationType=1 Then '调用自动分页函数
Content=KMCObj.SplitNewsPage(Content,MaxCharPerPage)
End IF
Else
FoundErr = True
ErrMsg = ErrMsg & "<br><li>在分析：" & NewsUrl & "新闻列表时发生错误！</li>"
End If
End If
End if
Content=Replace(Content,NewsPageNext,"")
End If
'过滤
Call Filters
Title = KMCObj.FpHtmlEnCode(Title)
Call FilterScript
Content = KMCObj.UBBCode(Content, strInstallDir, strChannelDir)
End If
If FoundErr <> True Then
'时间
If UpDateType = 0 Then
UpDateTime = Now()
ElseIf UpDateType = 1 Then
If DateType = 0 Then
UpDateTime = Now()
Else
UpDateTime = KMCObj.GetBody(NewsCode, DsString, DoString, False, False)
UpDateTime = LCase(KMCObj.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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -