system_gatherarticle.asp

网人分类信息5.0商业版。非常优秀的分类信息系统。比较少见。

	Content = Content & "<tr><td width='30%'><strong>分页开始代码</strong></td><td width='70%'><textaRea name=PNBegin cols=50 rows=5>"&PageNext(1)&"</textaRea></td></tr>" & vbCrLf
	Content = Content & "<tr><td><strong>分页结束代码</strong></td><td><textaRea name=PNEnd cols=50 rows=5>"&PageNext(2)&"</textaRea></td></tr>" & vbCrLf
	Content = Content & "<tr><td><strong>分页链接开始代码</strong></td><td><textaRea name=PNLBegin cols=50 rows=5>"&PageNext(3)&"</textaRea></td></tr>" & vbCrLf
	Content = Content & "<tr><td><strong>分页链接结束代码</strong></td><td><textaRea name=PNLEnd cols=50 rows=5>"&PageNext(4)&"</textaRea></td></tr>" & vbCrLf
	Content = Content & "</table></td></tr>" & vbCrLf
	Content = Content & "<tr class=td2><td><strong>时间设置</strong></td><td><input type=radio value=0 name=AddTime checked onClick=""AT1.style.display='none'""" & WRMPS.GetCheckVer(0, Int(Split(HtmlContent(2),Sign1)(0)), 1) & ">不作设置　<input type=radio value=1 name=AddTime onClick=""AT1.style.display=''""" & WRMPS.GetCheckVer(1, Int(Split(HtmlContent(2),Sign1)(0)), 1) & ">设置标签</td></tr>" & vbCrLf
	Content = Content & "<tr class=td2 id=AT1"
	If Int(Split(HtmlContent(2),Sign1)(0)) < 1 Then Content = Content & " style='display:none'"
	Content = Content & "><td colspan=2><table width='100%' border=0 cellspacing=0 cellpadding=0>"
	Content = Content & "<tr><td width='30%'><strong>时间开始代码</strong></td><td width='70%'><textaRea name=ATBegin cols=50 rows=5>"&Split(HtmlContent(2),Sign1)(1)&"</textaRea></td></tr>" & vbCrLf
	Content = Content & "<tr><td><strong>时间结束代码</strong></td><td><textaRea name=ATEnd cols=50 rows=5>"&Split(HtmlContent(2),Sign1)(2)&"</textaRea></td></tr>" & vbCrLf
	Content = Content & "</table></td></tr>" & vbCrLf
	Content = Content & "<tr class=td2><td><strong>作者设置</strong></td><td><input type=radio value=0 name=Author checked onClick=""AH1.style.display='none';AH2.style.display='none'""" & WRMPS.GetCheckVer(0, Int(Split(HtmlContent(3),Sign1)(0)), 1) & ">不作设置　<input type=radio value=1 name=Author onClick=""AH1.style.display='';AH2.style.display='none'""" & WRMPS.GetCheckVer(1, Int(Split(HtmlContent(3),Sign1)(0)), 1) & ">设置标签　<input type=radio value=2 name=Author onClick=""AH1.style.display='none';AH2.style.display=''""" & WRMPS.GetCheckVer(2, Int(Split(HtmlContent(3),Sign1)(0)), 1) & ">指定作者</td></tr>" & vbCrLf
	Content = Content & "<tr class=td2 id=AH1"
	If Int(Split(HtmlContent(3),Sign1)(0)) <> 1 Then Content = Content & " style='display:none'"
	Content = Content & "><td colspan=2><table width='100%' border=0 cellspacing=0 cellpadding=0>"
	Content = Content & "<tr><td width='30%'><strong>作者开始代码</strong></td><td width='70%'><textaRea name=AHBegin cols=50 rows=5>"&Split(HtmlContent(3),Sign1)(1)&"</textaRea></td></tr>" & vbCrLf
	Content = Content & "<tr><td><strong>作者结束代码</strong></td><td><textaRea name=AHEnd cols=50 rows=5>"&Split(HtmlContent(3),Sign1)(2)&"</textaRea></td></tr>" & vbCrLf
	Content = Content & "</table></td></tr>" & vbCrLf
    Content = Content & "<tr class=td2 id=AH2"
	If Int(Split(HtmlContent(3),Sign1)(0)) <> 2 Then Content = Content & " style='display:none'"
	Content = Content & "><td><strong>指定作者</strong></td><td><input name=AH maxlength=50 type=text size=30 value="""&Split(HtmlContent(3),Sign1)(1)&"""></td></tr>" & vbCrLf
	Content = Content & "<tr class=td2><td><strong>来源设置</strong></td><td><input type=radio value=0 name=CopyFrom checked onClick=""CF1.style.display='none';CF2.style.display='none'""" & WRMPS.GetCheckVer(0, Int(Split(HtmlContent(4),Sign1)(0)), 1) & ">不作设置　<input type=radio value=1 name=CopyFrom onClick=""CF1.style.display='';CF2.style.display='none'""" & WRMPS.GetCheckVer(1, Int(Split(HtmlContent(4),Sign1)(0)), 1) & ">设置标签　<input type=radio value=2 name=CopyFrom onClick=""CF1.style.display='none';CF2.style.display=''""" & WRMPS.GetCheckVer(2, Int(Split(HtmlContent(4),Sign1)(0)), 1) & ">指定来源</td></tr>" & vbCrLf
	Content = Content & "<tr class=td2 id=CF1"
	If Int(Split(HtmlContent(4),Sign1)(0)) <> 1 Then Content = Content & " style='display:none'"
	Content = Content & "><td colspan=2><table width='100%' border=0 cellspacing=0 cellpadding=0>"
	Content = Content & "<tr><td width='30%'><strong>来源开始代码</strong></td><td width='70%'><textaRea name=CFBegin cols=50 rows=5>"&Split(HtmlContent(4),Sign1)(1)&"</textaRea></td></tr>" & vbCrLf
	Content = Content & "<tr><td><strong>来源结束代码</strong></td><td><textaRea name=CFEnd cols=50 rows=5>"&Split(HtmlContent(4),Sign1)(2)&"</textaRea></td></tr>" & vbCrLf
	Content = Content & "</table></td></tr>" & vbCrLf
    Content = Content & "<tr class=td2 id=CF2"
	If Int(Split(HtmlContent(4),Sign1)(0)) <> 2 Then Content = Content & " style='display:none'"
	Content = Content & "><td><strong>指定来源</strong></td><td><input name=CF maxlength=50 type=text size=30 value="""&Split(HtmlContent(4),Sign1)(1)&"""></td></tr>" & vbCrLf
	Content = Content & "<tr class=td2><td><strong>关键字设置</strong></td><td><input type=radio value=0 name=Tags checked onClick=""Tag1.style.display='none';Tag2.style.display='none'""" & WRMPS.GetCheckVer(0, Int(Split(HtmlContent(5),Sign1)(0)), 1) & ">标题生成　<input type=radio value=1 name=Tags onClick=""Tag1.style.display='';Tag2.style.display='none'""" & WRMPS.GetCheckVer(1, Int(Split(HtmlContent(5),Sign1)(0)), 1) & ">设置标签　<input type=radio value=2 name=Tags onClick=""Tag1.style.display='none';Tag2.style.display=''""" & WRMPS.GetCheckVer(2, Int(Split(HtmlContent(5),Sign1)(0)), 1) & ">指定关键字</td></tr>" & vbCrLf
	Content = Content & "<tr class=td2 id=Tag1"
	If Int(Split(HtmlContent(5),Sign1)(0)) <> 1 Then Content = Content & " style='display:none'"
	Content = Content & "><td colspan=2><table width='100%' border=0 cellspacing=0 cellpadding=0>"
	Content = Content & "<tr><td width='30%'><strong>关键字开始代码</strong></td><td width='70%'><textaRea name=TagBegin cols=50 rows=5>"&Split(HtmlContent(5),Sign1)(1)&"</textaRea></td></tr>" & vbCrLf
	Content = Content & "<tr><td><strong>关键字结束代码</strong></td><td><textaRea name=TagEnd cols=50 rows=5>"&Split(HtmlContent(5),Sign1)(2)&"</textaRea></td></tr>" & vbCrLf
	Content = Content & "</table></td></tr>" & vbCrLf
    Content = Content & "<tr class=td2 id=Tag2"
	If Int(Split(HtmlContent(5),Sign1)(0)) <> 2 Then Content = Content & " style='display:none'"
	Content = Content & "><td><strong>指定关键字</strong></td><td><input maxlength=50 name=Tag type=text size=30 value="""&Split(HtmlContent(5),Sign1)(1)&"""><br>格式：关键字之间用<span class=font2>,</span>分隔，如：新闻,IT </td></tr>" & vbCrLf
	Content = Content & "<tr class=td2><td></td><td><input type=submit name=Submit value='下一步'>　　<input type=checkbox name=ShowCode value=1>显示源码</td></tr>" & vbCrLf
    Content = Content & "</form>" & vbCrLf
	Content = Content & "</table>" & vbCrLf
	Call ConnClose()
  
  Case "ItemTwo"
	If Ucase(Request("Save")) <> "NO" Then
      ItemName = WR.CheckStr(Request.Form("ItemName"), 0)
	  If ItemName = "" Then Call WRMPS.ErrView("·请输入项目名称", 0)
      ChannelID = WR.CheckStr(Request.Form("ChannelID"), 1)
	  If ChannelID = "" Then ChannelID = Null
	  ChannelID = GetChannerDir(ChannelID)
      ClassID = WR.CheckStr(Request.Form("ClassID"), 1)
      If ClassID = "" Or ChannelID = "" Then Call WRMPS.ErrView("·所属频道和所属栏目必选", 0)
	  ClassID = GetClassDir(ClassID,"WM_ArticleSort")
	  GUrl = WR.CheckStr(Request.Form("GUrl"), 0) 
	  If GUrl = "" Then Call WRMPS.ErrView("·请输入目标页URL", 0)
	  GEncoding = WR.CheckStr(Request.Form("GEncoding"), 0) 
	  ListType = WR.CheckStr(Request.Form("ListType"), 1) 
	  Select Case ListType
	   Case 0
	     ListStr = ""
	   Case 1
	     ListStr = WR.CheckStr(Request.Form("ListStr2"), 0)&"|"& WR.CheckStr(Request.Form("ListID1"), 1)&"|"& WR.CheckStr(Request.Form("ListID2"), 1) 
	     If WR.CheckStr(Request.Form("ListStr2"), 0) = "" or WR.CheckStr(Request.Form("ListID1"), 1) = "" or WR.CheckStr(Request.Form("ListID2"), 1) = "" Then Call WRMPS.ErrView("·你选择了批量生成分页，请做好相关设置", 0)
	   Case 2
	     ListStr = Request.Form("ListStr3")
	     If Request.Form("ListStr3") = "" Then Call WRMPS.ErrView("·你选择了手动添加分页地址，请做好相关设置", 0)
	  End Select
	  CollecNum = WR.CheckStr(Request.Form("CollecNum"), 1) 
	  Passed = WR.CheckStr(Request.Form("Passed"), 1)
	  If Passed = "" Then Passed = 0
	  SaveFiles = WR.CheckStr(Request.Form("SaveFiles"), 1) 
	  If SaveFiles = "" Then SaveFiles = 0
	  CReThumb = WR.CheckStr(Request.Form("CReateThumb"), 1) 
	  If CReThumb = "" Then CReThumb = 0
	  WaterMark = WR.CheckStr(Request.Form("WaterMark"), 1) 
	  If WaterMark = "" Then WaterMark = 0
	  CollecOrder = WR.CheckStr(Request.Form("CollecOrder"), 1) 
	  If CollecOrder = "" Then CollecOrder = 0
	  Timing = WR.CheckStr(Request.Form("Timing"), 1) 
	  If Timing = "" Then Timing = 0
	  Leach = "|"&Replace(WR.CheckStr(Replace(Request.Form("Leach")," ",""), 0),",","|")&"|"
	  Displace = WR.CheckStr(Request.Form("Displace"),2)
	  If CollecNum = "" Then CollecNum = 0
	  BaseSetting = GUrl&"§§§"&GEncoding&"§§§"&ListType&"§§§"&ListStr&"§§§"&CollecNum&"§§§"&Passed&"§§§"&SaveFiles&"§§§"&WaterMark&"§§§"&CollecOrder&"§§§"&Leach&"§§§"&Displace&"§§§"&CReThumb
    End If
	Call ConnOpen()
	If ID <> "" Then
	  If Ucase(Request("Save")) <> "NO" Then Gconn.Execute("Update WR_Item Set WR_ChannelID='"&ChannelID&"',WR_Class='"&ClassID&"',WR_Name='"&ItemName&"',WR_BaseSetting='"&BaseSetting&"',WR_Timing="&Timing&" Where WR_ID="&ID&"")
	Else
	  If Ucase(Request("Save")) <> "NO" Then Gconn.Execute("insert into WR_Item(WR_Name,WR_ChannelID,WR_Class,WR_Area,WR_BaseSetting,WR_Timing,WR_Key,WR_Module)values('"&ItemName&"','"&ChannelID&"','"&ClassID&"',0,'"&BaseSetting&"',"&Timing&",0,"&Module&")")
      Set Grs = Gconn.Execute("Select Top 1 WR_ID From WR_Item Order By WR_ID Desc")
	  If Not Grs.Eof Then
	    ID = Grs(0)
	  End If
	  Grs.Close
	End If
	Set Grs = Gconn.Execute("Select Top 1 WR_ListBegin,WR_ListEnd,WR_LinkBegin,WR_LinkEnd,WR_LinkReset From WR_Item Where WR_ID="&ID)
	If Not Grs.Eof Then
	  ListBegin = Grs(0)
	  ListEnd = Grs(1)
	  LinkBegin = Grs(2)
	  LinkEnd = Grs(3)
	  LinkReset = Grs(4)
	End If
	Grs.Close
	
	If LinkReset = "" Or IsNull(LinkReset) Then LinkReset = "0|"
	LinkReset = Split(LinkReset,"|")
    Content = Content & "<table width='100%' cellpadding=3 cellspacing=1 class=td1>" & vbCrLf
    Content = Content & "<form name=myform method='post' action='?Action=ItemThree&Page="&Page&"'>" & vbCrLf
	Content = Content & "<input name=ID type=hidden value=" & ID & ">" & vbCrLf
	If WR.CheckStr(Request.Form("ShowCode"), 1) = 1 Then
      Content = Content & "<tr class=td4><td colspan=2><strong>采集测试</strong></td></tr>" & vbCrLf
      Content = Content & "<tr class=td2><td colspan=2 align=center><textaRea style='width:100%;height:180'>"&WRMPS.GetHTMLEncode(GetHttpPage(GUrl,GEncoding))&"</textaRea><br>采集的目标地址：<a href="&GUrl&" target=_blank>"&GUrl&"</a>　<a href='view-source:"&GUrl&"' target=_blank>点击查看目标源代码</a></td></tr>" & vbCrLf
	End If 
	Call ConnClose()
	Content = Content & "<tr class=td4><td colspan=2><strong>采集项目设置 <a href=?Action=Item&ID="&ID&"&Page="&Page&">第一步</a> >> <a href=?Action=ItemTwo&ID="&ID&"&Save=NO&Page="&Page&"><span class=font2>第二步</span></a> >> <a href=?Action=ItemThree&ID="&ID&"&Save=NO&Page="&Page&">第三步</a> >> <a href=?Action=ItemTest&ShowCode=1&Save=No&ID="&ID&"&Page="&Page&">测试</a></strong></td></tr>" & vbCrLf
    Content = Content & "<tr class=td2><td width='30%'><strong>列表开始代码</strong></td><td width='70%'><textaRea name=ListBegin cols=50 rows=6>"&WRMPS.GetHTMLEncode(ListBegin)&"</textaRea></td></tr>" & vbCrLf
    Content = Content & "<tr class=td2><td><strong>列表结束代码</strong></td><td><textaRea name=ListEnd cols=50 rows=6>"&WRMPS.GetHTMLEncode(ListEnd)&"</textaRea></td></tr>" & vbCrLf
    Content = Content & "<tr class=td2><td><strong>链接开始代码</strong></td><td><textaRea name=LinkBegin cols=50 rows=6>"&WRMPS.GetHTMLEncode(LinkBegin)&"</textaRea></td></tr>" & vbCrLf
    Content = Content & "<tr class=td2><td><strong>链接结束代码</strong></td><td><textaRea name=LinkEnd cols=50 rows=6>"&WRMPS.GetHTMLEncode(LinkEnd)&"</textaRea></td></tr>" & vbCrLf
    Content = Content & "<tr class=td2><td><strong>重定链接地址</strong></td><td><input type=radio value=0 name=LinkReset onClick=""LinkR.style.display='none'""" & WRMPS.GetCheckVer(0, Int(LinkReset(0)), 1) & ">完整URL　<input type=radio value=1 name=LinkReset onClick=""LinkR.style.display=''""" & WRMPS.GetCheckVer(1, Int(LinkReset(0)), 1) & ">重新链接URL</td></tr>" & vbCrLf
    Content = Content & "<tr class=td2 id=LinkR"
	If Int(LinkReset(0)) = 0 Then Content = Content & " style='display:none'"
	Content = Content & "><td><strong>重定链接地址</strong></td><td><input name=LinkResetUrl type=text size=50 value="""&LinkReset(1)&"""><br>如：javascript:Openwin(""<span class=font2>8785</span>"") 或 <span class=font2>/show.asp?id=8785</span> 等<br>正确设置：<span class=font2>http://www.wangRen.net/{$Url}.html</span> 或 <span class=font2>http://www.wangRen.net/{$Url}</span></td></tr>" & vbCrLf
	Content = Content & "<tr class=td2><td></td><td><input type=submit name=Submit value='下一步'>　　<input type=checkbox name=ShowCode value=1>显示源码</td></tr>" & vbCrLf
    Content = Content & "</form>" & vbCrLf
	Content = Content & "</table>" & vbCrLf
	
  Case "Item"
	BaseSetting = "§§§GB2312§§§0§§§||§§§0§§§0§§§0§§§0§§§0§§§§§§§§§0"
    Timing = 0
    ClassID = 0
	AreaID = 0
	ChannelID = 0
	If ID <> "" Then 
	  Call ConnOpen()
	  Set Grs = Gconn.Execute("Select WR_Name,WR_Class,WR_Area,WR_BaseSetting,WR_Timing,WR_ChannelID From WR_Item Where WR_ID="&ID)
	  If Not Grs.Eof Then
	    ItemName = Grs(0)
		ClassID = Split(Grs(1),"|")(0)
		AreaID = Grs(2)
		BaseSetting = Grs(3)
		Timing = Grs(4)
		ChannelID = Split(Grs(5),"|")(0)
	  End If
	  Grs.Close
	  Set Grs = Nothing
	  Call ConnClose()
	End If
	BaseSetting = Split(BaseSetting,"§§§")
    Content = Content & "<table width='100%' cellpadding=3 cellspacing=1 class=td1>" & vbCrLf
    Content = Content & "<form name=myform method='post' action='?Action=ItemTwo&Page="&Page&"'>" & vbCrLf
	Content = Content & "<input name=ID type=hidden value=" & ID & ">" & vbCrLf
    If ID <> "" Then
	  Content = Content & "<tr class=td4><td colspan=2><strong>采集项目设置 <a href=?Action=Item&ID="&ID&"&Page="&Page&"><span class=font2>第一步</span></a> >> <a href=?Action=ItemTwo&ID="&ID&"&Save=NO&Page="&Page&">第二步</a> >> <a href=?Action=ItemThree&ID="&ID&"&Save=NO&Page="&Page&">第三步</a> >> <a href=?Action=ItemTest&ShowCode=1&Save=No&ID="&ID&"&Page="&Page&">测试</a></strong></td></tr>" & vbCrLf
	Else
	  Content = Content & "<tr class=td4><td colspan=2><strong>采集项目设置 <span class=font2>第一步</span> >> 第二步 >> 第三步 >> 测试</strong></td></tr>" & vbCrLf
	End If
    Content = Content & "<tr class=td3><td colspan=2><strong>基本信息</strong></td></tr>" & vbCrLf
    Content = Content & "<tr class=td2><td width='30%'><strong>项目名称</strong></td><td width='70%'><input name='ItemName' type='text' size=30 maxlength=50 Value="""&ItemName&"""> <font Class=Font2>*</font></td></tr>" & vbCrLf
    Content = Content & "<tr class=td2><td><strong>所属频道</strong></td><td>" &GetChannelSelect(ChannelID)& "</td></tr>" & vbCrLf
    Content = Content & "<tr class=td2><td><strong>所属栏目</strong></td><td>"&wrmps.SelectSort(1,ChannelID,0,1, ClassID, "WM_ArticleSort", "ClassID", 0, 1)&"</td></tr>" & vbCrLf	
	Content = Content & "<tr class=td3><td colspan=2><strong>待采集目标页信息</strong></td></tr>" & vbCrLf
    Content = Content & "<tr class=td2><td><strong>目标页URL</strong></td><td><input name='GUrl' type='text' size=50 value="""&BaseSetting(0)&"""> <font Class=Font2>*</font></td></tr>" & vbCrLf
    Content = Content & "<tr class=td2><td><strong>目标网页编码</strong></td><td><Select name=GEncoding size=1><option value='GB2312'" & WRMPS.GetCheckVer("GB2312", BaseSetting(1), 0) & ">GB2312</option><option value='UTF-8'" & WRMPS.GetCheckVer("UTF-8", BaseSetting(1), 0) & ">UTF-8</option><option value='BIG5'" & WRMPS.GetCheckVer("BIG5", BaseSetting(1), 0) & ">BIG5</option></Select> <font Class=Font2>*</font></td></tr>" & vbCrLf
    Content = Content & "<tr class=td2><td><strong>列表分页采集设置</strong></td><td><input type=radio value=0 name=ListType" & WRMPS.GetCheckVer(0, Int(BaseSetting(2)), 1) & " onClick=""ListPaing2.style.display='none';ListPaing3.style.display='none'"">不作设置　<input type=radio value=1 name=ListType" & WRMPS.GetCheckVer(1, Int(BaseSetting(2)), 1) & " onClick=""ListPaing2.style.display='';ListPaing3.style.display='none'"">批量生成　<input type=radio value=2 name=ListType" & WRMPS.GetCheckVer(2, Int(BaseSetting(2)), 1) & " onClick=""ListPaing2.style.display='none';ListPaing3.style.display=''"">手动添加</td></tr>" & vbCrLf
    Content = Content & "<tr class=td2 id=ListPaing2"
	If Int(BaseSetting(2)) <> 1 Then Content = Content & " style='display:none'"
	Dim ListID1,ListID2
	If Int(BaseSetting(2)) = 1 Then
	  ListStr = Split(BaseSetting(3),"|")(0)
	  ListID1 = Split(BaseSetting(3),"|")(1)
	  ListID2 = Split(BaseSetting(3),"|")(2)
	ElseIf Int(BaseSetting(2)) = 2 Then
	  ListStr = ""
	  ListID1 = ""
	  ListID2 = ""