?? admin_itemaddnew4.asp
字號:
<!--#include file="inc/conn.asp"-->
<!--#include file="inc/function.asp"-->
<%
Dim ItemID
Dim RsItem,SqlItem,FoundErr,ErrMsg
Dim ListStr,LsString,LoString
Dim ListPaingType,LPsString,LPoString,ListPaingStr1,ListPaingStr2,ListPaingID1,ListPaingID2,ListPaingStr3,HsString,HoString,HttpUrlType,HttpUrlStr
Dim ListUrl,ListCode,NewsArrayCode,NewsArray,UrlTest,NewsCode
dim Testi
ItemID=Trim(Request("ItemID"))
HsString=Request.Form("HsString")
HoString=Request.Form("HoString")
HttpUrlType=Trim(Request.Form("HttpUrlType"))
HttpUrlStr=Trim(Request.Form("HttpUrlStr"))
If ItemID="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>參數錯誤，請從有效鏈接進入</li>"
Else
ItemID=Clng(ItemID)
End If
If HsString="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>鏈接開始標記不能為空</li>"
End If
If HoString="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>鏈接結束標記不能為空</li>"
End If
If HttpUrlType="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>請選擇鏈接處理類型</li>"
Else
HttpUrlType=Clng(HttpUrlType)
If HttpUrlType=1 Then
If HttpUrlStr="" Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>絕對鏈接字符設置不能為空</li>"
Else
If Len(HttpUrlStr)<15 Then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>絕對鏈接字符設置不正確(15個字符以上)</li>"
End If
End If
End If
End If
If FoundErr<>True Then
SqlItem="Select ListStr,LsString,LoString,ListPaingType,LPsString,LPoString,ListPaingStr1,ListPaingStr2,ListPaingID1,ListPaingID2,ListPaingStr3,HsString,HoString,HttpUrlType,HttpUrlStr from Item Where ItemID=" & ItemID
Set RsItem=server.CreateObject("adodb.recordset")
RsItem.Open SqlItem,ConnItem,2,3
RsItem("HsString")=HsString
RsItem("HoString")=HoString
RsItem("HttpUrlType")=HttpUrlType
If HttpUrlType=1 Then
RsItem("HttpUrlStr")=HttpUrlStr
End If
ListStr=RsItem("ListStr")
LsString=RsItem("LsString")
LoString=RsItem("LoString")
ListPaingType=RsItem("ListPaingType")
LPsString=RsItem("LPsString")
ListPaingStr1=RsItem("ListPaingStr1")
ListPaingStr2=RsItem("ListPaingStr2")
ListPaingID1=RsItem("ListPaingID1")
ListPaingID2=RsItem("ListPaingID2")
ListPaingStr3=RsItem("ListPaingStr3")
RsItem.UpDate
RsItem.Close
Set RsItem=Nothing
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=NewsArray(1)
End If
End Select
ListCode=GetHttpPage(ListUrl)
If ListCode<>"$False$" Then
ListCode=GetBody(ListCode,LsString,LoString,False,False)
If ListCode<>"$False$" Then
NewsArrayCode=GetArray(ListCode,HsString,HoString,False,False)
If NewsArrayCode<>"$False$" Then
NewsArray=Split(NewsArrayCode,"$Array$")
For Testi=0 To Ubound(NewsArray)
If HttpUrlType=1 Then
NewsArray(Testi)=Replace(HttpUrlStr,"{$ID}",NewsArray(Testi))
Else
NewsArray(Testi)=DefiniteUrl(NewsArray(Testi),ListUrl)
End If
Next
UrlTest=NewsArray(0)
NewsCode=GetHttpPage(UrlTest)
Else
FoundErr=True
ErrMsg=ErrMsg & "<br><li>在獲取鏈接列表時出錯。</li>"
End If
Else
FoundErr=True
ErrMsg=ErrMsg & "<br><li>在截取列表時發生錯誤。</li>"
End If
Else
FoundErr=True
ErrMsg=ErrMsg & "<br><li>在獲取:" & ListUrl & "網頁源碼時發生錯誤。</li>"
End If
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("測試失?。〈a有重復,開始或結束至少有一處代碼是唯一才有效！")
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -