system_gatherclass.asp

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

<!--#include file="System_Gather.asp"-->
<%
Call WR.Hand()
Module = 2 '模块ID 1为文章 2为分类信息
Content = Content & "<table width='100%' cellpadding=3 cellspacing=1 class=td1>" & vbCrLf
Content = Content & "<tr class=td2><td><a href=System_GatherClass.asp>项目管理首页</a> | <a href=System_GatherClass.asp?Action=Item>添加项目</a> | <a href=System_GatherDataTrim.asp?Module="&Module&">数据审核</a> | <a href=System_GatherDataTrim.asp?Action=Histroly&Module="&Module&">采集历史</a> | <a href=System_GatherLeach.asp?Module="&Module&">过滤管理</a> | <a href=System_GatherLeach.asp?Action=Leach&Module="&Module&">添加新过滤</a></td></tr>" & vbCrLf
Content = Content & "</table>" & vbCrLf
Dim ItemName,GUrl,GEncoding,ListType,ListStr,PicSavePath,Passed,SaveFiles,WaterMark,CollecOrder,Timing,Leach,Displace,CollecNum,CReThumb,GField
Dim WR_Class,ID,BaseSetting,ARea,ShowCode,WorkLine
Dim i,n,WR_Content,WR_ID,WR_Name,WR_LeachType,WR_Leach1,WR_Leach2,WR_Key,WR_Module
Dim ListBegin,ListEnd,LinkBegin,LinkEnd,LinkReset,HtmlContent
Dim WR_Title,WR_Time,WR_Tags,AddTime,Contact,Tags,QQ,AddRess,TEl
ID = WR.CheckStr(Request("ID"), 0)
Page = WR.CheckStr(Request("page"),1)

