?? admin_itemmodify3.asp
字號:
<!--#include file="inc/conn.asp"-->
<!--#include file="inc/function.asp"-->
<%
Dim SqlItem,RsItem,ItemID,FoundErr,ErrMsg,Action
Dim ListStr,LsString,LoString,ListPaingType,LPsString,LPoString,ListPaingStr1,ListPaingStr2,ListPaingID1,ListPaingID2,ListPaingStr3
Dim LoginType,LoginUrl,LoginPostUrl,LoginUser,LoginPass,LoginFalse,LoginResult,LoginData
Dim HsString,HoString,HttpUrlType,HttpUrlStr
Dim ListUrl,ListCode,ListPaingNext
ItemID=Trim(Request("ItemID"))
Action=Trim(Request("Action"))
If ItemID="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>參數錯誤，項目ID不能為空！</li>"
Else
ItemID=Clng(ItemID)
End If
If Action="SaveEdit" And FoundErr<>True Then
Call SaveEdit()
End If
If FoundErr<>True Then
Call GetTest()
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">
</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_ItemModify.asp?ItemID=<%=ItemID%>">基本設置</a> >> <a href="Admin_ItemModify2.asp?ItemID=<%=ItemID%>">列表設置</a> >> <a href="Admin_ItemModify3.asp?ItemID=<%=ItemID%>"><font color=red>鏈接設置</font></a> >> <a href="Admin_ItemModify4.asp?ItemID=<%=ItemID%>">正文設置</a> >>
<a href="Admin_ItemModify5.asp?ItemID=<%=ItemID%>">采樣測試</a> >> <a href="Admin_ItemAttribute.asp?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 class="tdbg">
<td height="22" colspan="2" class="tdbg">
<%=ListCode%>
</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"><%=ListCode%></TEXTAREA></td>
</tr>
</table>
<%If ListPaingType=1 Then%>
<br>
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border" >
<tr class="tdbg">
<td height="22" colspan="2" class="tdbg" >
<%Response.Write "<br>下一頁列表：<a href='" & ListPaingNext & "' target=_blank><font color=red>" & ListPaingNext & "</font></a>"%>
</td>
</tr>
</table>
<br>
<%End If%>
<form method="post" action="Admin_ItemModify4.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>
<tr class="tdbg">
<td width="20%" class="tdbg" ><strong>鏈接開始標記：</strong></td>
<td class="tdbg" width="75%">
<textarea name="HsString" cols="49" rows="7"><%=HsString%></textarea></td>
</tr>
<tr class="tdbg">
<td width="20%" class="tdbg" ><strong>鏈接結束標記：</strong></td>
<td class="tdbg" width="75%">
<textarea name="HoString" cols="49" rows="7"><%=HoString%></textarea></td>
</tr>
<tr>
<td width="20%" class="tdbg"><strong> 鏈接特殊處理：</strong></td>
<td class="tdbg" width="75%">
<input type="radio" value="0" name="HttpUrlType" <%If HttpUrlType=0 Then Response.Write "checked"%> onClick="HttpUrl1.style.display='none'"> 自動處理
<input type="radio" value="1" name="HttpUrlType" <%If HttpUrlType=1 Then Response.Write "checked"%> onClick="HttpUrl1.style.display=''"> 重新定位
</td>
</tr>
<tr class="tdbg" id="HttpUrl1" style="display:'<%If HttpUrlType=0 Then Response.Write "none"%>'">
<td width="20%" class="tdbg"><strong>絕對鏈接字符：</strong></td>
<td class="tdbg" width="75%">
<input name="HttpUrlStr" type="text" size="49" maxlength="200" value="<%=HttpUrlStr%>"></td>
</tr>
<tr class="tdbg">
<td colspan="2" align="center" class="tdbg">
<input name="Action" type="hidden" id="Action" value="SaveEdit">
<input name="ItemID" type="hidden" id="ItemID" value="<%=ItemID%>">
<input type="button" name="button1" value="上 一 步" onClick="window.location.href='javascript:history.go(-1)'" style="cursor: hand;background-color: #cccccc;">
<input type="submit" name="Submit" value="下 一 步" style="cursor: hand;background-color: #cccccc;"></td>
</tr>
</table>
</form>
<!--#include file="Admin_ItemFoot.asp"-->
</body>
</html>
<%End Sub%>
<%
Sub SaveEdit
LsString=Request.Form("LsString")
LoString=Request.Form("LoString")
ListPaingType=Request.Form("ListPaingType")
LPsString=Request.Form("LPsString")
LPoString=Request.Form("LPoString")
ListPaingStr1=Trim(Request.Form("ListPaingStr1"))
ListPaingStr2=Trim(Request.Form("ListPaingStr2"))
ListPaingID1=Request.Form("ListPaingID1")
ListPaingID2=Request.Form("ListPaingID2")
ListPaingStr3=Request.Form("ListPaingStr3")
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 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=0 And ListPaingID2=0 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
If ListPaingType=1 Then
RsItem("LPsString")=LPsString
RsItem("LPoString")=LPoString
RsItem("ListPaingStr1")=ListPaingStr1
End If
Case 2
RsItem("ListPaingStr2")=ListPaingStr2
RsItem("ListPaingID1")=ListPaingID1
RsItem("ListPaingID2")=ListPaingID2
Case 3
RsItem("ListPaingStr3")=ListPaingStr3
End Select
RsItem.UpDate
RsItem.Close
Set RsItem=Nothing
End If
End Sub
'==================================================
'過程名：GetTest
'作 用：測試
'參 數：無
'==================================================
Sub GetTest
SqlItem="Select * from Item Where ItemID=" & ItemID
Set RsItem=server.CreateObject("adodb.recordset")
RsItem.Open SqlItem,ConnItem,1,1
If RsItem.Eof And RsItem.Bof Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>參數錯誤，項目ID不能為空</li>"
Else
LoginType=RsItem("LoginType")
LoginUrl=RsItem("LoginUrl")
LoginPostUrl=RsItem("LoginPostUrl")
LoginUser=RsItem("LoginUser")
LoginPass=RsItem("LoginPass")
LoginFalse=RsItem("LoginFalse")
ListStr=RsItem("ListStr")
LsString=RsItem("LsString")
LoString=RsItem("LoString")
ListPaingType=RsItem("ListPaingType")
LPsString=RsItem("LPsString")
LPoString=RsItem("LPoString")
ListPaingStr1=RsItem("ListPaingStr1")
ListPaingStr2=RsItem("ListPaingStr2")
ListPaingID1=RsItem("ListPaingID1")
ListPaingID2=RsItem("ListPaingID2")
ListPaingStr3=RsItem("ListPaingStr3")
HsString=RsItem("HsString")
HoString=RsItem("HoString")
HttpUrlType=RsItem("HttpUrlType")
HttpUrlStr=RsItem("HttpUrlStr")
End If
RsItem.Close
Set RsItem=Nothing
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=0 Or ListPaingType=1 Then
If ListStr="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>列表索引頁不能為空！</li>"
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
ElseIf ListPaingType=2 Then
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=0 And ListPaingID2=0 Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>批量生成的范圍不正確！</li>"
End If
End If
ElseIf ListPaingType=3 Then
If ListPaingStr3="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>索引分頁不能為空！</li>"
End If
Else
FoundErr=True
ErrMsg=ErrMsg & "<br><li>參數錯誤，請選擇索引分頁類型</li>"
End If
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
If FoundErr<>True Then
Select Case ListPaingType
Case 0,1
ListUrl=ListStr
Case 2
ListUrl=Replace(ListPaingStr2,"{$ID}",CStr(ListPaingID1))
Case 3
If Instr(ListPaingStr3,"|")> 0 Then
ListUrl=Left(ListPaingStr3,Instr(ListPaingStr3,"|")-1)
Else
ListUrl=ListPaingStr3
End If
End Select
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>登錄網站時發(fā)生錯誤，請確認登錄信息的正確性！</li>"
End If
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>在截取列表時發(fā)生錯誤。</li>"
End If
Else
FoundErr=True
ErrMsg=ErrMsg & "<br><li>在獲取:" & ListUrl & "網頁源碼時發(fā)生錯誤。</li>"
End If
End If
End Sub
%>
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -