collect_itemmodify4.asp

SK信息采集2.0功能介绍: 1.可针对任何静态网页,动态网页进行采集。包括htm,html,shtml,ASP,ASPX,JSP,PHP等。 2.增加自定文件采集.用户可采集网页中的所有文件.

		   Response.Write "   <td width=""75%"">"
		   Response.Write "     <input name=""NewsPageStr2"" type=""text"" value=""预留功能"" size=""58"">      </td>"
		   Response.Write " </tr>"
		
		   Response.Write " <tr>"
		   Response.Write "   <td height=""30"" colspan=""2"" align=""center""><br>"
		   Response.Write "     <input name=""Action"" type=""hidden"" id=""Action"" value=""SaveEdit"">"
		   Response.Write "     <input name=""ItemID"" type=""hidden"" id=""ItemID"" value=""" & ItemID & """>"
		   Response.Write "     <input  type=""button"" name=""button1"" value=""上&nbsp;一&nbsp;步"" onClick=""window.location.href='javascript:history.go(-1)'""  >"
		   Response.Write "     &nbsp;&nbsp;&nbsp;&nbsp;"
			Response.Write "  <input  type=""submit"" name=""Submit"" value=""下&nbsp;一&nbsp;步""></td>"
			Response.Write "    <input type=""hidden"" name=""UrlTest"" id=""UrlTest"" value=""" & UrlTest & """ >"
			Response.Write "</tr>"
		Response.Write "</table>"
		Response.Write "</form>"
		Response.Write "<br>"
		Response.Write "<table width=""85%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""1"" class=""border"" >"
		Response.Write "  <tr>"
		 Response.Write "   <td height=""22"" colspan=""2"" class=""title""><div align=""center""><strong>列 表 新 闻 链 接 测 试</strong></div></td>"
		Response.Write "  </tr>"
		Response.Write "</table>"
		Response.Write "<table width=""70%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""1"" class=""border"" >"
		Response.Write "  <tr>"
		 Response.Write "   <td height=""22"" colspan=""2"">以下是分析后所得到的新闻绝对链接地址，请查看是否正确。下一步将抽取第一条新闻进行测试，在填写以上标记时尽量不要使用第一条新闻<br>"
				
		For Testi = 0 To UBound(NewsArray)
		   Response.Write "<a href='" & NewsArray(Testi) & "' target=_blank>" & NewsArray(Testi) & "</a><br>"
		Next
		
		  Response.Write "      <br></td>"
		  Response.Write "</tr>"
		Response.Write "</table>"
		Response.Write "</body>"
		Response.Write "</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 KS_CollectItem 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 KS_CollectItem 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")
			  ListPageType = RsItem("ListPageType")
			  LPsString = RsItem("LPsString")
			  LPoString = RsItem("LPoString")
			  ListPageStr1 = RsItem("ListPageStr1")
			  ListPageStr2 = RsItem("ListPageStr2")
			  ListPageID1 = RsItem("ListPageID1")
			  ListPageID2 = RsItem("ListPageID2")
			  ListPageStr3 = RsItem("ListPageStr3")
			  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")
		
			  NewsPageType = RsItem("NewsPageType")
			  NPsString = RsItem("NPsString")
			  NPoString = RsItem("NPoString")
			  NewsPageStr = RsItem("NewsPageStr")
			  NewsPageEnd = RsItem("NewsPageEnd")
		   End If
		   RsItem.Close
		   Set RsItem = Nothing
		    if isnull(NewsPageEnd) then NewsPageEnd=""
			if isnull(NewsPageStr) then NewsPageStr=""
			if isnull(NPsString)   then NPsString=""
			if isnull(NPoString)   then NPoString=""
		
		   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 ListPageType = 0 Or ListPageType = 1 Then
			  If ListStr = "" Then
				 FoundErr = True
				 ErrMsg = ErrMsg & "<br><li>列表索引页不能为空！</li>"
			  End If
			  If ListPageType = 1 Then
				 If LPsString = "" Or LPoString = "" Then
					FoundErr = True
					ErrMsg = ErrMsg & "<br><li>索引分页开始、结束标记不能为空！</li>"
				 End If
			  End If
			  If ListPageStr1 <> "" And Len(ListPageStr1) < 15 Then
				 FoundErr = True
				 ErrMsg = ErrMsg & "<br><li>索引分页重定向设置不正确！</li>"
					End If
		   ElseIf ListPageType = 2 Then
			  If ListPageStr2 = "" Then
				 FoundErr = True
				 ErrMsg = ErrMsg & "<br><li>批量生成原字符串不能为空！</li>"
			  End If
			  If IsNumeric(ListPageID1) = False Or IsNumeric(ListPageID2) = False Then
				 FoundErr = True
				 ErrMsg = ErrMsg & "<br><li>批量生成的范围只能是数字！</li>"
			  Else
				 ListPageID1 = CLng(ListPageID1)
				 ListPageID2 = CLng(ListPageID2)
				 If ListPageID1 = 0 And ListPageID2 = 0 Then
					FoundErr = True
					ErrMsg = ErrMsg & "<br><li>批量生成的范围不正确！</li>"
				 End If
			  End If
		   ElseIf ListPageType = 3 Then
			  If ListPageStr3 = "" 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 ListPageType
			  Case 0, 1
					ListUrl = ListStr
			  Case 2
				 ListUrl = Replace(ListPageStr2, "{$ID}", CStr(ListPageID1))
			  Case 3
				 If InStr(ListPageStr3, "|") > 0 Then
					ListUrl = Left(ListPageStr3, InStr(ListPageStr3, "|") - 1)
				 Else
					ListUrl = ListPageStr3
				 End If
			  End Select
		   End If
		
			  If FoundErr <> True And Action <> "SaveEdit" And LoginType = 1 Then
			  LoginData = KMCObj.UrlEncoding(LoginUser & "&" & LoginPass)
			  LoginResult = KMCObj.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 = KMCObj.GetHttpPage(ListUrl)
			  If ListCode <> "Error" Then
				 ListCode = KMCObj.GetBody(ListCode, LsString, LoString, False, False)
				 If ListCode = "Error" 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 = KMCObj.GetArray(ListCode, HsString, HoString, False, False)
			  If NewsArrayCode = "Error" 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) = KMCObj.DefiniteUrl(NewsArray(Testi), ListUrl)
					   End If
					Next
					UrlTest = NewsArray(0)
					NewsCode = KMCObj.GetHttpPage(UrlTest)
				 Else
					FoundErr = True
					ErrMsg = ErrMsg & "<br><li>在分析：" & ListUrl & "新闻列表时发生错误！</li>"
				 End If
			  End If
		   End If
		End Sub
End Class
%>