system_gatherarticle.asp

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

<!--#include file="System_Gather.asp"-->
<%
Call WR.Hand()
Module = 1 '模块ID 1为文章
Content = Content & "<table width='100%' cellpadding=3 cellspacing=1 class=td1>" & vbCrLf
Content = Content & "<tr class=td2><td><a href=System_GatherArticle.asp>项目管理首页</a> | <a href=System_GatherArticle.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,PageNext,WR_Content,WR_ID
Dim ListBegin,ListEnd,LinkBegin,LinkEnd,LinkReset,HtmlContent
Dim WR_Title,WR_Time,WR_Author,WR_CopyFrom,WR_Tags
Dim AddTime,CopyFrom,Tags
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("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("Author"), 1) = 0 Then
	  Author = WR.CheckStr(Request("Author"), 1)&Sign1&Sign1
	ElseIf WR.CheckStr(Request("Author"), 1) = 1 Then
      If Request("AHBegin") = "" or Request("AHEnd") = "" Then Call WRMPS.ErrView("·请填写作者开始结束标签", 0)
      Author = WR.CheckStr(Request("Author"), 1)&Sign1&Request("AHBegin")&Sign1&Request("AHEnd")
	Else
      If Request("AH") = "" Then Call WRMPS.ErrView("·请填写指定作者", 0)
      Author = WR.CheckStr(Request("Author"), 1)&Sign1&WR.CheckStr(Request("AH"), 0)&Sign1
	End If
	HtmlContent = HtmlContent & Sign & Author
	If WR.CheckStr(Request("CopyFrom"), 1) = 0 Then
	  CopyFrom = WR.CheckStr(Request("CopyFrom"), 1)&Sign1&Sign1
	ElseIf WR.CheckStr(Request("CopyFrom"), 1) = 1 Then
      If Request("CFBegin") = "" or Request("CFEnd") = "" Then Call WRMPS.ErrView("·请填写来源开始结束标签", 0)
      CopyFrom = WR.CheckStr(Request("CopyFrom"), 1)&Sign1&Request("CFBegin")&Sign1&Request("CFEnd")
	Else
      If Request("CF") = "" Then Call WRMPS.ErrView("·请填写指定来源", 0)
      CopyFrom = WR.CheckStr(Request("CopyFrom"), 1)&Sign1&WR.CheckStr(Request("CF"), 0)&Sign1
	End If
	HtmlContent = HtmlContent & Sign & CopyFrom
	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
	If WR.CheckStr(Request("PageNext"), 1) = 0 Then
	  PageNext = WR.CheckStr(Request("PageNext"), 1)&Sign&Sign&Sign&Sign
	Else
      If Request("PNBegin") = "" or Request("PNEnd") = "" or Request("PNLBegin") = "" or Request("PNLEnd") = "" Then Call WRMPS.ErrView("·请填写正文分页开始结束标签", 0)
      PageNext = WR.CheckStr(Request("PageNext"), 1)&Sign&Request("PNBegin")&Sign&Request("PNEnd")&Sign&Request("PNLBegin")&Sign&Request("PNLEnd")
	End If
	Grs.Open"Select Top 1 WR_Content,WR_PageNext,WR_Key From WR_Item Where WR_ID="&ID ,Gconn,1,3
	If Not Grs.Eof Then
	  Grs(0) = HtmlContent
	  Grs(1) = PageNext
	  Grs(2) = 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)
	  WR_Time = GetTime(ShowCode,HtmlContent(2))
	  WR_Author = GetShaReCon(ShowCode,HtmlContent(3))
	  WR_CopyFrom = GetShaReCon(ShowCode,HtmlContent(4))
	  WR_Tags = GetTags(ShowCode,HtmlContent(5),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(WR_Time)&"""></td></tr>" & vbCrLf
      Content = Content & "<tr class=td2><td><strong>作者</strong></td><td><input type=text size=50 value="""&WRMPS.GetHTMLEncode(WR_Author)&"""></td></tr>" & vbCrLf
      Content = Content & "<tr class=td2><td><strong>来源</strong></td><td><input type=text size=50 value="""&WRMPS.GetHTMLEncode(WR_CopyFrom)&"""></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
	  LinkReset = "1|"&WR.CheckStr(Request.Form("LinkResetUrl"), 0)
	End If
	Call ConnOpen()
	If Ucase(Request("Save")) <> "NO" Then
	  If WR.CheckStr(Request.Form("LinkReset"), 1) = 1 and WR.CheckStr(Request.Form("LinkResetUrl"), 0) = "" Then Call WRMPS.ErrView("·你选择了重新链接位置，请做好相关设置", 0)
	  Set Grs = Gconn.Execute("Update WR_Item Set WR_ListBegin='"&ListBegin&"',WR_ListEnd='"&ListEnd&"',WR_LinkBegin='"&LinkBegin&"',WR_LinkEnd='"&LinkEnd&"',WR_LinkReset='"&LinkReset&"' Where WR_ID="&ID)
    End If
	Set Grs = Gconn.Execute("Select Top 1 WR_Content,WR_BaseSetting,WR_PageNext,WR_ListBegin,WR_ListEnd,WR_LinkBegin,WR_LinkEnd From WR_Item Where WR_ID="&ID)
	If Not Grs.Eof Then
	  HtmlContent = Grs(0)
	  BaseSetting = Grs(1)
	  PageNext = Grs(2)
	  ListBegin = Grs(3)
	  ListEnd = Grs(4)
	  LinkBegin = Grs(5)
	  LinkEnd = Grs(6)
	End If
	Grs.Close
	GUrl = Split(BaseSetting,"§§§")(0)
	GEncoding = Split(BaseSetting,"§§§")(1)
    Content = Content & "<table width='100%' cellpadding=3 cellspacing=1 class=td1>" & vbCrLf
    Content = Content & "<form name=myform method='post' action='?Action=ItemTest&Page="&Page&"'>" & vbCrLf
	Content = Content & "<input name=ID type=hidden value=" & ID & ">" & vbCrLf
	If WR.CheckStr(Request.Form("ShowCode"), 1) = 1 Then
	  ShowCode = GetHttpPage(GUrl,GEncoding)
	  ShowCode = HCode(ShowCode,ListBegin,ListEnd)
	  ShowCode = ListCode(ShowCode,LinkBegin,LinkEnd,Split(BaseSetting,"§§§")(8))
	  If Instr(ShowCode,"§") > 0 Then 
	    If Instr(ShowCode,"§") > 0 Then Url = GetUrl(Split(ShowCode,"§")(0),LinkReset) Else Url = GetUrl(ShowCode,LinkReset)
		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(Url,GEncoding))&"</textaRea><div style='width:100%; height:150px; z-index:1;overflow:auto;text-align:left' class=div>"
		For i=0 To Ubound(Split(ShowCode,"§"))
		  Content = Content & "&nbsp;目标地址：<a href="&GetUrl(Split(ShowCode,"§")(i),LinkReset)&" target=_blank>"&GetUrl(Split(ShowCode,"§")(i),LinkReset)&"</a>　<a href='view-source:"&GetUrl(Split(ShowCode,"§")(i),LinkReset)&"' target=_blank>点击查看目标源代码</a><br>"
		Next
		Content = Content & "</div></td></tr>" & vbCrLf
	  End If
	End If 
	If HtmlContent = "" or IsNull(HtmlContent) Then HtmlContent = Sign1&Sign&Sign1&Sign&"0"&Sign1&Sign1&Sign&"0"&Sign1&Sign1&Sign&"0"&Sign1&Sign1&Sign&"0"&Sign1&Sign1
	If PageNext = "" or IsNull(PageNext) Then PageNext = "0"&Sign&Sign&Sign&Sign
	HtmlContent = Split(HtmlContent,Sign)
	PageNext = Split(PageNext,Sign)
	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&">第二步</a> >> <a href=?Action=ItemThree&ID="&ID&"&Save=NO&Page="&Page&"><span class=font2>第三步</span></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=Begin1 cols=50 rows=5>"&Split(HtmlContent(0),Sign1)(0)&"</textaRea></td></tr>" & vbCrLf
    Content = Content & "<tr class=td2><td><strong>标题结束代码</strong></td><td><textaRea name=End1 cols=50 rows=5>"&Split(HtmlContent(0),Sign1)(1)&"</textaRea></td></tr>" & vbCrLf
    Content = Content & "<tr class=td2><td><strong>内容开始代码</strong></td><td><textaRea name=Begin2 cols=50 rows=5>"&Split(HtmlContent(1),Sign1)(0)&"</textaRea></td></tr>" & vbCrLf
    Content = Content & "<tr class=td2><td><strong>内容结束代码</strong></td><td><textaRea name=End2 cols=50 rows=5>"&Split(HtmlContent(1),Sign1)(1)&"</textaRea></td></tr>" & vbCrLf
	Content = Content & "<tr class=td2 style='display:none'><td><strong>是否设置正文分页</strong></td><td><input type=radio value=0 name=PageNext checked onClick=""PN1.style.display='none'""" & WRMPS.GetCheckVer(0, Int(PageNext(0)), 1) & ">不作设置　<input type=radio value=1 name=PageNext onClick=""PN1.style.display=''""" & WRMPS.GetCheckVer(1, Int(PageNext(0)), 1) & ">正文分页</td></tr>" & vbCrLf
	Content = Content & "<tr class=td2 style='display:none' id=PN1"
	If Int(PageNext(0)) < 1 Then Content = Content & " style='display:none'"
	Content = Content & "><td colspan=2><table width='100%' border=0 cellspacing=0 cellpadding=0>"