admin_itemmodify4.asp

来自「全球商务网站系统介绍 GLOBALEC.COM.CN[生成HTML版] 」· ASP 代码 · 共 572 行 · 第 1/2 页

      <td class="tdbg" >
        <input type="radio" value="0" name="NewsPaingType" <%If NewsPaingType=0 Then Response.Write "checked"%> onClick="javascript:NewsPaing1.style.display='none';NewsPaing2.style.display='none'">不作设置&nbsp;
        <input type="radio" value="1" name="NewsPaingType" <%If NewsPaingType=1 Then Response.Write "checked"%> onClick="javascript:NewsPaing1.style.display='';NewsPaing2.style.display='none'">设置标签&nbsp;
       </td>
    </tr>
    <tr class="tdbg" id="NewsPaing1" style="display:'<%If NewsPaingType<>1 Then Response.Write "none"%>'">
      <td width="150" class="tdbg" align='center'><strong>下页开始标记：</font></strong><br><br><br><br><br><br>
        <strong>下页结束标记：</font></strong></td>
      <td class="tdbg" >
        <textarea name="NPsString" style='width:450px;height:100px'><%=NPsString%></textarea>&nbsp;<input TYPE='button' value='测试代码' onCLICK='ceshi(15)' ><br>
        <textarea name="NPoString" style='width:450px;height:100px'><%=NPoString%></textarea>&nbsp;<input TYPE='button' value='测试代码' onCLICK='ceshi(16)' ></td>
    </tr>
    <tr class="tdbg" id="NewsPaing2" style="display:'<%If NewsPaingType<>2 Then Response.Write "none"%>'"> 
      <td width="20%" class="tdbg"><strong><font color=blue>手&nbsp; 动&nbsp; 设&nbsp; 置：</font></strong></td>
      <td class="tdbg" width="75%">
		<input name="NewsPaingStr2" type="text" value="预留功能" size="58">
      </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';">不作分析&nbsp;
     <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>向前代码&nbsp;
     <Input TYPE='radio' NAME='AnalyseWay' value='1'>向后代码&nbsp;
     <Input TYPE='radio' NAME='AnalyseWay' value='2'>前后代码&nbsp;
    字符数：
     <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" class="tdbg"><br>
        <input name="Action" type="hidden" id="Action" value="SaveEdit">
        <input name="ItemID" type="hidden" id="ItemID" value="<%=ItemID%>">
        <input  type="button" name="button1" value="上&nbsp;一&nbsp;步" onClick="window.location.href='javascript:history.go(-1)'"  style="cursor: hand;background-color: #cccccc;">
        &nbsp;&nbsp;&nbsp;&nbsp; 
        <input  type="submit" name="Submit" value="下&nbsp;一&nbsp;步" style="cursor: hand;background-color: #cccccc;"></td>
        <input type="hidden" name="UrlTest" id="UrlTest" value="<%=UrlTest%>">
    </tr>
</table>
</form>
<!--#include file="Admin_ItemFoot.asp"-->          
</body>         
</html>
<%End Sub%>
<%
Sub SaveEdit
   HsString=Request.Form("HsString")
   HoString=Request.Form("HoString")
   HttpUrlType=Trim(Request.Form("HttpUrlType"))
   HttpUrlStr=Trim(Request.Form("HttpUrlStr"))

   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 ItemID,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
      RsItem.UpDate
      RsItem.Close
      Set RsItem=Nothing
   End If
End Sub

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")
      TsString=RsItem("TsString")
      ToString=RsItem("ToString")
      CsString=RsItem("CsString")
      CoString=RsItem("CoString")
      
      DateType=RsItem("DateType")
      DsString=RsItem("DsString")
      DoString=RsItem("DoString")
      
      AuthorType=RsItem("AuthorType")
      AsString=RsItem("AsString")
      AoString=RsItem("AoString")
      AuthorStr=RsItem("AuthorStr")

      CopyFromType=RsItem("CopyFromType")
      FsString=RsItem("FsString")
      FoString=RsItem("FoString")
      CopyFromStr=RsItem("CopyFromStr")

      KeyType=RsItem("KeyType")
      KsString=RsItem("KsString")
      KoString=RsItem("KoString")
      KeyStr=RsItem("KeyStr")

      NewsPaingType=RsItem("NewsPaingType")
      NPsString=RsItem("NPsString")
      NPoString=RsItem("NPoString")
      NewsPaingStr=RsItem("NewsPaingStr")
      NewsPaingHtml=RsItem("NewsPaingHtml")
   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
      End If      
      If  ListPaingStr1<>""  And  Len(ListPaingStr1)<15  Then
         FoundErr=True
         ErrMsg=ErrMsg & "<br><li>索引分页重定向设置不正确！</li>"
            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
   End If

      If  FoundErr<>True  And Action<>"SaveEdit" And  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
         ListCode=GetBody(ListCode,LsString,LoString,False,False)
         If ListCode="$False$" Then
            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
      NewsArrayCode=GetArray(ListCode,HsString,HoString,False,False)
      If NewsArrayCode="$False$" Then
         FoundErr=True
         ErrMsg=ErrMsg & "<br><li>在分析：" & ListUrl & "信息列表时发生错误！</li>"
      Else
         NewsArray=Split(NewsArrayCode,"$Array$")
         If IsArray(NewsArray)=True Then
            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>在分析：" & ListUrl & "信息列表时发生错误！</li>"
         End If            
      End If
   End If 
End Sub
%>