Set Grs = server.cReateobject("adodb.Recordset")
Select Case Request("Action")
  Case "ItemTest"
  Call ConnOpen()
  If Ucase(Request("Save")) <> "NO" Then
    If Request("Begin1") = "" or Request("End1") = "" Then Call WRMPS.ErrView("·请填写标题开始结束标签", 0)
    If Request("Begin2") = "" or Request("End2") = "" Then Call WRMPS.ErrView("·请填写内容开始结束标签", 0)
    HtmlContent = Request("Begin1")&Sign1&Request("End1")&Sign&Request("Begin2")&Sign1&Request("End2")
	If WR.CheckStr(Request("Contact"), 1) = 0 Then
	  Contact = WR.CheckStr(Request("Contact"), 1)&Sign1&Sign1
	Else
      If Request("CTBegin") = "" or Request("CTEnd") = "" Then Call WRMPS.ErrView("·请填写联系人开始结束标签", 0)
      Contact = WR.CheckStr(Request("Contact"), 1)&Sign1&Request("CTBegin")&Sign1&Request("CTEnd")
	End If
	HtmlContent = HtmlContent & Sign & Contact
	If WR.CheckStr(Request("EMail"), 1) = 0 Then
	  EMail = WR.CheckStr(Request("EMail"), 1)&Sign1&Sign1
	Else
      If Request("MLBegin") = "" or Request("MLEnd") = "" Then Call WRMPS.ErrView("·请填写邮箱开始结束标签", 0)
      EMail = WR.CheckStr(Request("EMail"), 1)&Sign1&Request("MLBegin")&Sign1&Request("MLEnd")
	End If
	HtmlContent = HtmlContent & Sign & EMail
	If WR.CheckStr(Request("QQ"), 1) = 0 Then
	  QQ = WR.CheckStr(Request("QQ"), 1)&Sign1&Sign1
	Else
      If Request("QQBegin") = "" or Request("QQEnd") = "" Then Call WRMPS.ErrView("·请填写QQ开始结束标签", 0)
      QQ = WR.CheckStr(Request("QQ"), 1)&Sign1&Request("QQBegin")&Sign1&Request("QQEnd")
	End If
	HtmlContent = HtmlContent & Sign & QQ
	If WR.CheckStr(Request("AddRess"), 1) = 0 Then
	  AddRess = WR.CheckStr(Request("AddRess"), 1)&Sign1&Sign1
	Else
      If Request("ARBegin") = "" or Request("ARend") = "" Then Call WRMPS.ErrView("·请填写联系地址开始结束标签", 0)
      AddRess = WR.CheckStr(Request("AddRess"), 1)&Sign1&Request("ARBegin")&Sign1&Request("ARend")
	End If
	HtmlContent = HtmlContent & Sign & AddRess
	If WR.CheckStr(Request("TEL"), 1) = 0 Then
	  TEL = WR.CheckStr(Request("TEL"), 1)&Sign1&Sign1
	Else
      If Request("TLBegin") = "" or Request("TLEnd") = "" Then Call WRMPS.ErrView("·请填写电话开始结束标签", 0)
      TEL = WR.CheckStr(Request("TEL"), 1)&Sign1&Request("TLBegin")&Sign1&Request("TLEnd")
	End If
	HtmlContent = HtmlContent & Sign & TEL
	If WR.CheckStr(Request("AddTime"), 1) = 0 Then
	  AddTime = WR.CheckStr(Request("AddTime"), 1)&Sign1&Sign1
	Else
      If Request("ATBegin") = "" or Request("ATEnd") = "" Then Call WRMPS.ErrView("·请填写时间开始结束标签", 0)
      AddTime = WR.CheckStr(Request("AddTime"), 1)&Sign1&Request("ATBegin")&Sign1&Request("ATEnd")
	End If
	HtmlContent = HtmlContent & Sign & AddTime
	If WR.CheckStr(Request("Tags"), 1) = 0 Then
	  Tags = WR.CheckStr(Request("Tags"), 1)&Sign1&Sign1
	ElseIf WR.CheckStr(Request("Tags"), 1) = 1 Then
      If Request("TagBegin") = "" or Request("TagEnd") = "" Then Call WRMPS.ErrView("·请填写关键字开始结束标签", 0)
      Tags = WR.CheckStr(Request("Tags"), 1)&Sign1&Request("TagBegin")&Sign1&Request("TagEnd")
	Else
      If Request("Tag") = "" Then Call WRMPS.ErrView("·请填写指定关键字", 0)
      Tags = WR.CheckStr(Request("Tags"), 1)&Sign1&WR.CheckStr(Request("Tag"), 0)&Sign1
	End If
	HtmlContent = HtmlContent & Sign & Tags
	Grs.Open"Select Top 1 WR_Content,WR_Key From WR_Item Where WR_ID="&ID ,Gconn,1,3
	If Not Grs.Eof Then
	  Grs(0) = HtmlContent
	  Grs(1) = 1
	  Grs.Update
	End If
	Grs.Close
  End If
	If WR.CheckStr(Request("ShowCode"), 1) = 1 Then
      Set Grs = Gconn.Execute("Select Top 1 WR_Content,WR_BaseSetting,WR_ListBegin,WR_ListEnd,WR_LinkBegin,WR_LinkEnd,WR_LinkReset,WR_Key From WR_Item Where WR_ID="&ID)
	  If Not Grs.Eof Then
	    HtmlContent = Grs(0)
	    BaseSetting = Grs(1)
		ListBegin = Grs(2)
		ListEnd = Grs(3)
		LinkBegin = Grs(4)
		LinkEnd = Grs(5)
		LinkReset = Grs(6)
	    If Grs(7) = 0 Then Call WRMPS.ErrView("·采集项目设置不完整<meta http-equiv=RefResh content='1;URL=?Page="&Page&"'>",1)
	  Else
	    Call WRMPS.ErrView("·采集项目不存在<meta http-equiv=RefResh content='1;URL=?Page="&Page&"'>",1)
	  End If
	  Grs.Close
	  Set Grs = Nothing
      BaseSetting = Split(BaseSetting,"§§§")
	  GUrl = BaseSetting(0)
	  GEncoding = BaseSetting(1)
	  ShowCode = GetHttpPage(GUrl,GEncoding)
	  HtmlContent = Split(HtmlContent,Sign)
	  ShowCode = ListCode(HCode(ShowCode,ListBegin,ListEnd),LinkBegin,LinkEnd,BaseSetting(8))
	  If Instr(ShowCode,"§") > 0 Then Url = GetUrl(Split(ShowCode,"§")(0),LinkReset) Else Url = GetUrl(ShowCode,LinkReset)
      ShowCode = GetHttpPage(Url,GEncoding)
	  
	  WR_Title = GetTitle(ShowCode,HtmlContent(0))
	  WR_Content = GetContent(ShowCode,HtmlContent(1),ID,Url,Module,0,0,0)
	  Contact = GetShaReC(ShowCode,HtmlContent(2))
	  EMail = GetShaReC(ShowCode,HtmlContent(3))
	  QQ = GetShaReC(ShowCode,HtmlContent(4))
	  AddRess = GetShaReC(ShowCode,HtmlContent(5))
	  TEL = GetShaReC(ShowCode,HtmlContent(6))
	  WR_Time = GetTime(ShowCode,HtmlContent(7))
	  WR_Tags = GetTags(ShowCode,HtmlContent(8),WR_Title)

      Content = Content & "<table width='100%' cellpadding=3 cellspacing=1 class=td1>" & vbCrLf
      Content = Content & "<tr class=td4><td colspan=2><strong>采集测试</strong></td></tr>" & vbCrLf
      Content = Content & "<tr class=td2><td width='30%'><strong>标题</strong></td><td width='70%'><input type=text size=50 value="""&WRMPS.GetHTMLEncode(WR_Title)&"""></td></tr>" & vbCrLf
      Content = Content & "<tr class=td2><td><strong>内容</strong></td><td><textaRea cols=70 rows=10>"&WR.CheckStr(WR_Content,3)&"</textaRea></td></tr>" & vbCrLf
      Content = Content & "<tr class=td2><td><strong>联系人</strong></td><td><input type=text size=50 value="""&WRMPS.GetHTMLEncode(Contact)&"""></td></tr>" & vbCrLf
      Content = Content & "<tr class=td2><td><strong>邮箱</strong></td><td><input type=text size=50 value="""&WRMPS.GetHTMLEncode(EMail)&"""></td></tr>" & vbCrLf
      Content = Content & "<tr class=td2><td><strong>QQ</strong></td><td><input type=text size=50 value="""&WRMPS.GetHTMLEncode(QQ)&"""></td></tr>" & vbCrLf
      Content = Content & "<tr class=td2><td><strong>联系地址</strong></td><td><input type=text size=50 value="""&WRMPS.GetHTMLEncode(AddRess)&"""></td></tr>" & vbCrLf
      Content = Content & "<tr class=td2><td><strong>电话</strong></td><td><input type=text size=50 value="""&WRMPS.GetHTMLEncode(TEL)&"""></td></tr>" & vbCrLf
      Content = Content & "<tr class=td2><td><strong>时间</strong></td><td><input type=text size=50 value="""&WRMPS.GetHTMLEncode(WR_Time)&"""></td></tr>" & vbCrLf
      Content = Content & "<tr class=td2><td><strong>关键字</strong></td><td><input type=text size=50 value="""&WRMPS.GetHTMLEncode(WR_Tags)&"""></td></tr>" & vbCrLf
	  Content = Content & "<tr class=td2><td></td><td><input type=button name=Submit value='完 成' onclick='javascript:window.open(""?Page="&Page&""",""_self"")'></td></tr>" & vbCrLf
      Content = Content & "</table>" & vbCrLf
	Else
      Call WRMPS.ErrView("·采集项目操作成功<meta http-equiv=RefResh content='1;URL=?Page="&Page&"'>",1)
	End If 
    Call ConnClose()
	
  Case "ItemThree"
	ListBegin = WR.CheckStr(Request.Form("ListBegin"),2)
	ListEnd = WR.CheckStr(Request.Form("ListEnd"),2)
	LinkBegin = WR.CheckStr(Request.Form("LinkBegin"),2)
	LinkEnd = WR.CheckStr(Request.Form("LinkEnd"),2)
	If WR.CheckStr(Request.Form("LinkReset"), 1) = 0 Then
	  LinkReset = "0|"
	Else