📄 collectinfo.asp
字号:
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%
option explicit
Response.Buffer = True
Server.ScriptTimeOut=999
Response.Expires = -1
Response.ExpiresAbsolute = Now() - 1
Response.Expires = 0
Response.CacheControl = "no-cache"
%>
<!--#include file="inc/conn.asp"-->
<!--#include file="inc/function.asp"-->
<!--#include file="inc/clsCache.asp"-->
<%
'参数定义
'------------------------------------------
'项目参数
Dim ProjectID,ProjectName,ChannelID,ClassID,WebName,WebUrl
Dim ListIndex,ListStartString,ListEndString,ListType,ListPageStr,PageStart,PageEnd,PageOrder
Dim LinkStartStr,LinkEndStr,linkurl
Dim TitleStartStr,TitleEndStr,ContentStartStr,ContentEndStr
Dim CollectionTime,UserName,Rank
'出错参数
Dim Errmsg,FoundErr
'项目相关参数
Dim Arr_Project
'列表参数
Dim CollectListNum
'信息相关参数
Dim InfoSuccessNum,InfoFalseNum,CollectInfoNum,ArticleID
'采集控制参数
'Dim ProjectEnd '判断所有项目采集是否结束
Dim StartTime,ListUrl,ListNum,ListEnd '采集当前列表地址,列表页面页数，当前列表是否结束
Dim CollectInfoAllNum '采集信息总数
'采集临时变量
Dim Arr_i,ListCode,Arr_InfoListCode,Arr_InfoList,InfoUrl
Dim IsCollect,Arr_Histroy,His_i,His_Title,His_CollectionTime,His_Result
Dim InfoCode,Title,Content,UpDateTime,Author
Dim a
Dim RsHistroy,SqlHistroy,rs,sql
'初始化参数
'---------------------------------------------------
Dim strInstallDir,CacheTemp
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="trsoft" & CacheTemp
'数据初始化
ListNum=Session("ListNum") '列表数目
InfoSuccessNum=Session("InfoSuccessNum") '成功采集信息数目
InfoFalseNum=Session("InfoFalseNum") '失败采集信息数目
CollectListNum=0
CollectInfoNum=0
ArticleID=Session("ArticleID") '文章ID
ErrMsg="" '错误信息
FoundErr=False '是否存在错误
ListEnd=False '列表结束
%>
<html>
<head>
<title>通用信息采集系统</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link rel="stylesheet" type="text/css" href="css/style.css">
<style type="text/css">
<!--
.STYLE1 {
color: #000000;
font-weight: bold;
}
.STYLE2 {color: #FF0000}
-->
</style>
</head>
<body leftmargin="0" topmargin="0" marginwidth="0" marginheight="0">
<table width="97%" border="0" align="center" cellpadding="0" cellspacing="1" class="tableBorder">
<tr>
<th height="22" colspan="2" align="center"><span class="STYLE1">采 集 项 目 管 理</span></th>
</tr>
</table>
<table width="97%" border="0" align="center" cellpadding="0" cellspacing="1" class="tableBorder">
<tr>
<td width="65" height="30"><strong>管理导航：</strong></td>
<td height="30"><a href="projectmanage.asp">管理首页</a> | 正在采集</td>
</tr>
</table>
<%
Call GetCache() '读取缓存信息包括项目和历史数据
Call SetProject() '设置项目
'程序循环开始
do While not ListEnd
FoundErr = False
ErrMsg = ""
Call SetHistroyCache()
Call SetListUrl()
if not ListEnd then
Call StartCollection()
Response.Write("<meta http-equiv=""refresh"" content=""5;url=collectinfo.asp"">")
response.End()
else
dim Result
Result=""
Result=Result&"本次运行：共采集1 个项目。其中：成功采集--"&Session("InfoSuccessNum")&"条信息，失败"&Session("InfoFalseNum")&"条。<a href=""collectmanage.asp"">停止采集</a>"
Call ShowMsg(Result)
Session("ListNum")=1
Session("InfoSuccessNum")=0
Session("InfoFalseNum")=0
Session("ArticleID")=0
end if
Loop
%>
</body>
</html>
<%
Response.Flush()
'关闭数据库链接
Call CloseConn()
Call CloseConnHistroy()
'函数列表
'==================================================
'过程名：GetCache
'作 用：存取缓存
'参 数：无
'==================================================
Sub GetCache()
Dim ProjectCache
Set ProjectCache=new clsCache
'项目信息
ProjectCache.name=CacheTemp & "Project"
If ProjectCache.valid then
Arr_Project=ProjectCache.value
Else
ListEnd=True
End If
'历史记录
ProjectCache.name=CacheTemp & "histroy"
If ProjectCache.valid then
Arr_Histroy=ProjectCache.value
End If
Set ProjectCache=Nothing
End Sub
'==================================================
'过程名：SetProject
'作 用：获取项目信息
'参 数：无
'==================================================
Sub SetProject()
ProjectID=Arr_Project(0,0)
ProjectName=Arr_Project(1,0) '项目名称
ChannelID=Arr_Project(2,0) '频道ID
ClassID=Arr_Project(3,0) '栏目ID
WebName=Arr_Project(4,0)
WebUrl=Arr_Project(5,0)
ListIndex=Arr_Project(6,0)
ListStartString=Arr_Project(7,0)
ListEndString=Arr_Project(8,0)
ListType=Arr_Project(9,0)
ListPageStr=Arr_Project(10,0)
PageStart=Arr_Project(11,0)
PageEnd=Arr_Project(12,0)
PageOrder=Arr_Project(13,0)
LinkStartStr=Arr_Project(14,0)
LinkEndStr=Arr_Project(15,0)
TitleStartStr=Arr_Project(16,0)
TitleEndStr=Arr_Project(17,0)
ContentStartStr=Arr_Project(18,0)
ContentEndStr=Arr_Project(19,0)
CollectionTime=Arr_Project(20,0)
UserName=Arr_Project(21,0)
Rank=Arr_Project(22,0)
End Sub
Sub DelCache()
Dim ProjectCache
Set ProjectCache=new clsCache
ProjectCache.name=CacheTemp & "Project"
Call ProjectCache.clean()
ProjectCache.name=CacheTemp & "histroy"
Call ProjectCache.clean()
Set ProjectCache=Nothing
End Sub
Sub SetListUrl()
If ListType=0 Then '第一种连接类型
If ListNum=1 Then
ListUrl=ListIndex
Else
ListEnd=True
End If
ElseIf ListType=1 Then
If PageStart>PageEnd then
If (PageStart-ListNum+1)<PageEnd or (PageStart-ListNum+1)<0 Then
Listend=True
Else
ListUrl=Replace(ListPageStr,"{$ID}",Cstr(PageStart-ListNum+1))
End if
Else
If (PageStart+ListNum-1)>PageEnd Then
ListEnd=True
Else
ListUrl=Replace(ListPageStr,"{$ID}",CStr(PageStart+ListNum-1))
End If
End If
End If
ListNum = ListNum + 1
End Sub
Sub StartCollection()
ListCode=GetHttpPage(ListUrl)
If ListCode="$False$" Then
FoundErr=True
ErrMsg=ErrMsg & "<br>在获取列表：" & ListUrl & "网页源码时发生错误！"
Else
ListCode=GetBody(ListCode,ListStartString,ListEndString,False,False)
If ListCode="$False$" Or ListCode="" Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -