📄 projectmodify.asp
字号:
ErrMsg=ErrMsg & "<br><li>在截取:" & ListIndex & "新闻列表时发生错误</li>"
Call WriteErrMsg(ErrMsg)
Response.end
End If
Sql="update Project set ProjectName = '"&ProjectName&"',ChannelID='"&ChannelID&"',ClassID='"&ClassID&"',WebName='"&WebName&"',WebUrl='"&WebUrl&"',ListIndex ='"&ListIndex&"' where ProjectID="&session("ProjectID")
ConnHistroy.Execute(sql)
End If
If FoundErr<>True Then
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,1
If Rs.Eof And Rs.Bof Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>参数错误，没有找到该项目！</li>"
Else
ListStartString=Rs("ListStartString")
ListEndString=Rs("ListEndString")
ListType=Rs("ListType")
ListPageStr=Rs("ListPageStr")
PageStart=Rs("PageStart")
PageEnd=Rs("PageEnd")
PageOrder=Rs("PageOrder")
End If
Rs.Close
Set Rs=Nothing
End If
%>
<center>
<form method="POST" action="?Action=Modify_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"><%=ListStartString%></textarea><br>
（用文本编辑器查看上步指定的新闻列表页面，从中找出能唯一确定新闻列表开始的HTML代码，以缩小查找范围）
</td>
</tr>
<tr height="25">
<td width="30%" align="right">
<b>列表结束代码：</b></td>
<td width="65%">
<br>
<textarea rows="6" name="ListEndString" cols="52"><%=ListEndString%></textarea><br>
（用文本编辑器查看上步指定的新闻列表页面，从中找出能唯一确定新闻列表结束的HTML代码，以缩小查找范围）
</td>
</tr>
<tr height="25">
<td width="30%" align="right">
<strong>链接处理类型：</strong></td>
<td width="65%">
<%%>
<input type="radio" value="0" name="ListType" <%If ListType=0 Then Response.Write "checked"%>
onclick="HttpUrl1.style.display='none'">
不作设置
<input type="radio" value="1" name="ListType" <%If ListType=1 Then Response.Write "checked"%>
onclick="HttpUrl1.style.display=''">批量生成
</td>
</tr>
<tr height="25" id="HttpUrl1" style="display: <%If ListType<>1 Then Response.Write "none"%>">
<td width="30%" align="right">
<b>批量生成：</b></td>
<td width="65%" style="line-height: 150%">
<br>
重定向地址：<input type="text" name="ListPageStr" size="52" value="<%=ListPageStr%>">
<br>
格式：http://www.**.com/Article_Show.asp?ID={$ID} <font color="#FF0000">$ID 代替变动的页数</font><br>
起始页数：<input type="text" name="PageStart" size="9" value="<%=PageStart%>">
结束页数：<input type="text" name="PageEnd" size="9" value="<%=PageEnd%>"><br>
采集顺序：<input type="radio" name="PageOrder" value="0" <%If PageOrder=0 Then Response.Write "checked"%>>倒序
<input type="radio" name="PageOrder" value="1" <%If PageOrder=1 Then Response.Write "checked"%>>顺序<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 if%>
<%
If Action="Modify_Project2" then
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
Rs.Close
End If
If FoundErr=True then
Call WriteErrMsg(ErrMsg)
Response.end
Else
Sql="Select LinkStartStr,LinkEndStr from Project where ProjectID="&session("ProjectID")
Set Rs=Server.Createobject("Adodb.Recordset")
Rs.Open Sql,connHistroy,1,1
LinkStartStr=Rs("LinkStartStr")
LinkEndStr=Rs("LinkEndStr")
Rs.Close
End If
%>
<center>
<form method="POST" action="?Action=Modify_Project3" name="form4" id="ng_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="left" colspan="2">
<% session("tmpContent") = session("strRemoteListUrl")%>
检索到的链接列表
<iframe src="showcontent.asp" width=100% height=180pt frameborder=0></iframe>
</td>
</tr>
<tr height="25">
<td width="30%" align="right">
<b>链接开始代码：</b></td>
<td width="65%">
<br>
<textarea rows="6" name="LinkStartStr" cols="52"><%=LinkStartStr%></textarea><br>
（用文本编辑器查看本页找到的链接列表源文件，从中找出每个新闻内容页面链接的起始标志，如〈a href= ，以确定具体的页面链接）
</td>
</tr>
<tr height="25">
<td width="30%" align="right">
<b>链接结束代码：</b></td>
<td width="65%">
<br>
<textarea rows="6" name="LinkEndStr" cols="52"><%=LinkEndStr%></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" onclick="javascript:ng_form4.submit();"></td>
</tr>
</table>
</td>
</tr>
</table>
</form>
</center>
<%End If%>
<%
If Action="Modify_Project3" then
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
If FoundErr=True then
Call WriteErrMsg(ErrMsg)
Response.end
Else
Sql="Select TitleStartStr,TitleEndStr,ContentStartStr,ContentEndStr from Project where ProjectID="&session("ProjectID")
Set Rs=Server.Createobject("Adodb.Recordset")
Rs.Open Sql,connHistroy,1,1
TitleStartStr=Rs("TitleStartStr")
TitleEndStr=Rs("TitleEndStr")
ContentStartStr=Rs("ContentStartStr")
ContentEndStr=Rs("ContentEndStr")
Rs.close
End If
%>
<center>
<form method="POST" action="?Action=Modify_Project4" name="form5">
<table border="0" cellpadding="0" cellspacing="0" width="97%" class="tableBorder">
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -