📄 projectmanage.asp
字号:
End If
If ChannelID="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>所属频道不能为空</li>"
End If
If ClassID="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>所属栏目不能为空</li>"
End If
If WebName="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>被采集网站名称不能为空</li>"
End If
If WebUrl="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>被采集网站地址名称不能为空</li>"
End If
If ListIndex="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>列表索引页面不能为空</li>"
End If
If FoundErr=True then
Call WriteErrMsg(ErrMsg)
Response.end
Else
ListCode=GetHttpPage(ListIndex)
If ListCode="$False$" Then
ErrMsg=ErrMsg & "<br><li>在截取:" & ListIndex & "新闻列表时发生错误</li>"
Call WriteErrMsg(ErrMsg)
Response.end
End If
Set rs=Server.CreateObject("Adodb.Recordset")
rs.open "Select top 1 ProjectID,WebName from Project where ProjectName='"&ProjectName&"'",ConnHistroy,1,1
If rs.eof and rs.eof then
Sql="INSERT INTO Project (ProjectName,ChannelID,ClassID,WebName,WebUrl,ListIndex) VALUES ('"&ProjectName&"','"&ChannelID&"','"&ClassID&"','"&WebName&"','"&WebUrl&"','"&ListIndex&"')"
ConnHistroy.Execute(sql)
Set rs=ConnHistroy.Execute("select top 1 ProjectID from Project where ProjectName='"&ProjectName&"'")
Session("ProjectID")=rs("ProjectID")
rs.close
Else
ErrMsg=ErrMsg & "<br><li>项目名字已存在！</li>"
Call WriteErrMsg(ErrMsg)
Response.end
End if
End If
%>
<center>
<form method="POST" action="?Action=Add_Project2&ListIndex=<%=ListIndex%>" name="form3">
<table border="0" cellpadding="0" cellspacing="0" width="97%" class="tableBorder">
<tr>
<td width="100%" height="30" valign="middle">
<font color="#FF0000">采集项目：</font><font color="red">列表设置</font>
</td>
</tr>
<tr>
<td width="100%" valign="top">
<table cellpadding="0" cellspacing="0" width="100%" bgcolor="#FFFFFF" id="table1">
<%if ShowCode="yes" then%>
<tr height="25">
<td align="right" colspan="2">
<p align="center"><br>
<table border="0" width="100%" cellspacing="0" cellpadding="0" id="table2">
<tr>
<td>
<p align="center">
<textarea rows="16" name="ListCode" cols="107"><%=ListCode%></textarea></td>
</tr>
</table>
<p align="center"> </td>
</tr>
<%end if%>
<tr height="25">
<td width="30%" align="right">
<b>列表开始代码：</b></td>
<td width="65%"> <br>
<textarea rows="6" name="ListStartString" cols="52"></textarea><br>
</td>
</tr>
<tr height="25">
<td width="30%" align="right">
<b>列表结束代码：</b></td>
<td width="65%"><br>
<textarea rows="6" name="ListEndString" cols="52"></textarea><br>
</td>
</tr>
<tr height="25">
<td width="30%" align="right"><strong>链接处理类型：</strong></td>
<td width="65%"> <input type="radio" value="0" name="ListType" checked onClick="HttpUrl1.style.display='none'">
不作设置 <input type="radio" value="1" name="ListType" onClick="HttpUrl1.style.display=''">批量生成 </td>
</tr>
<tr height="25" id="HttpUrl1" style="display:none">
<td width="30%" align="right"><b>批量生成：</b></td>
<td width="65%" style="line-height: 150%"> <br>
重定向地址：<input type="text" name="ListPageStr" size="52"> <br>
格式：http://www.**.com/Article_Show.asp?ID={$ID}
<font color="#FF0000">$ID 代替变动的页数</font><br>
起始页数：<input type="text" name="PageStart" size="9" value="0"> 结束页数：<input type="text" name="PageEnd" size="9" value="0"><br>
采集顺序：<input type="radio" name="PageOrder" value="0" checked>倒序
<input type="radio" name="PageOrder" value="1">顺序<br>
</td>
</tr>
<tr height="25">
<td width="30%" align="right"> </td>
<td width="65%"> </td>
</tr>
<tr height="25">
<td width="30%" align="right"> </td>
<td width="65%" style="line-height: 200%"> <input type="submit" value="下一步" name="B3"></td>
</tr>
<tr height="25">
<td width="30%" align="right"> </td>
<td width="65%"> </td>
</tr>
</table>
</td>
</tr>
</table>
</form>
</center>
<%End Sub%>
<%
Sub Step2()
ListIndex=Request.Querystring("ListIndex")
ListCode=GetHttpPage(ListIndex)
ListStartString=Request.form("ListStartString")
ListEndString=Request.form("ListEndString")
ListType=Request.form("ListType")
ListPageStr=Request.form("ListPageStr")
PageStart=Request.form("PageStart")
PageEnd=Request.form("PageEnd")
PageOrder=Request.form("Pageorder")
If ListStartString="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>列表开始代码不能为空</li>"
End If
If ListEndString="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>列表结束代码不能为空</li>"
End If
If ListType = 1 then
If ListPageStr="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>重定向地址不能为空</li>"
End If
If PageStart="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>超始页不能为空，请输入数字</li>"
End If
If PageEnd="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>结束页不能为空，请输入数字</li>"
End If
If isNumeric(PageStart)=False or isNumeric(PagEend)=False Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>批量生成的范围只能是数字</li>"
End if
End If
If FoundErr=True then
Call WriteErrMsg(ErrMsg)
Response.end
Else
strRemoteListUrl = GetBody(ListCode,ListStartString,ListEndString,False,False)
Session("strRemoteListUrl")=strRemoteListUrl
'response.write server.htmlencode(strRemoteListUrl)
Sql="Select ProjectID,ListStartString,ListEndString,ListType,ListPageStr,PageStart,PageEnd,PageOrder from Project where ProjectID="&session("ProjectID")
Set Rs=Server.Createobject("Adodb.Recordset")
Rs.Open Sql,connHistroy,1,2
Rs("ListStartString")=ListStartString
Rs("ListEndString")=ListEndString
Rs("ListType")=ListType
Rs("ListPageStr")=ListPageStr
Rs("Pagestart")=Pagestart
Rs("Pageend")=Pageend
Rs("Pageorder")=Pageorder
Rs.Update
End If
%>
<center>
<form method="POST" action="?Action=Add_Project3" name="form4">
<table border="0" cellpadding="0" cellspacing="0" width="97%" class="tableBorder">
<tr>
<td width="100%" height="30" valign="middle">
<font color="#FF0000">采集项目：</font><font color="red">链接设置</font>
</td>
</tr>
<tr>
<td width="100%" bgcolor="#F7F7F7" height="1" style="border: 1 solid #C0C0C0" valign="top">
<table border="1" cellpadding="0" cellspacing="0" width="100%" bgcolor="#FFFFFF" id="table1">
<tr height="25">
<td align="right" colspan="2">
<p align="center"><%=session("strRemoteListUrl")%></td> </tr>
<tr height="25">
<td width="30%" align="right">
<b>链接开始代码：</b></td> <td width="65%"> <br>
<textarea rows="6" name="LinkStartStr" cols="52"></textarea><br>
</td>
</tr>
<tr height="25">
<td width="30%" align="right">
<b>链接结束代码：</b></td>
<td width="65%"><br>
<textarea rows="6" name="LinkEndStr" cols="52"></textarea><br>
</td>
</tr>
<tr height="25">
<td width="30%" align="right"> </td>
<td width="65%"> </td>
</tr>
<tr height="25">
<td width="30%" align="right"> </td> <td width="65%"><input type="submit" value="下一步" name="B2"></td> </tr>
</table>
</td>
</tr>
</table>
</form>
</center>
<%End Sub%>
<%
Sub Step3()
LinkStartStr=Request.form("LinkStartStr")
LinkEndStr=Request.form("LinkEndStr")
If LinkStartStr="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>链接开始代码不能为空</li>"
End If
If LinkEndStr="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>链接结束代码不能为空</li>"
End If
If FoundErr=True then
Call WriteErrMsg(ErrMsg)
Response.end
Else
linkurl= GetArray(session("strRemoteListUrl"),LinkStartStr,LinkEndStr,False,False)
NewsArray=Split(linkurl,"$Array$")
If Ubound(NewsArray)=0 then
ErrMsg=ErrMsg & "<br><li>链接开始或结束代码出错，没有截取到任何记录</li>"
Call WriteErrMsg(ErrMsg)
Response.end
End if
For Testi=0 To Ubound(NewsArray)
If left(NewsArray(Testi),1)="/" then
ProjectName_Z=session("WebUrl") & NewsArray(Ubound(NewsArray)-1)
else
if left(NewsArray(Testi),4)="http" then
ProjectName_Z=NewsArray(Ubound(NewsArray)-1)
else
ProjectName_Z=session("Urlstr") & NewsArray(Ubound(NewsArray)-1)
end if
end if
Next
Sql="Select ProjectID,LinkStartStr,LinkEndStr from Project where ProjectID="&session("ProjectID")
Set Rs=Server.Createobject("Adodb.Recordset")
Rs.Open Sql,connHistroy,1,2
Rs("LinkStartStr")=LinkStartStr
Rs("LinkEndStr")=LinkEndStr
Rs.Update
ListCode_z=GetHttpPage(ProjectName_Z)
Session("ListCode_z")=ListCode_z
If Instr(Session("ListCode_z"),"无法找到该页")<>0 then
ErrMsg=ErrMsg & "<br><li>在截取:" & ListPageStr & "时发生错误，请检查截取的列表是否正确</li>"
Call WriteErrMsg(ErrMsg)
Response.end
End If
End If
%>
<center>
<form method="POST" action="?Action=Add_Project4" name="form5">
<table border="0" cellpadding="0" cellspacing="0" width="97%" class="tableBorder">
<tr>
<td width="100%" height="30" valign="middle">
<font color="#FF0000">采集项目：标题/内容设置</font>
</td>
</tr>
<tr>
<td width="100%" valign="top">
<table cellpadding="0" cellspacing="0" width="100%" bgcolor="#FFFFFF" id="table1">
<tr height="25">
<td align="right" colspan="2">
<table border="0" width="98%" id="table3">
<tr>
<td style="line-height: 150%">
以下是分析后所得到的新闻绝对链接地址，请查看是否正确。<br>
<%
For Testi=0 To Ubound(NewsArray)
If left(NewsArray(Testi),1)="/" then
Response.Write "<a href='" & session("WebUrl") & NewsArray(Testi) & "' target=_blank>" & session("WebUrl") & NewsArray(Testi) & "</a><br>"
else
if left(NewsArray(Testi),4)="http" then
Response.Write "<a href='" & NewsArray(Testi) & "' target=_blank>" & NewsArray(Testi) & "</a><br>"
else
Response.Write "<a href='" & session("Urlstr") & NewsArray(Testi) & "' target=_blank>" & session("WebUrl") & NewsArray(Testi) & "</a><br>"
end if
end if
Next
%><br>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -