admin_itemaddnew2.asp
来自「实现一个用JSP、Servlet技术实现的小型物流网站系统。实现功能如下：管理员」· ASP 代码 · 共 344 行
ASP
344 行
<!--#include file="inc/conn.asp"-->
<!--#include file="inc/function.asp"-->
<%
Dim Rs,Sql,FoundErr,ErrMsg
Dim SqlItem,RsItem
Dim ItemID,ItemName,WebName,ListStr,infoClassID,expoClassID,ChannelID,strChannelDir,ClassID,SpecialID,ItemDemo,LoginType,LoginUrl,LoginPostUrl,LoginUser,LoginPass,LoginFalse
Dim tClass,tSpecial
ItemName=Trim(Request.Form("ItemName"))
WebName=Trim(Request.Form("WebName"))
ListStr=Trim(Request.Form("ListStr"))
ChannelID=Request.Form("ChannelID")
infoClassID=Request.Form("infoClassID")
expoClassID=Request.Form("expoClassID")
SpecialID=Trim(Request.Form("SpecialID"))
ItemDemo=Trim(Request.Form("ItemDemo"))
LoginType=Request.Form("LoginType")
LoginUrl=Trim(Request.Form("LoginUrl"))
LoginPostUrl=Trim(Request.Form("LoginPostUrl"))
LoginUser=Trim(Request.Form("LoginUser"))
LoginPass=Trim(Request.Form("LoginPass"))
LoginFalse=Trim(Request.Form("LoginFalse"))
If ItemName="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>项目名称不能为空</li>"
End If
If WebName="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>网站名称不能为空</li>"
End If
If ListStr="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>列表网址不能为空</li>"
else
ListCode=GetHttpPage(ListStr)
If ListCode="$False$" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>在截取:" & ListStr & "信息列表时发生错误</li>"
End If
End If
If ChannelID="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>未指定频道</li>"
Else
ChannelID=Clng(ChannelID)
End If
if ChannelID=1 then
If infoClassID="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>未指定商业资讯栏目</li>"
else
ClassID=infoClassID
End if
end if
if ChannelID=2 then
If expoClassID="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>未指定展会资讯栏目</li>"
else
ClassID=expoClassID
End if
end if
If ClassID="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>未指定栏目</li>"
End if
if SpecialID="" then
SpecialID=0
End if
If LoginType="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>请选择登录类型</li>"
Else
LoginType=Clng(LoginType)
If LoginType=1 Then
If LoginUrl="" or LoginPostUrl="" or LoginUser="" or LoginPass="" or LoginFalse="" then
FoundErr=True
ErrMsg=ErrMsg& "<br><li>请将登录参数填写完整</li>"
End If
End If
End If
If FoundErr<>True Then
SqlItem="Select top 1 ItemID,ItemName,WebName,ListStr,ChannelID,ChannelDir,ClassID,SpecialID,ItemDemo,LoginType,LoginUrl,LoginPostUrl,LoginUser,LoginPass,LoginFalse from Item"
Set RsItem=server.CreateObject("adodb.recordset")
RsItem.Open SqlItem,ConnItem,1,3
RsItem.AddNew
RsItem("ItemName")=ItemName
RsItem("WebName")=WebName
RsItem("ListStr")=ListStr
RsItem("ChannelID")=ChannelID
RsItem("ChannelDir")=strChannelDir
RsItem("ClassID")=ClassID
RsItem("SpecialID")=SpecialID
If ItemDemo<>"" then
RsItem("ItemDemo")=ItemDemo
End if
RsItem("LoginType")=LoginType
If LoginType=1 Then
RsItem("LoginUrl")=LoginUrl
RsItem("LoginPostUrl")=LoginPostUrl
RsItem("LoginUser")=LoginUser
RsItem("LoginPass")=LoginPass
RsItem("LoginFalse")=LoginFalse
End If
ItemID=RsItem("ItemID")
RsItem.UpDate
RsItem.Close
Set RsItem=Nothing
End If
If FoundErr=True Then
call WriteErrMsg(ErrMsg)
Else
Call Main
End If
'关闭数据库链接
Call CloseConn()
Call CloseConnItem()
%>
<%Sub Main%>
<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">
<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>
</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>
<tr class="tdbg">
<td width="65" height="30"><strong>管理导航：</strong></td>
<td height="30"><a href="Admin_ItemAddNew.asp">添加项目</a> >> <a href="Admin_ItemModify.asp">基本设置</a> >> <font color=red>列表设置</font> >> 链接设置 >> 正文设置 >> 采样测试 >> 属性设置 >> 完成</td>
</tr>
</table>
<br>
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border" >
<form method="post" action="Admin_ItemAddNew3.asp" name="form1">
<tr class="tdbg">
<td height="22" colspan="2" class="title"> <div align="center"><strong> 项 目 编 辑--采集目标网页 </strong> <Input type="radio" value="0" name="page" onClick="javascript:ShowPage.style.display='none';" checked>不查看
<Input type="radio" value="1" name="page" onClick="javascript:ShowPage.style.display='';javascript:setFileFileds('<%=ListStr%>');" >查看网页
</div></td>
</tr>
<tr class="tdbg" id="ShowPage" style="display:'none'">
<td class='tdbg' colspan='2' align='center' id='objFiles'></td>
</tr>
<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">
<%=Replace(Replace(ListCode, "</textarea>", "</textarea>"),"</TEXTAREA>","</TEXTAREA>")%>
</textarea>
</td>
</tr>
<tr class="tdbg">
<td width="20%" class="tdbg" ><strong>列表开始标记：</strong></td>
<td class="tdbg" width="75%">
<textarea name="LsString" cols="49" rows="7"></textarea> <input TYPE='button' value='测试代码' onCLICK='ceshi(1)' ><br>
</td>
</tr>
<tr class="tdbg">
<td width="20%" class="tdbg" ><strong>列表结束标记：</strong></td>
<td class="tdbg" width="75%">
<textarea name="LoString" cols="49" rows="7"></textarea> <input TYPE='button' value='测试代码' onCLICK='ceshi(2)' ><br>
</td>
</tr>
<tr>
<td width="150" class="tdbg" align="center"><strong> 列表索引分页： </strong></td>
<td class="tdbg" >
<input type="radio" value="0" name="ListPaingType"checked onClick="javascript:ListPaing1.style.display='none';ListPaing12.style.display='none';ListPaing2.style.display='none';ListPaing3.style.display='none'">不作设置
<input type="radio" value="1" name="ListPaingType" onClick="javascript:ListPaing1.style.display='';ListPaing12.style.display='';ListPaing2.style.display='none';ListPaing3.style.display='none'">设置标签
<input type="radio" value="2" name="ListPaingType" onClick="javascript:ListPaing1.style.display='none';ListPaing12.style.display='none';ListPaing2.style.display='';ListPaing3.style.display='none'">批量生成
<input type="radio" value="3" name="ListPaingType" onClick="javascript:ListPaing1.style.display='none';ListPaing12.style.display='none';ListPaing2.style.display='none';ListPaing3.style.display=''">手动添加
</td>
</tr>
<tr class="tdbg" id="ListPaing1" style="display:'none'">
<td width="150" class="tdbg" align="center"><strong>下页开始标记：</strong><br><br><br><br><br><br>
<strong>下页结束标记：</font></strong>
</td>
<td class="tdbg" >
<textarea name="LPsString" style='width:450px;height:100px'></textarea> <input TYPE='button' value='测试代码' onCLICK='ceshi(3)' ><br>
<textarea name="LPoString" style='width:450px;height:100px'></textarea> <input TYPE='button' value='测试代码' onCLICK='ceshi(4)' >
</td>
</tr>
<tr class="tdbg" id="ListPaing12" style="display:'none'">
<td width="150" class="tdbg" align="center"><strong>索引分页重定向： </strong></td>
<td class="tdbg" >
<input name="ListPaingStr1" type="text" size="60" maxlength="200" value=>
<br><font color=#0099FF>一般不会用到，如果采集分页很纵深，并且下一页代码是相对路径。
<br>在下一步链接设置分析到的下一页列表的URL和实际不符，应用此功能。
<br>在列表设置捕获相对路径，如果是动态页捕获ID。
<br>例：在索引分页中填写实际路径 http://www.xxxxx.com/xxx/xx/xxx/news/{$ID} {$ID}就是列表捕获的相对路径或动态ID。</font>
<br>系统能智能分析网站的相对路径，如果特殊情况分析不对，请按上述步骤使用此功能。 </td>
</tr>
<tr class="tdbg" id="ListPaing2" style="display:'none'">
<td width="150" class="tdbg" align="center"><strong>批量生成： </strong></td>
<td class="tdbg" >原字符串：<br>
<input name="ListPaingStr2" type="text" size="60" maxlength="200" value=><br>
<font color=#0099FF>例：http://www.xxxxx.com/news/index_{$ID}.html {$ID}代表分页数</font><br>
生成范围：<br>
<input name="ListPaingID1" type="text" size="8" maxlength="200" value=><span lang="en-us"> To </span><input name="ListPaingID2" type="text" size="8" maxlength="200" value=>
<font color=#0099FF>例： 1 ~ 9 或 9 ~ 1 升序或倒序采集</font><br>
</td>
</tr>
<tr class="tdbg" id="ListPaing3" style="display:'none'">
<td width="150" class="tdbg" align="center"><strong>手动添加： </strong></td>
<td class="tdbg" >
<textarea name="ListPaingStr3" style='width:450px;height:100px'></textarea>
<br><font color=#0099FF>注：一行写一个网页地址</font>
</td>
</tr>
<tr class="tdbg">
<td colspan="2" align="center" class="tdbg">
<input type="button" name="button1" value="上 一 步" onClick="window.location.href='javascript:history.go(-1)'" style="cursor: hand;background-color: #cccccc;"><input name="ItemID" type="hidden" value="<%=ItemID%>">
<input type="submit" name="Submit" value="下 一 步" style="cursor: hand;background-color: #cccccc;"></td>
</tr>
</form>
</table>
<!--#include file="Admin_ItemFoot.asp"-->
</body>
</html>
<%End Sub%>⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?