⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 sk_gethy.asp

📁 清风信息自动采集生成系统 很好用的大家试试看
💻 ASP
📖 第 1 页 / 共 5 页
字号:
End If
End Sub'第二完

Sub demo()'测试页
	If ItemID="" Then
	   FoundErr=True
	   ErrMsg=ErrMsg & "<br><li>参数错误,项目ID不能为空</li>"
	Else
	   ItemID=Clng(ItemID)
	End If
	If FoundErr<>True Then
		Req_Err_msg 3
	End If
	If FoundErr<>True And Action="demo" And Action1=""  Then
	   SK.GetTest()
	End If
	
If FoundErr=True Then
   Call WriteErrMsg(ErrMsg)
Else
If Action1="" And Action="demo" Or Skcj.G("ShowCode")="checkbox" Then
%>
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="tableBorder"  >
    <tr> 
      <td height="22" colspan="2" class="title"> <div align="center"><strong>编 辑 项 目--采 样 测 试</strong></div></td>
    </tr>
</table>

<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="tableBorder" >
  <tr align="center" class="tdbg"> 
    <td colspan="2" valign="bottom"><span lang="zh-cn">
	<%=Title%></span></td>
  </tr>
  <tr align="center" class="tdbg">
    <td colspan="2">
        <strong>作者:</strong><%=Author%>&nbsp;&nbsp;<strong>来源:</strong><%=CopyFrom%>&nbsp;&nbsp;<strong>更新时间:</strong><%=UpDateTime%>
    </td>
  </tr>
  <tr class="tdbg">
    <td colspan="2">
      <table width="100%" height="100%" border="0" cellpadding="0" cellspacing="5">
        <tr>
          <td height="200" valign="top">
		  <%
		  If x_tp=1 Then
		  	Response.Write "<B>列表小图片地址:</b>"
		 	 Response.Write "<a href="& picpath &" target=""_blank"">"& picpath &"<a/>"
		  End If
		  Response.Write "<br><strong>"& CjName &"内容:</strong>" & Server.HtmlEncode(Content) &""
		  Response.Write "<br><b>关键字:</b>" & Server.HtmlEncode(Key) &"<br>"
		  '-------------------自定义--------------------------
		  If SK.GeU_WUrl=1 then
			  Dim  DiyFieldSTR,Diy_Arr,DiyField_Arr
			  '最终页
			  DiyFieldSTR=Sk.GetDiyField_STR(ItemID,1,Colleclx)'取得采集字符串
			  If DiyFieldSTR<>"" then
				  Diy_Arr=Split(DiyFieldSTR,"{$SK$}")
				  For Testi=0 To Ubound(Diy_Arr) -1
					 DiyField_Arr=Split(Diy_Arr(Testi),"{|}")
					 Response.Write "<B>"& DiyField_Arr(0) &":</B>" & Server.HtmlEncode(DiyField_Arr(1)) &"<BR>"
				  Next
			  End if
		  End If	  
	      '-------------------自定义--------------------------
		  %>
          </td>
        </tr>
      </table>
    </td>
  </tr>
  <form method="post" action="<%= CJFileName  %>" name="form1">
  <tr class="tdbg">
  	<td colspan="2" align="center">
	    <input name="Cancel" class="lostfocus" type="button"  value=" 上&nbsp;一&nbsp;步 " onClick="window.location.href='javascript:history.go(-1)'" style="cursor: hand;background-color: #cccccc;">&nbsp;&nbsp;<input  type="submit" name="Submit" class="lostfocus" value=" 设置完成&nbsp; " style="cursor: hand;background-color: #cccccc;">
	</td>
  </tr>
  </form>
</table>
<%
else
%>
<table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="tableBorder" >
  
  <tr class="tdbg">
    <td colspan="2">
      <table width="100%" height="100%" border="0" cellpadding="0" cellspacing="5">
        <tr>
          <td height="30" valign="top"><a href="?action=demo&ItemID=<%= ItemID %>">点击查看测试页</a></td>
        </tr>
      </table>    </td>
  </tr>
  <form method="post" action="<%= CJFileName  %>" name="form1">
  <tr class="tdbg">
  	<td colspan="2" align="center">
	    <input name="Cancel" class="lostfocus" type="button"  value=" 上&nbsp;一&nbsp;步 " onClick="window.location.href='javascript:history.go(-1)'" style="cursor: hand;background-color: #cccccc;">&nbsp;&nbsp;<input  type="submit" name="Submit" class="lostfocus" value=" 设置完成&nbsp; " style="cursor: hand;background-color: #cccccc;">	</td>
  </tr>
  </form>
</table>

<%
End If
End If
End Sub

Sub copy
	ItemID=Skcj.G("ItemID")
	If ItemID="" Then
		  FoundErr=True
		  ErrMsg=ErrMsg & "<br><li>请选择要删除的项目!</li>"
	   Else
		Dim copy_s,copyitem(99999)
		SqlItem="Select top 1 * from Item where ItemID="& ItemID
		Set RsItem=server.CreateObject("adodb.recordset")
		RsItem.Open SqlItem,ConnItem,3,3
		copy_s =Cint(RsItem.Fields.count)
		for i=1 to copy_s - 1
		copyitem(i)=RsItem(i)
		next
		RsItem.AddNew
		for i=1 to copy_s - 1
		RsItem(i)=copyitem(i)
		RsItem(1)=copyitem(1) & " 复制"
		next
		RsItem.update
		RsItem.close
		Call show_Manage()
	End If
