collect_itemmodify3.asp

来自「SK信息采集2.0功能介绍: 1.可针对任何静态网页,动态网页进行采集。包括h」· ASP 代码 · 共 410 行 · 第 1/2 页

					   ErrMsg = ErrMsg & "<br><li>索引分页重定向设置不正确(至少15个字符)</li>"
					End If
			  End If
		   Case 2
			  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
		   Case 3
			  If ListPageStr3 = "" Then
				 FoundErr = True
				 ErrMsg = ErrMsg & "<br><li>列表索引分页不能为空，请手动添加</li>"
			  Else
				 ListPageStr3 = Replace(ListPageStr3, Chr(13), "|")
			  End If
		   Case Else
			  FoundErr = True
			  ErrMsg = ErrMsg & "<br><li>请选择列表索引分页类型</li>"
		   End Select
		End If
		
		If FoundErr <> True Then
		   SqlItem = "Select * From KS_CollectItem Where ItemID=" & ItemID
		   Set RsItem = Server.CreateObject("adodb.recordset")
		   RsItem.Open SqlItem, ConnItem, 2, 3
		
		   RsItem("LsString") = LsString
		   RsItem("LoString") = LoString
		   RsItem("ListPageType") = ListPageType
		   RsItem("ListStr") = ListStr
		   Select Case ListPageType
		   Case 0, 1
			  If ListPageType = 1 Then
				 RsItem("LPsString") = LPsString
				 RsItem("LPoString") = LPoString
				 RsItem("ListPageStr1") = ListPageStr1
			  End If
		   Case 2
			  RsItem("ListPageStr2") = ListPageStr2
			  RsItem("ListPageID1") = ListPageID1
			  RsItem("ListPageID2") = ListPageID2
		   Case 3
			  RsItem("ListPageStr3") = ListPageStr3
		   End Select
		   RsItem.Update
		   RsItem.Close
		   Set RsItem = Nothing
		End If
		End Sub
		
		
		'==================================================
		'过程名：GetTest
		'作  用：测试
		'参  数：无
		'==================================================
		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")
		   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 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
				 If ListPageStr1 <> "" And Len(ListPageStr1) < 15 Then
					FoundErr = True
					ErrMsg = ErrMsg & "<br><li>索引分页绝对链接设置不正确(请留空或者字符>15个)！</li>"
				 End If
			  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 = ListStr
				 '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
		
			  If 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
		   End If
		   If FoundErr <> True Then
			  ListCode = KMCObj.GetHttpPage(ListUrl)
			  If ListCode <> "Error" Then
				 If ListPageType = 1 Then
					ListPageNext = KMCObj.GetPage(ListCode, LPsString, LPoString, False, False)
					If ListPageNext <> "Error" Then
					   If ListPageStr1 <> "" Then
						  ListPageNext = Replace(ListPageStr1, "{$ID}", ListPageNext)
					   Else
						  ListPageNext = KMCObj.DefiniteUrl(ListPageNext, ListUrl)
					   End If
					End If
				 End If
				 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
		End Sub	
End Class
%>