admin_mov_add_04.asp

重庆宽频P2P电影小偷程序,可以做一个大型的电影站了

<%Sub Add4
Dim ListArrb,ListArrbt,Listarri,UrlTest,TestUrl
TestUrl=Trim(Request("TestUrl"))
if TestUrl="" then
	TestUrl=0
End if
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=ListPaingStr3
      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$")
               ListArrb="<option value=''>请选择要测试的正文页</option>"
               For Listarri=0 to Ubound(NewsArray)
               	ListArrbt=Trim(NewsArray(Listarri))
           	    If HttpUrlType=1 Then
           	       ListArrb=ListArrb&"<option value='1'>"&ListArrbt&"</option>"
           	    Else
           	       ListArrb=ListArrb&"<option value='"&Listarri&"'>"&ListArrbt&"</option>"
           	    End If
               Next
               If HttpUrlType=1 Then
           	      UrlTest=Trim(Replace(HttpUrlStr,"{$ID}",NewsArray(TestUrl)))
           	   Else
           	      UrlTest=Trim(DefiniteUrl(NewsArray(TestUrl),ListUrl))
           	   End If
               'Response.write ListArrb
         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)
	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 19
        huoqv=document.form1.BsStringb.value
    Case 20
        huoqv=document.form1.BoStringb.value
    Case 21
        huoqv=document.form1.YsStringb.value
    Case 22
        huoqv=document.form1.YoStringb.value
    Case 23
        huoqv=document.form1.PsStringb.value
    Case 24
        huoqv=document.form1.PoStringb.value
    Case 25
        huoqv=document.form1.HsStringb.value
    Case 26
        huoqv=document.form1.HoStringb.value
    Case 27
        huoqv=document.form1.JsStringb.value
    Case 28
        huoqv=document.form1.JoStringb.value
    Case 29
        huoqv=document.form1.SsStringb.value
    Case 30
        huoqv=document.form1.SoStringb.value
    Case 31
        huoqv=document.form1.ZsStringb.value
    Case 32
        huoqv=document.form1.ZoStringb.value
    Case 33
        huoqv=document.form1.DsStringb.value
    Case 34
        huoqv=document.form1.DoStringb.value
    Case 35
        huoqv=document.form1.LsStringb.value
    Case 36
        huoqv=document.form1.LoStringb.value
    Case 37
        huoqv=document.form1.MsStringb.value
    Case 38
        huoqv=document.form1.MoStringb.value
    Case 39
        huoqv=document.form1.DsStringbb.value
    Case 40
        huoqv=document.form1.DoStringbb.value
    Case 41
        huoqv=document.form1.QsStringb.value
    Case 42
        huoqv=document.form1.QoStringb.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