📄 admin_mov_add_03.asp
字号:
<%
Sub Add3
FoundErr=False
If ItemID="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>参数错误，请从有效链接进入</li>"
Else
ItemID=Clng(ItemID)
End If
If LsString="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>列表开始标记不能为空</li>"
End If
If LoString="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>列表结束标记不能为空</li>"
End If
If ListPaingType="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>请选择列表索引分页类型</li>"
Else
ListPaingType=Clng(ListPaingType)
Select Case ListPaingType
Case 0,1
If ListStr="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>列表索引页不能为空</li>"
Else
ListStr=Trim(ListStr)
End If
If ListPaingType=1 Then
If LPsString="" or LPoString="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>索引分页开始/结束标记不能为空</li>"
End If
If ListPaingStr1<>"" and Len(ListPaingStr1)<15 Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>索引分页重定向设置不正确(至少15个字符)</li>"
End If
End If
Case 2
If ListPaingStr2="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>批量生成字符不能为空</li>"
End If
If isNumeric(ListPaingID1)=False or isNumeric(ListPaingID2)=False Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>批量生成的范围只能是数字</li>"
Else
ListPaingID1=Clng(ListPaingID1)
ListPaingID2=Clng(ListPaingID2)
If ListPaingID1 > ListPaingID2 Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>批量生成范围设置不正确</li>"
End If
End If
Case 3
If ListPaingStr3="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>列表索引分页不能为空，请手动添加</li>"
Else
ListPaingStr3=Replace(ListPaingStr3,CHR(13),"|")
End If
Case Else
FoundErr=True
ErrMsg=ErrMsg & "<br><li>请选择列表索引分页类型</li>"
End Select
End if
If FoundErr<>True Then
SqlItem="Select * from Item Where ItemID=" & ItemID
Set RsItem=server.CreateObject("adodb.recordset")
RsItem.Open SqlItem,ConnItem,2,3
RsItem("LsString")=LsString
RsItem("LoString")=LoString
RsItem("ListPaingType")=ListPaingType
Select Case ListPaingType
Case 0,1
RsItem("ListStr")=ListStr
If ListPaingType=1 Then
RsItem("LPsString")=LPsString
RsItem("LPoString")=LPoString
If ListPaingStr1<>"" Then
RsItem("ListPaingStr1")=ListPaingStr1
End If
End If
ListUrl=ListStr
Case 2
RsItem("ListPaingStr2")=ListPaingStr2
RsItem("ListPaingID1")=ListPaingID1
RsItem("ListPaingID2")=ListPaingID2
ListUrl=Replace(ListPaingStr2,"{$ID}",CStr(ListPaingID1))
Case 3
RsItem("ListPaingStr3")=ListPaingStr3
If Instr(ListPaingStr3,"|")>0 Then
ListUrl=Left(ListPaingStr3,Instr(ListPaingStr3,"|")-1)
Else
ListUrl=ListPaingStr3
End If
End Select
LoginType=RsItem("LoginType")
LoginUrl=RsItem("LoginUrl")
LoginPostUrl=RsItem("LoginPostUrl")
LoginUser=RsItem("LoginUser")
LoginPass=RsItem("LoginPass")
LoginFalse=RsItem("LoginFalse")
RsItem.UpDate
RsItem.Close
Set RsItem=Nothing
If LoginType=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)
If ListCode<>"$False$" Then
If ListPaingType=1 Then
ListPaingNext=GetPaing(ListCode,LPsString,LPoString,False,False)
If ListPaingNext<>"$False$" Then
If ListPaingStr1<>"" Then
ListPaingNext=Replace(ListPaingStr1,"{$ID}",ListPaingNext)
Else
ListPaingNext=DefiniteUrl(ListPaingNext,ListUrl)
End If
End If
End If
ListCode=GetBody(ListCode,LsString,Lostring,False,False)
If ListCode="$False$" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>在截取:" & ListUrl & "新闻列表时发生错误</li>"
End If
Else
FoundErr=True
ErrMsg=ErrMsg & "<br><li>在获取:" & ListUrl & "网页源码时发生错误</li>"
End If
End If
End if
If FoundErr=True Then
Call WriteErrMsg(ErrMsg)
Response.End
End If
Set rrs=server.createobject("adodb.recordset")
SqlItemR="Select * from Item Where ItemID=" & ItemID
rrs.open SqlItemR,ConnItem,1,1
%>
<script language="VBScript">
Private Sub ceshi(Num)
Dim content
Content=document.form1.Content.value
Select Case Num
Case 1
huoqv=document.form1.LsString.value
Case 2
huoqv=document.form1.LoString.value
Case 3
huoqv=document.form1.LPsString.value
Case 4
huoqv=document.form1.LPoString.value
Case 5
huoqv=document.form1.TsString.value
Case 6
huoqv=document.form1.ToString.value
Case 7
huoqv=document.form1.CsString.value
Case 8
huoqv=document.form1.CoString.value
Case 9
huoqv=document.form1.AsString.value
Case 10
huoqv=document.form1.AoString.value
Case 11
huoqv=document.form1.FsString.value
Case 12
huoqv=document.form1.FoString.value
Case 13
huoqv=document.form1.KsString.value
Case 14
huoqv=document.form1.KoString.value
Case 15
huoqv=document.form1.NPsString.value
Case 16
huoqv=document.form1.NPsString.value
Case 17
huoqv=document.form1.DsString.value
Case 18
huoqv=document.form1.DoString.value
Case Else
Exit sub
End Select
if huoqv="" then
alert("测试无效！代码为空！")
exit Sub
End if
If InStr(Content,huoqv) = 0 Then
alert("测试无效！网页没有这些代码。")
Else
If InStr(Mid(Content,InStr(Content,huoqv)+LenB(huoqv),LenB(Content)),huoqv) = 0 Then
alert("测试成功！代码在页面是唯一的。")
Else
alert("测试失败！代码有重复,开始或结束至少有一处代码是唯一才有效！")
End if
End if
End Sub
Private Sub Analyse()
Dim AnalyseString,AnalyseString2
Dim content,Analysetemp
Content=document.form1.Content.value
AnalyseString=document.form1.AnalyseString.value
if AnalyseString="" then
alert("分析无效！分析代码为空！")
Exit Sub
End if
if isNumeric(document.form1.AnalyseNum.value)=false then
alert("分析字符数不是有效数字！")
Exit Sub
End if
AnalyseString2=LenB(AnalyseString)
If InStr(Content,AnalyseString) = 0 Then
alert("分析无效！网页没有这些代码。")
Else
if InStr(Content,AnalyseString)-document.form1.AnalyseNum.value <= 0 then
Analysetemp = 1
Else
Analysetemp =InStr(Content,AnalyseString)-document.form1.AnalyseNum.value
End if
If InStr(Mid(Content,InStr(Content,AnalyseString)+AnalyseString2, LenB(Content)),AnalyseString) = 0 Then
if document.form1.AnalyseWay(0).checked=true Then
document.form1.AnalyseContent.value=Mid(Content,Analysetemp,Len(AnalyseString)+document.form1.AnalyseNum.value)
elseif document.form1.AnalyseWay(1).checked=true then
document.form1.AnalyseContent.value=Mid(Content,InStr(Content,AnalyseString),Len(AnalyseString)+document.form1.AnalyseNum.value)
elseif document.form1.AnalyseWay(2).checked=true then
document.form1.AnalyseContent.value=Mid(Content,Analysetemp,document.form1.AnalyseNum.value)+Mid(Content,InStr(Content,AnalyseString),Len(AnalyseString)+document.form1.AnalyseNum.value)
End if
Else
alert("分析失败！分析代码有重复,要确认为一的字符。")
Exit Sub
End if
End if
End Sub
</script>
<script language="JavaScript">
<!--
function CheckForm(){
if (document.form1.Content.value.length > 200000){
document.form1.Content.value="";
}
}
function setFileFileds(weburl){
str="<iframe id='IFrame1' marginwidth=0 marginheight=0 frameborder=0 width='800' height='300' src="+weburl+"></iframe>";
objFiles.innerHTML=str;
}
//-->
</script>
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border">
<tr class="tdbg">
<td width="70" height="30"><strong>管理导航：</strong></td>
<td height="30"><a href="Admin_mov_Manage.asp">管理首页</a> >> <a href="Admin_mov_Add.asp?Type=modify&ItemID=<%=ItemID%>">基本设置</a> >> <a href="Admin_mov_Add.asp?action=Add1&Type=modify&ItemID=<%=ItemID%>">列表设置</a> >> <a href="Admin_mov_Add.asp?action=Add2&Type=modify&ItemID=<%=ItemID%>"><font color=red>链接设置</font></a> >> <a href="Admin_mov_Add.asp?action=Add3&Type=modify&ItemID=<%=ItemID%>">正文设置</a> >> <a href="Admin_mov_Add.asp?action=Add4&Type=modify&ItemID=<%=ItemID%>">采样测试</a> >> <a href="Admin_mov_Add.asp?action=Add5&Type=modify&ItemID=<%=ItemID%>">属性设置</a> >> 完成</td>
</tr>
</table>
<br>
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border" >
<tr>
<td height="22" colspan="2" class="title"> <div align="center"><strong> 项 目 编 辑-- 采 集 列 表 </strong></div></td>
</tr>
<tr>
<td height="22" colspan="2" class="tdbg"><%=ListCode%></td>
</tr>
<%If ListPaingNext<>"" And ListPaingNext<>"$False$" Then%>
<tr>
<td height="22" colspan="2" class="tdbg" >
<%Response.Write "<br>下一页列表：<a href='" & ListPaingNext & "' target=_blank><font color=red>" & ListPaingNext & "</font></a>"%>
</td>
</tr>
<%End If%>
<tr>
<td height="22" colspan="2" class="title"> <div align="center"><strong> 项 目 编 辑--采集目标源码 </strong> <Input type="radio" value="0" name="code" onClick="javascript:Content.style.height='1';" >不查看
<Input type="radio" value="1" name="code" onClick="javascript:Content.style.height='300';" checked>查看源码
</div></td>
</tr>
<tr class="tdbg">
<td class="tdbg" colspan='2' align='center'><TEXTAREA NAME='Content' ROWS='' COLS='' style='width:800px;height:300px'><%=dvHtmlEnCode1(ListCode)%></TEXTAREA></td>
</tr>
<tr>
<td height="22" colspan="2" class="tdbg" align="center">
</td>
</tr>
</table>
<form method="post" action="Admin_mov_Add.asp" name="form1">
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border" >
<tr>
<td height="22" colspan="2" class="title"><div align="center"><strong> 项 目 编 辑--链 接 设 置</strong></div></td>
</tr>
</table>
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border" >
<tr class="tdbg">
<td width="150" class="tdbg" align='center'><strong> 链接开始代码：</strong></td>
<td class="tdbg"><textarea name="HsString" style='width:450px;height:100px' id="HsString"><%=dvHtmlEnCode1(rrs("HsString"))%></textarea></td>
</tr>
<tr class="tdbg">
<td width="150" class="tdbg" align='center'><strong> 链接结束代码：</strong></td>
<td class="tdbg"><textarea name="HoString" style='width:450px;height:100px' id="HoString"><%=dvHtmlEnCode1(rrs("HoString"))%></textarea></td>
</tr>
<tr>
<td width="150" class="tdbg" align='center'><strong> 链接特殊处理：</strong></td>
<td class="tdbg" >
<input type="radio" value="0" name="HttpUrlType" <% if rrs("HttpUrlType")=0 then Response.Write "checked"%> onClick="javascript:HttpUrl1.style.display='none'">不作处理
<input type="radio" value="1" name="HttpUrlType" <% if rrs("HttpUrlType")=1 then Response.Write "checked"%> onClick="javascript:HttpUrl1.style.display=''"> 重新定位
</td>
</tr>
<tr class="tdbg" id="HttpUrl1" style="display:'<% if rrs("HttpUrlType")<>1 then Response.Write "none"%>'">
<td width="150" class="tdbg" align='center'><strong>绝对链接字符：</strong></td>
<td class="tdbg" >
<input name="HttpUrlStr" type="text" size="49" maxlength="200" value="<%=dvHtmlEnCode1(rrs("HttpUrlStr"))%>">
<br><font color=#0099FF>如果是动态js链接，用此功能。
<br>用链接设置捕获js的传值 例： onClick="nameid('xx')" 截取 onClick="nameid(' 和 ") 得到里面的ID
<br>再在绝对链接中填写实际路径 http://www.xxxxx.com/xxx/news.asp?id={$ID} {$ID}就是链接捕获的动态ID。</font>
</td>
</tr>
<tr class="tdbg">
<td width="150" class="tdbg" align="center"><strong> 分析代码： </strong></td>
<td class="tdbg">
<Input type="radio" value="0" name="analyseType" checked onClick="javascript:analyse.style.display='none';">不作分析
<Input type="radio" value="1" name="analyseType" onClick="javascript:analyse.style.display='';">启用分析
<font color='#0099FF'>注：此功能为辅助功能与采集配置无关</font> </td>
</tr>
<tr class="tdbg" id="analyse" style="display:none">
<td width="150" class="tdbg" align="right"></strong></td>
<td class="tdbg"> 分析网页字符：
<Input TYPE='text' NAME='AnalyseString' value='' id='AnalyseString' size='40' maxlength='200'>
<Input TYPE='button' value=' 分 析 ' NAME='AnalyseStart' onCLICK='Analyse()' ><br>
<Input TYPE='radio' NAME='AnalyseWay' value='0' checked>向前代码
<Input TYPE='radio' NAME='AnalyseWay' value='1'>向后代码
<Input TYPE='radio' NAME='AnalyseWay' value='2'>前后代码
字符数：
<Input TYPE='text' NAME='AnalyseNum' value='300' size='5' maxlength='4'>
<br>
<TEXTAREA NAME='AnalyseContent' style='width:550px;height:100px'></TEXTAREA>
</td>
</tr>
<tr class="tdbg">
<td colspan="2" align="center" height="50" class="tdbg">
<input name="ItemID" type="hidden" id="ItemID" value=<%=ItemID%>>
<input name="Action" type="hidden" id="Action" value="Add3">
<input type="button" name="Cancel" id="Cancel" value="返回上一步" onClick="window.location.href='javascript:history.go(-1)'" >
<input name="Submit" type="submit" value=" 下一步 " ></td>
</tr>
</form>
</table>
<%
rrs.close
set rrs=nothing
End Sub
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -