system_gatherclass.asp

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

	  If Ucase(Request("Save")) <> "NO" Then Gconn.Execute("Update WR_Item Set WR_Class='"&ClassID&"',WR_Area="&AreaID&",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&"',2,'"&ClassID&"',"&AreaID&",'"&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"
    Dim AreaIDName
	BaseSetting = "§§§GB2312§§§0§§§||§§§0§§§0§§§0§§§0§§§0§§§§§§§§§0"
    Timing = 0
    ClassID = 0
	AreaID = 0
	If ID <> "" Then 
	  Call ConnOpen()
	  Set Grs = Gconn.Execute("Select WR_Name,WR_Class,WR_Area,WR_BaseSetting,WR_Timing 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)
        AreaIDName=WRDB.GetClassName("WM_Area",AreaID)
        ClassName=WRDB.GetClassName("WM_ClassSort",ClassID)
	  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 & "<input name=_ClassID type=hidden value=" & ClassID & ">" & vbCrLf
	  Content = Content & "<input name=_AreaID type=hidden value=" & AreaID & ">" & vbCrLf
	  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
    If ID <> "" Then
	  Content = Content & "<tr Class=td2><td width='20%'><strong>所属栏目</strong></td>" & vbCrLf
	  Content = Content & "<td>"&ClassName&"　<font onclick='Edit(a1)' style='cursor:pointer' color=blue>修改请点击</font></td></tr>" & vbCrLf
	  Content = Content & "<tr Class=td2 id=a1 style='display:none'><td><strong>修改栏目</strong></td>" & vbCrLf
	  Content = Content & "<td><script src='../../Inc/Js/ClassSelect.Js'></Script></td></tr>" & vbCrLf
	  Content = Content & "<tr Class=td2><td><strong>所属地区</strong></td>" & vbCrLf
      Content = Content & "<td>"&AreaIDName&"　<font onclick='Edit2(b1)' style='cursor:pointer' color=blue>修改请点击</font></td></tr>" & vbCrLf
	  Content = Content & "<tr Class=td2 id=b1 style='display:none'><td><strong>修改地区</strong></td>" & vbCrLf
	  Content = Content & "<td><script src='../../Inc/Js/AreaSelect.Js'></Script></td></tr>" & vbCrLf    
	Else
	  Content = Content & "<tr Class=td2><td width='20%'><strong>所属栏目</strong></td>" & vbCrLf
	  Content = Content & "<td><script src='../../Inc/Js/ClassSelect.Js'></Script></td></tr>" & vbCrLf
	  Content = Content & "<tr Class=td2><td><strong>所属地区</strong></td>" & vbCrLf
	  Content = Content & "<td><script src='../../Inc/Js/AreaSelect.Js'></Script></td></tr>" & vbCrLf    
	End If
	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 = ""
	End If
	Content = Content & "><td><strong>批量生成</strong><br>除目标页以外的列表页面</td><td><input name=ListStr2 type=text size=50 value="""&ListStr&"""> 分页代码 <font color=Red>{$ID}</font><br>格式：http://www.wangRen.net/list.asp?page={$ID}<br>生成范围：<input name=ListID1 type=text size=8 maxlength=5 value="""&ListID1&"""> To <input name=ListID2 type=text size=8 maxlength=5 value="""&ListID2&"""> 例如：2 - 9 请从小到大填写</td></tr>" & vbCrLf
    Content = Content & "<tr class=td2 id=ListPaing3"
	If Int(BaseSetting(2)) <> 2 Then Content = Content & " style='display:none'"
	Content = Content & "><td><strong>手动添加</strong></td><td><textaRea name=ListStr3 cols=50 rows=6>"&Replace(BaseSetting(3),"||","")&"</textaRea><br>格式：输入一个网址后按回车，再输入下一个</td></tr>" & vbCrLf
    Content = Content & "<tr class=td2><td><strong>采集设置</strong></td><td><input name=Passed type=checkbox value=1" & WRMPS.GetCheckVer(1, Int(BaseSetting(5)), 1) & ">立即入库　<input name=SaveFiles type=checkbox value=1" & WRMPS.GetCheckVer(1, Int(BaseSetting(6)), 1) & ">保存图片　<input name=CReateThumb type=checkbox value=1" & WRMPS.GetCheckVer(1, Int(BaseSetting(11)), 1) & ">标题缩略图　<input name=WaterMark type=checkbox value=1" & WRMPS.GetCheckVer(1, Int(BaseSetting(7)), 1) & ">图片水印　<input name=CollecOrder type=checkbox value=1" & WRMPS.GetCheckVer(1, Int(BaseSetting(8)), 1) & ">倒序采集　<input name=Timing type=checkbox value=1" & WRMPS.GetCheckVer(1, Timing, 1) & ">定时采集</td></tr>" & vbCrLf
    Content = Content & "<tr class=td2><td><strong>标签过滤</strong></td><td><input name=Leach type=checkbox value=iframe"
	If Instr(BaseSetting(9),"|iframe|") > 0 Then Content = Content & " checked"
	Content = Content & ">ifrAme　<input name=Leach type=checkbox value=object"
	If Instr(BaseSetting(9),"|object|") > 0 Then Content = Content & " checked"
	Content = Content & " onclick='Return confirm(""确定要选择该标记吗？这将删除正文中的所有Object标记，结果将导致该信息中的所有Flash动画被删除！"");'>Object　<input name=Leach type=checkbox value=script"
	If Instr(BaseSetting(9),"|script|") > 0 Then Content = Content & " checked"
	Content = Content & ">Script　<input name=Leach type=checkbox value=div"
	If Instr(BaseSetting(9),"|div|") > 0 Then Content = Content & " checked"
	Content = Content & ">Div　<input name=Leach type=checkbox  value=table"
	If Instr(BaseSetting(9),"|table|") > 0 Then Content = Content & " checked"
	Content = Content & ">Table　<input name=Leach type=checkbox  value=tr"
	If Instr(BaseSetting(9),"|tr|") > 0 Then Content = Content & " checked"
	Content = Content & ">TR<br><input name=Leach type=checkbox  value=span"
	If Instr(BaseSetting(9),"|span|") > 0 Then Content = Content & " checked"
	Content = Content & ">Span　<input name=Leach type=checkbox value=img"
	If Instr(BaseSetting(9),"|img|") > 0 Then Content = Content & " checked"
	Content = Content & ">Img　<input name=Leach type=checkbox  value=font"
	If Instr(BaseSetting(9),"|font|") > 0 Then Content = Content & " checked"
	Content = Content & ">Font　<input name=Leach type=checkbox value=a"
	If Instr(BaseSetting(9),"|a|") > 0 Then Content = Content & " checked"
	Content = Content & ">A　<input name=Leach type=checkbox value=html"
	If Instr(BaseSetting(9),"|html|") > 0 Then Content = Content & " checked"
	Content = Content & " onclick='Return confirm(""确定要选择该标记吗？这将删除正文中的所有Html标记，结果将导致该信息的可查看性降低！"");'>Html　<input name=Leach type=checkbox value=td"
	If Instr(BaseSetting(9),"|td|") > 0 Then Content = Content & " checked"
	Content = Content & ">TD</td></tr>" & vbCrLf
    Content = Content & "<tr class=td2><td><strong>内容字符替换操作</strong><br>格式 替换前的字符串|替换后的字符串<br>每条替换规则之间用回车隔开</td><td><textaRea name=Displace cols=50 rows=6>"&BaseSetting(10)&"</textaRea></td></tr>" & vbCrLf
    Content = Content & "<tr class=td2><td><strong>采集数量限制</strong><br>0为采集所有</td><td><input name='CollecNum' type='text' size=8 maxlength=5 value="""&BaseSetting(4)&"""></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