End Sub

Sub Del
ItemID=Skcj.G("ItemID")
If Skcj.G("Del")="快速采集" Then
	Response.redirect "Sk_CollectionFast.asp?ItemID="&ItemID&"&ItemNum=1&ListNum=1&NewsSuccesNum=0&NewsFalseNum=0&ImagesNumAll=0&NewsNum_i=0"
Else
	If Skcj.G("Del")="清空所有记录" Then
	   ConnItem.Execute("Delete From Item")
	   ConnItem.Execute("Delete From Filters")
	   ConnItem.Execute("Delete From Histroly")
	Else
	   If ItemID="" Then
		  FoundErr=True
		  ErrMsg=ErrMsg & "<br><li>请选择要删除的项目!</li>"
	   Else
		  ItemID=Replace(ItemID," ","")   
		  ConnItem.Execute("Delete From [Item] Where ItemID In(" & ItemID & ")")
		  ConnItem.Execute("Delete From [Filters] Where ItemID In(" & ItemID & ")")
		  ConnItem.Execute("Delete From [Histroly] Where ItemID In(" & ItemID & ")")
	   End If
	End  If
End If	
Call show_Manage()
End Sub
	'================================================
	'函数名:Req_Err_msg
	'作  用:检查提交设置并保存
	'参  数:erron   ----第几步
	'================================================
	Public Sub Req_Err_msg(erron)
	select case erron
	case 1
		ItemName=Trim(Request.Form("ItemName"))
		ChannelID=Trim(Request.Form("ChannelID"))
		ClassID=Trim(Request.Form("ClassID"))
		SpecialID=Trim(Request.Form("SpecialID"))
		selEncoding=Trim(Request.Form("selEncoding"))
		Colleclx=Trim(Request.Form("Colleclx"))
		ListStr=Trim(Request.Form("ListStr"))
		ListPaingType=Trim(Request.Form("ListPaingType"))
		ListPaingStr2=Trim(Request.Form("ListPaingStr2"))
		ListPaingID1=Trim(Request.Form("ListPaingID1"))
		ListPaingID2=Trim(Request.Form("ListPaingID2"))
		ListPaingStr3=Trim(Request.Form("ListPaingStr3"))
		Passed=Trim(Request.Form("Passed"))
		SaveFiles=Trim(Request.Form("SaveFiles"))
		Thumb_WaterMark=Request.Form("Thumb_WaterMark")
		SaveFileUrl=Trim(Request.Form("SaveFileUrl"))
		Script_Iframe=Trim(Request.Form("Script_Iframe"))
		Script_Object=Trim(Request.Form("Script_Object"))
		Script_Script=Trim(Request.Form("Script_Script"))
		Script_Div=Trim(Request.Form("Script_Div"))
		Script_Class=Trim(Request.Form("Script_Class"))
		Script_Span=Trim(Request.Form("Script_Span"))
		Script_Img=Trim(Request.Form("Script_Img"))
		Script_Font=Trim(Request.Form("Script_Font"))
		Script_A=Trim(Request.Form("Script_A"))
		Script_Html=Trim(Request.Form("Script_Html"))
		Script_Table=Trim(Request.Form("Script_Table"))
		Script_Tr=Trim(Request.Form("Script_Tr"))
		Script_Td=Trim(Request.Form("Script_Td"))
		Stars=Trim(Request.Form("Stars"))
		ReadPoint=Trim(Request.Form("ReadPoint"))
		Hits=Trim(Request.Form("Hits"))
		Colleclx=Request.Form("Colleclx")
		CollecNewsNum=Request.Form("CollecNewsNum")
		Timing=Trim(Request.Form("Timing"))
		strReplace=Trim(Request.Form("ReplaceList"))'内容替换
		If ItemName="" Then
		   FoundErr=True
		   ErrMsg=ErrMsg & "<br><li>项目名称不能为空</li>"
		End If
		If ClassID=0 Then
		   FoundErr=True
		   ErrMsg=ErrMsg & "<br><li>未指定栏目分类</li>"
		End If
		If ListStr="" Then
		   FoundErr=True
		   ErrMsg=ErrMsg & "<br><li>远程列表URL不能为空</li>" 
		End If
		If ListPaingType="" Then
		   FoundErr=True
		   ErrMsg=ErrMsg & "<br><li>请选择列表索引分页类型</li>" 
		Else
		   ListPaingType=Clng(ListPaingType)
		   Select Case ListPaingType
		   Case 0
		   Case 1
			  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 2
			  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 Stars="" Then
		   FoundErr=True
		   ErrMsg=ErrMsg & "<br><li>请选择文章评分等级!</li>"
		Else
		   Stars=Clng(Stars)
		End If
		If ReadPoint="" Then
		   ReadPoint=0
		Else
		   ReadPoint=Clng(ReadPoint)
		End If
		If Hits="" Then
		   Hits=0
		Else
		   Hits=Clng(Hits)
		End If
		'-----------------保存数据设置---------------------------------
		Dim Sqllx
		If FoundErr<>True Then
			If action1="add" Then sqllx="add" 
			If action1="edit" Then sqllx="edit"
			If sqllx <> "" And sqllx="edit" Or sqllx="add" Then
			If sqllx="add" Then 
				Sql="Select top 1 * from Item"
			Else
				S

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -