?? admin_itemcollecsteady.asp
字號:
<!--#include file="inc/conn.asp"-->
<!--#include file="inc/function.asp"-->
<!--#include file="inc/ubbcode.asp"-->
<!--#include file="inc/clsCache.asp"-->
<%
Dim ItemNum,ListNum,ListSuccesNum,ListFalseNum,NewsNumAll
Dim Rs,Sql,RsItem,SqlItem,FoundErr,ErrMsg,ItemEnd,ListEnd
'項目變量
Dim ItemID,ItemName,LoginType,LoginUrl,LoginPostUrl,LoginUser,LoginPass,LoginFalse
Dim ListStr,LsString,LoString,ListPaingType,LPsString,LPoString,ListPaingStr1,ListPaingStr2,ListPaingID1,ListPaingID2,ListPaingStr3,HsString,HoString,HttpUrlType,HttpUrlStr,CollecListNum,CollecNewsNum
'采集相關的變量
Dim Arr_i,NewsUrl
'其它變量
Dim LoginData,LoginResult
Dim Arr_Item,CacheTemp,CollecOrder,OrderTemp
'執行時間變量
Dim StartTime,OverTime
'列表
Dim ListUrl,ListCode,NewsArrayCode,NewsArray,ListArray,ListPaingNext,ListPaingTemp
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")))
ListNum=Clng(Trim(Request("ListNum")))
ListSuccesNum=Clng(Trim(Request("ListSuccesNum")))
ListFalseNum=Clng(Trim(Request("ListFalseNum")))
NewsNumAll=Clng(Trim(Request("NewsNumAll")))
ListPaingNext=Trim(Request("ListPaingNext"))
FoundErr=False
ItemEnd=False
ListEnd=False
CollecListNum=0
CollecNewsNum=0
Call SetCache()
If ItemEnd<>True Then
If (ItemNum-1)>Ubound(Arr_Item,2) then
ItemEnd=True
Else
Call SetItems()
End If
End If
If ItemEnd<>True Then
If ListPaingType=0 Then
If ListNum=1 Then
ListUrl=ListStr
Else
ListEnd=True
End If
ElseIf ListPaingType=1 Then
If ListNum=1 Then
ListUrl=ListStr
Else
If ListPaingNext="" or ListPaingNext="$False$" Then
ListEnd=True
Else
ListPaingNext=Replace(ListPaingNext,"{$ID}","&")
ListUrl=ListPaingNext
End If
End If
ElseIf ListPaingType=2 Then
If ListPaingID1>ListPaingID2 then
If (ListPaingID1-ListNum+1)<ListPaingID2 or (ListPaingID1-ListNum+1)<0 Then
Listend=True
Else
ListUrl=Replace(ListPaingStr2,"{$ID}",Cstr(ListpaingID1-ListNum+1))
End if
Else
If (ListPaingID1+ListNum-1)>ListPaingID2 Then
ListEnd=True
Else
ListUrl=Replace(ListPaingStr2,"{$ID}",CStr(ListPaingID1+ListNum-1))
End If
End If
ElseIf ListPaingType=3 Then
ListArray=Split(ListPaingStr3,"|")
If (ListNum-1)>Ubound(ListArray) Then
ListEnd=True
Else
ListUrl=ListArray(ListNum-1)
End If
End If
If ListNum>CollecListNum And CollecListNum<>0 Then
ListEnd=True
End if
End If
If ItemEnd=True Then
ErrMsg="<br>列表分析完成"
ErrMsg=ErrMsg & "<br>成功分析： " & ListSuccesNum & " 頁列表,失敗： " & ListFalseNum & " 頁,信息：" & NewsNumAll & " 條"
ErrMsg=ErrMsg& "<br>正在整理數據，稍后進行信息的采集..."
ErrMsg=ErrMsg & "<meta http-equiv=""refresh"" content=""3;url=Admin_ItemCollecNews.asp?ItemNum=1&NewsNum=1&NewsSuccesNum=0&NewsFalseNum=0&ImagesNumAll=0&NewsNumAll=" & NewsNumAll & """>"
Else
If ListEnd=True Then
ItemNum=ItemNum+1
ListNum=1
ErrMsg="<br>" & ItemName & " 項目所有列表分析完成，正在整理數據請稍后..."
ErrMsg=ErrMsg & "<meta http-equiv=""refresh"" content=""3;url=Admin_ItemCollecSteady.asp?ItemNum=" & ItemNum & "&ListNum=" & ListNum & "&ListSuccesNum=" & ListSuccesNum & "&ListFalseNum=" & ListFalseNum & "&NewsNumAll=" & NewsNumAll & """>"
End If
End If
Call TopItem()
If ItemEnd<>True And ListEnd<>True Then
FoundErr=False
ErrMsg=""
Call StartCollection()
End If
Call WriteSucced(ErrMsg)
Call FootItem()
Response.Flush()
'關閉數據庫鏈接
Call CloseConn()
Call CloseConnItem()
%>
<%
'==================================================
'過程名：StartCollection
'作 用：開始采集
'參 數：無
'==================================================
Sub StartCollection
'第一次采集時登錄
If LoginType=1 And ListNum=1 then
LoginData=UrlEncoding(LoginUser & "&" & LoginPass)
LoginResult=PostHttpPage(LoginUrl,LoginPostUrl,LoginData)
If Instr(LoginResult,LoginFalse)>0 Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>在登錄網站時發生錯誤，請確保登錄信息的正確性！</li>"
End If
End If
If FoundErr<>True then
ListCode=GetHttpPage(ListUrl)
Call GetListPaing()
If ListCode="$False$" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>在獲取列表：" & ListUrl & "網頁源碼時發生錯誤！</li>"
Else
ListCode=GetBody(ListCode,LsString,LoString,False,False)
If ListCode="$False$" Or ListCode="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>在截取：" & ListUrl & "的信息列表時發生錯誤！</li>"
End If
End If
End If
If FoundErr<>True Then
NewsArrayCode=GetArray(ListCode,HsString,HoString,False,False)
If NewsArrayCode="$False$" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>在分析：" & ListUrl & "信息列表時發生錯誤！</li>"
Else
NewsArray=Split(NewsArrayCode,"$Array$")
For Arr_i=0 to Ubound(NewsArray)
If HttpUrlType=1 Then
NewsArray(Arr_i)=Trim(Replace(HttpUrlStr,"{$ID}",NewsArray(Arr_i)))
Else
NewsArray(Arr_i)=Trim(DefiniteUrl(NewsArray(Arr_i),ListUrl))
End If
NewsArray(Arr_i)=CheckUrl(NewsArray(Arr_i))
Next
If CollecOrder=True Then
For Arr_i=0 to Fix(Ubound(NewsArray)/2)
OrderTemp=NewsArray(Arr_i)
NewsArray(Arr_i)=NewsArray(Ubound(NewsArray)-Arr_i)
NewsArray(Ubound(NewsArray)-Arr_i)=OrderTemp
Next
End If
End If
End If
If FoundErr<>True Then
ErrMsg=ErrMsg & "<br>本次運行 " & Ubound(Arr_Item,2)+1 & " 個項目"
ErrMsg=ErrMsg & "<br>從第 " & ItemNum & " 個項目 " & ItemName & " 的第 " & ListNum & " 頁列表分析出 " & Ubound(NewsArray) & " 條信息"
If CollecNewsNum<>0 Then
ErrMsg=ErrMsg & "，限制 " & CollecNewsNum & " 條。"
If (CollecNewsNum-1)>Ubound(NewsArray) Then
CollecNewsNum=Ubound(NewsArray)+1
Else
'保持不變CollecNewsNum
End If
Else
CollecNewsNum=Ubound(NewsArray)+1
End If
ListSuccesNum=ListSuccesNum+1
NewsNumAll=NewsNumAll+CollecNewsNum
Call SaveNewsList()
Else
ListFalseNum=ListFalseNum+1
End If
ErrMsg=ErrMsg & "<br>" & "<meta http-equiv=""refresh"" content=""3;url=Admin_ItemCollecSteady.asp?ItemNum=" & ItemNum & "&ListNum=" & ListNum+1 & "&ListSuccesNum=" & ListSuccesNum & "&ListFalseNum=" & ListFalseNum & "&NewsNumAll=" & NewsNumAll & "&ListPaingNext=" & ListPaingNext & """>"
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
Set myCache=Nothing
End Sub
Sub SetItems()
Dim ItemNumTemp
ItemNumTemp=ItemNum-1
ItemID=Arr_Item(0,ItemNumTemp)
ItemName=Arr_Item(1,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)
CollecListNum=Arr_Item(80,ItemNumTemp)
CollecNewsNum=Arr_Item(81,ItemNumTemp)
CollecOrder=Arr_Item(84,ItemNumTemp)
End Sub
'==================================================
'過程名：GetListPaing
'作 用：獲取列表下一頁
'參 數：無
'==================================================
Sub GetListPaing()
If ListPaingType=1 Then
ListPaingNext=GetPaing(ListCode,LPsString,LPoString,False,False)
ListPaingNext=FpHtmlEnCode(ListPaingNext)
If ListPaingNext<>"$False$" And ListPaingNext<>"" Then
If ListPaingStr1<>"" Then
ListPaingNext=Replace(ListPaingStr1,"{$ID}",ListPaingNext)
Else
ListPaingNext=DefiniteUrl(ListPaingNext,ListUrl)
End If
ListPaingNext=Replace(ListPaingNext,"&","{$ID}")
End If
Else
ListPaingNext="$False$"
End If
End Sub
'==================================================
'過程名：SaveNewsList
'作 用：保存信息
'參 數：無
'==================================================
Sub SaveNewsList
set rs=server.createobject("adodb.recordset")
sql="select top 1 * from NewsList"
rs.open sql,connItem,1,3
For Arr_i=1 To CollecNewsNum
rs.addnew
rs("ItemID")=ItemID
rs("NewsUrl")=NewsArray(Arr_i-1)
rs.update
Next
rs.close
set rs=nothing
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="../css/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%>
<%
'==================================================
'過程名：FootItem
'作 用：顯示底部版權等信息
'參 數：無
'==================================================
Sub FootItem()%>
<!--#include file="Admin_ItemFoot.asp"-->
</body>
</html>
<%End Sub%>?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -