📄 system_gatherexe.asp
字号:
<!--#include file="System_Gather.asp"-->
<%
Call WR.Hand()
Dim Grso,WR_Anamnesis
Dim ID,BaseSetting,List,i,PageList,WorkLine,Li,Line,AReaBig,AReaSmall,Time_S
Dim ListBegin,ListEnd,LinkBegin,LinkEnd,ShowCode,HtmlContent,LinkReset,PageNext
Dim WR_Title,WR_Content,WR_Time,WR_Author,WR_CopyFrom,WR_Tags,WR_Class
Dim Contact,QQ,AddRess,TEL,SavePic,gSQL,Mobile,Fax,WEB
Dim TimingType,WR_WeekDay,ExeTime,Collecdate
Collecdate=WR.CheckStr(Request("Collecdate"), 1)
ID = WR.CheckStr(Request("ID"), 1)
Sub GatherInfo(gTitle,gInfo,gTime,gAuthor,gCopyFrom,gUrl,gTags)
Dim InfoShow
InfoShow = "<table width='100%' cellpadding=3 cellspacing=1 class=td1>" & vbCrLf
InfoShow = InfoShow & "<tr class=td4><td><strong>数据采集分析</strong> <a href=?Action=GatherStop>停止采集</a></td></tr>" & vbCrLf
InfoShow = InfoShow & "<tr class=td2><td>采集正在进行中，请耐心等待，如果网站出现暂时无法访问的情况这是正常的，采集正常结束后即可恢复。</td></tr>" & vbCrLf
InfoShow = InfoShow & "<tr class=td2><td><strong>本次运行：</strong>正在采集 <span class=font2>"&Split(Session(ID&"Item"),"|")(0)&"</span> 项目，共有 <span class=font2>"&Split(Session(ID&"Item"),"|")(8)&"</span> 页列表页，当前正在采集第 <span class=font2>"&Split(Session(ID&"Item"),"|")(1)&"</span> 页，该页共有 <span class=font2>"&Split(Session(ID&"Item"),"|")(2)&"</span> 条待采集记录，当前正在采集第 <span class=font2>"&Split(Session(ID&"Item"),"|")(7)&"</span> 条。</td></tr>" & vbCrLf
InfoShow = InfoShow & "<tr class=td2><td><strong>采集统计：</strong>共采集 <span class=font2>"&Split(Session(ID&"Item"),"|")(6)&"</span> 条记录，其中成功 <span class=font2>"&Split(Session(ID&"Item"),"|")(3)&"</span> 条，失败 <span class=font2>"&Split(Session(ID&"Item"),"|")(4)&"</span> 条。下载图片 <span class=font2>"&Split(Session(ID&"Item"),"|")(5)&"</span> 张。</td></tr>" & vbCrLf
InfoShow = InfoShow & "<tr class=td2><td><div style='width:100%; height:100px; z-index:1;text-align:left' class=div>"
InfoShow = InfoShow & " <strong>内容标题：</strong>"&gTitle&"<br>" & vbCrLf
InfoShow = InfoShow & " <strong>采集结果：</strong>"&gInfo&"<br>" & vbCrLf
InfoShow = InfoShow & " <strong>更新时间：</strong>"&gTime&"<br>" & vbCrLf
InfoShow = InfoShow & " <strong>内容作者：</strong>"&gAuthor&"<br>" & vbCrLf
InfoShow = InfoShow & " <strong>内容来源：</strong>"&gCopyFrom&"<br>" & vbCrLf
InfoShow = InfoShow & " <strong>关 键 字：</strong>"&gTags&"<br>" & vbCrLf
InfoShow = InfoShow & " <strong>目标地址：</strong><a href="&gUrl&" target=_blank>"&gUrl&"</a><br>" & vbCrLf
InfoShow = InfoShow & "</div></td></tr>" & vbCrLf
InfoShow = InfoShow & "</table>" & vbCrLf
Response.write InfoShow
End Sub
'On Error Resume Next
Call ConnOpen()
'执行定时采集
Sub Timing_window(gCollecdate)
Set Grso = Gconn.Execute("Select WR_ID From WR_Item Where WR_Timing=1")
Do While Not Grso.Eof
If ID = "" Then
ID = Grso(0)
Else
ID = ID & "," & Grso(0)
End If
Grso.MoveNext
Loop
Grso.Close
Set Grso = Nothing
Session("IDList") = "":Session("IDList") = ID
Response.RediRect "System_GatheRexe.asp?Collecdate="&gCollecdate
Response.end
End Sub
Select Case Request("Action")
Case "TimingSave"
TimingType = WR.CheckStr(Request("TimingType"), 1)
Select Case TimingType
Case 1
WR_WeekDay = WR.CheckStr(Request("WeekDay"), 1)
Case Else
WR_WeekDay = 0
End Select
ExeTime = WR.CheckStr(Request("ExeTime"), 0)
If WorkLine = "" Then WorkLine = 1
Gconn.Execute("Update WR_Config Set WR_TimingType="&TimingType&",WR_WeekDay="&WR_WeekDay&",WR_ExeTime='"&ExeTime&"'")
Call WRMPS.ErrView("·操作成功<meta http-equiv=RefResh content='1;URL=?Action=Timing'>",1)
Case "ExeTiming"
Session(ID&"Num") = ""
Session("IDList") = ""
Session(ID&"Item") = ""
Session(ID&"PageList") = ""
Session(ID&"UrlList") = ""
If Collecdate = "" Then Collecdate = 0
Content = Content & "<table width='100%' cellpadding=3 cellspacing=1 class=td1>" & vbCrLf
Content = Content & "<tr class=td4><td><strong>开启定时采集</strong></td></tr>" & vbCrLf
Set Grs = Gconn.Execute("Select WR_TimingType,WR_WeekDay,WR_ExeTime From WR_Config")
If Not Grs.EOF Then
Content = Content & "<tr class=td2><td align=center height='100'>本次采集设定：<span class=font2>"
Select Case Grs(0)
Case 0
If Time()>=CDate(Grs(2)) Then
If CStr(Day(now()))<>CStr(Collecdate) then
Collecdate=Day(now())
Call Timing_window(Collecdate)
End If
End if
Content = Content & "每天 "
Case 1
If Grs(1) = Weekday(Now()) And Time()>=CDate(Grs(2)) Then
If CStr(Day(now()))<>CStr(Collecdate) then
Collecdate=Day(now())
Call Timing_window(Collecdate)
End If
End if
Content = Content & "每周"
Select Case Grs(1)
Case 1
Content = Content & "日 "
Case 2
Content = Content & "一 "
Case 3
Content = Content & "二 "
Case 4
Content = Content & "三 "
Case 5
Content = Content & "四 "
Case 6
Content = Content & "五 "
Case 7
Content = Content & "六 "
End Select
End Select
Content = Content & Grs(2)&" 执行</span>"
Content = Content & "</span><br><br><input name=Submit type=button onclick=""javascript:window.open('about:blank','_self');TopTypeC()"" value='关闭定时采集'></td></tr>" & vbCrLf
Content = Content & "<tr class=td2><td align=center height='40' class=font2>定时采集已启动，请不要关闭此页面，否则定时采集功能也将同时关闭。</td></tr>" & vbCrLf
End If
Grs.Close
Content = Content & "</table><meta http-equiv=RefResh content='5'>" & vbCrLf
Response.Write Content
Case "Timing"
Content = Content & "<table width='100%' cellpadding=3 cellspacing=1 class=td1>" & vbCrLf
Content = Content & "<tr class=td2><td><a href=Index.asp>系统设置</a> | <a href=Data.asp>数据库管理</a> | <a href=Item.asp?Action=Admit>项目导入</a> | <a href=Item.asp?Action=Export>项目导出</a> | <a href=System_GatheRexe.asp?Action=Timing>定时采集</a></td></tr>" & vbCrLf
Content = Content & "</table>" & vbCrLf
Content = Content & "<table width='100%' cellpadding=3 cellspacing=1 class=td1>" & vbCrLf
Content = Content & "<tr class=td4><td><strong>定时采集设置</strong></td></tr>" & vbCrLf
Set Grs = Gconn.Execute("Select WR_TimingType,WR_WeekDay,WR_ExeTime From WR_Config")
If Not Grs.EOF Then
Content = Content & "<tr class=td2><td align=center height=200>设置定时采集时间"
Content = Content & "<form name='myform' method='post' Action='?Action=TimingSave'>" & vbCrLf
Content = Content & "<select name='TimingType' onChange=""if(this.options[this.selectedIndex].value==0){WeekDay.style.display='none'}else{WeekDay.style.display=''}""><option value=0" & WRMPS.GetCheckVer(0, Grs(0), 0) & ">每天</option><option value=1" & WRMPS.GetCheckVer(1, Grs(0), 0) & ">每周</option></select>"
Content = Content & "<select name='WeekDay' id='WeekDay'"
If Grs(0) < 1 Then Content = Content & " style='display:none'"
Content = Content & "><option value=1" & WRMPS.GetCheckVer(1, Grs(1), 0) & ">星期日</option><option value=2" & WRMPS.GetCheckVer(2, Grs(1), 0) & ">星期一</option><option value=3" & WRMPS.GetCheckVer(3, Grs(1), 0) & ">星期二</option><option value=4" & WRMPS.GetCheckVer(4, Grs(1), 0) & ">星期三</option><option value=5" & WRMPS.GetCheckVer(5, Grs(1), 0) & ">星期四</option><option value=6" & WRMPS.GetCheckVer(6, Grs(1), 0) & ">星期五</option><option value=7" & WRMPS.GetCheckVer(7, Grs(1), 0) & ">星期六</option></select>" & vbCrLf
Content = Content & " <input type=text name=ExeTime size=15 value='"&Grs(2)&"'><select name=ExeTime1 onChange=""javascript:myform.ExeTime.value=this.options[this.selectedIndex].value""><option></option>" & vbCrLf
Time_S=CDate("00:00:00")
For i=1 To 48
Content = Content & "<option value="""& Time_S &""">"& Time_S &"</option>" & vbCrLf
Time_S = CDate(Time_S) + CDate("00:30:00")
Next
Content = Content & "</select> <input name=Submit type=submit value='保存设置'>" & vbCrLf
End If
Grs.Close
Content = Content & "</form><input name=Submit type=button onclick=""javascript:window.open('?Action=ExeTiming','top');TopType()"" value='启动定时采集'></td></tr></table>" & vbCrLf
Response.Write Content
Case "CatherTwo"
Call ConnOpen()
If Instr(Session(ID&"UrlList"),"§") > 0 Then
Url = Split(Session(ID&"UrlList"),"§")(0)
Else
Url = Session(ID&"UrlList")
End If
If Url <> "" Then
Session(ID&"UrlList") = Listdata(1,Url)
End If
If Session(ID&"Num") = "" Then Session(ID&"Num")=0
Session(ID&"Item") = Itemdata(1,7)
Set Grs = Gconn.Execute("Select Top 1 WR_BaseSetting,WR_LinkReset,WR_Content,WR_PageNext,WR_Class,WR_Area,WR_Module,WR_ChannelID From WR_Item Where WR_ID="&ID)
If Not Grs.Eof Then
'取得公用数据
SavePic = ""
BaseSetting = Grs(0)
BaseSetting = Split(BaseSetting,"§§§")
LinkReset = Grs(1)
Url = GetUrl(Url,LinkReset) '重置URL
HtmlContent = Grs(2)
HtmlContent = Split(HtmlContent,Sign)
PageNext = Grs(3)
WR_Class = Grs(4)
AreaID = Grs(5)
ShowCode = ""
ShowCode = GetHttpPage(Url,BaseSetting(1))
Module = Grs(6)
ChannelID = Grs(7)
End If
Grs.Close
If Module <> "" Then
Select Case Module
Case 1 '文章采集
WR_Title = GetTitle(ShowCode,HtmlContent(0))
WR_Time = GetTime(ShowCode,HtmlContent(2))
WR_Author = GetShaReCon(ShowCode,HtmlContent(3))
WR_CopyFrom = GetShaReCon(ShowCode,HtmlContent(4))
WR_Tags = GetTags(ShowCode,HtmlContent(5),WR_Title)
If WR_Title = "" Then
Call GatherInfo(WR_Title,"<span class=font2>采集 "&Url&" 时出错。</span>","","","",Url,"")
Session(ID&"Item") = Itemdata(1,4)
Else
Set Grso = Gconn.Execute("Select WR_ID From WR_Histroly Where WR_ItemID="&ID&" and WR_ClassID="&Split(WR_Class,"|")(0)&" and WR_Title='"&WR_Title&"'")
If Not Grso.Eof Then'存在
Call GatherInfo(WR_Title,"<span class=font2>记录已存在，不给予采集</span>",WR_Time,WR_Author,WR_CopyFrom,Url,WR_Tags)
Session(ID&"Item") = Itemdata(1,4)
Else
WR_Content = GetContent(ShowCode,HtmlContent(1),ID,Url,Module,Int(BaseSetting(6)),Int(BaseSetting(7)),Int(BaseSetting(11)))
If WR_Content = "" Then Call GatherInfo("","<span class=font2>采集 "&Url&" 时出错。</span>","","","",Url,"")
Gconn.Execute("Insert Into WR_Histroly(WR_ItemID,WR_Module,WR_ClassID,WR_Title,WR_Url)values("&ID&","&Module&","&Split(WR_Class,"|")(0)&",'"&WR_Title&"','"&Url&"')")
If Int(BaseSetting(5)) > 0 Then '直接入库
Call ASave(WR_Title,WR.CheckStr(WR_Content,4),WR_Time,WR_Author,WR_CopyFrom,WR_Tags,ChannelID,WR_Class,SavePic)
Else
Gconn.Execute("Insert Into WR_Article(WR_Title,WR_Content,WR_Time,WR_Author,WR_CopyFrom,WR_Tags,WR_ChannelID,WR_ClassID,WR_AreaID,WR_Pic,WR_Item)values('"&WR_Title&"','"&WR.CheckStr(WR_Content,4)&"','"&WR_Time&"','"&WR_Author&"','"&WR_CopyFrom&"','"&WR_Tags&"','"&ChannelID&"','"&WR_Class&"',"&AreaID&",'"&SavePic&"',"&ID&")")
End If
If Err Then
Session(ID&"Item") = Itemdata(1,4)
Call GatherInfo("","<span class=font2>采集 "&Url&" 时出错。</span>","","","",Url,"")
Err.Clear
Else
Call GatherInfo(WR_Title,"采集成功",WR_Time,WR_Author,WR_CopyFrom,Url,WR_Tags)
Session(ID&"Item") = Itemdata(1,3)
End If
End If
Grso.Close
End If
Case 2 '分类广告采集
WR_Title = GetTitle(ShowCode,HtmlContent(0))
Contact = GetShaReC(ShowCode,HtmlContent(2))
EMail = GetShaReC(ShowCode,HtmlContent(3))
QQ = GetShaReC(ShowCode,HtmlContent(4))
AddRess = GetShaReC(ShowCode,HtmlContent(5))
TEL = GetShaReC(ShowCode,HtmlContent(6))
WR_Time = GetTime(ShowCode,HtmlContent(7))
WR_Tags = GetTags(ShowCode,HtmlContent(8),WR_Title)
If WR_Title = "" Then
Call GatherInfo(WR_Title,"<span class=font2>采集 "&Url&" 时出错。</span>","","","",Url,"")
Session(ID&"Item") = Itemdata(1,4)
Else
gSQL = ""
If TEL <> "" and IsNull(TEL)=False Then gSQL = gSQL & " and WR_Tel='"&TEL&"'"
If EMail <> "" and IsNull(EMail)=False Then gSQL = gSQL & " and WR_Email='"&EMail&"'"
Set Grso = Gconn.Execute("Select WR_ID From WR_Histroly Where WR_ItemID="&ID&" and WR_ClassID="&Split(WR_Class,"|")(0)&" and WR_Title='"&WR_Title&"'"&gSQL)
If Not Grso.Eof Then'存在
Call GatherInfo(WR_Title,"<span class=font2>记录已存在，不给予采集</span>",WR_Time,Contact,"",Url,WR_Tags)
Session(ID&"Item") = Itemdata(1,4)
Else
WR_Content = GetContent(ShowCode,HtmlContent(1),ID,Url,Module,Int(BaseSetting(6)),Int(BaseSetting(7)),Int(BaseSetting(11)))
If WR_Content = "" Then Call GatherInfo("","<span class=font2>采集 "&Url&" 时出错。</span>","","","",Url,"")
Gconn.Execute("Insert Into WR_Histroly(WR_ItemID,WR_Module,WR_ClassID,WR_Title,WR_Url,WR_Tel,WR_Email)values("&ID&","&Module&","&Split(WR_Class,"|")(0)&",'"&WR_Title&"','"&Url&"','"&TEL&"','"&EMail&"')")
If Int(BaseSetting(5)) > 0 Then '直接入库
Call CSave(WR_Title,WR.CheckStr(WR_Content,4),Contact,EMail,QQ,AddRess,TEL,WR_Time,WR_Tags,WR_Class,AreaID,SavePic)
Else
Gconn.Execute("Insert Into WR_ClassAD(WR_Title,WR_Content,WR_Time,WR_Tags,WR_Contact,WR_Email,WR_QQ,WR_AddRess,WR_TEL,WR_ChannelID,WR_ClassID,WR_AreaID,WR_Pic,WR_Item)values('"&WR_Title&"','"&WR.CheckStr(WR_Content,4)&"','"&WR_Time&"','"&WR_Tags&"','"&Contact&"','"&EMail&"','"&QQ&"','"&AddRess&"','"&TEL&"',"&ChannelID&",'"&WR_Class&"',"&AreaID&",'"&SavePic&"',"&ID&")")
End If
If Err Then
Session(ID&"Item") = Itemdata(1,4)
Call GatherInfo("","<span class=font2>采集 "&Url&" 时出错。</span>","","","",Url,"")
Err.Clear
Else
Call GatherInfo(WR_Title,"采集成功",WR_Time,Contact,"",Url,WR_Tags)
Session(ID&"Item") = Itemdata(1,3)
End If
End If
Grso.Close
End If
Case 3 '店铺采集
WR_Title = GetTitle(ShowCode,HtmlContent(0))
AddRess = GetShaReC(ShowCode,HtmlContent(2))
TEL = GetShaReC(ShowCode,HtmlContent(3))
Mobile = GetShaReC(ShowCode,HtmlContent(4))
Fax = GetShaReC(ShowCode,HtmlContent(5))
WEB = GetShaReC(ShowCode,HtmlContent(6))
WR_Time = GetTime(ShowCode,HtmlContent(7))
WR_Tags = GetTags(ShowCode,HtmlContent(8),WR_Title)
If WR_Title = "" Then
Call GatherInfo(WR_Title,"<span class=font2>采集 "&Url&" 时出错。</span>","","","",Url,"")
Session(ID&"Item") = Itemdata(1,4)
Else
gSQL = ""
If AddRess <> "" and IsNull(AddRess)=False Then gSQL = gSQL & " and WR_AddRess='"&AddRess&"'"
If TEL <> "" and IsNull(TEL)=False Then gSQL = gSQL & " and WR_TEL='"&TEL&"'"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -