collect_intobase.asp

SK信息采集2.0功能介绍: 1.可针对任何静态网页,动态网页进行采集。包括htm,html,shtml,ASP,ASPX,JSP,PHP等。 2.增加自定文件采集.用户可采集网页中的所有文件.

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%option explicit%>
<!--#include file="../../Conn.asp"-->
<!--#include file="../../SysCls/KS_CommonCls.asp"-->
<!--#include file="../../SysCls/KS_CollectCommonCls.asp"-->
<!--#include file="../Inc/Session.asp"-->
<%
'===================================================================================================================
'软件名称：科汛网站管理系统
'当前版本：科汛网站管理系统 V2.2 0628个人Access版
'Copyright (C) 2006-2008 Kesion.Com  All rights reserved.
'产品咨询QQ：9537636,41904294
'技术支持QQ：111394,54004407 
'程序版权：科汛网络
'程序开发：科汛网络开发组（总策划：林文仲）
'E-Mail  :[e-mail] [e-mail]
'官方网站：http://www.kesion.com  
'演示站点：http://test.kesion.com 
'郑重声明:
'    ①、免费版本请在程序首页保留版权信息，并做上本站LOGO友情连接,商业版本无此要求;
'    ②、任何个人或组织不得在授权允许的情况下删除、修改、拷贝本软件及其他副本上一切关于版权的信息；
'    ③、科汛网络保留此软件的法律追究权利
'===================================================================================================================
Dim KSCls
Set KSCls = New Collect_IntoBase
KSCls.Execute()
Set KSCls = Nothing

Class Collect_IntoBase
        Private KSCMS
		Private KMCObj
		Private ConnItem
		Private ErrNum
		Private SuccNum
		Private Sub Class_Initialize()
		  Set KSCMS=New CommonCls
		  Set KMCObj=New CollectCommonCls
		  Set ConnItem = KSCMS.ConnItem()
		End Sub
        Private Sub Class_Terminate()
		 Call KSCMS.CloseConnItem()
		 Call KSCMS.Closeconn
		 Set KSCMS=Nothing
		 Set KMCObj=Nothing
		End Sub
		Sub Execute()
		Dim NewsID, Action, SqlStr, Page, FRS
		ErrNum = 0
		SuccNum = 0
		NewsID = KSCMS.G("NewsID")
		NewsID = "'" & Replace(NewsID, ",", "','") & "'"
		Action = KSCMS.G("Action")
		Page = KSCMS.G("Page")
		Set FRS = Server.CreateObject("ADODB.RECORDSET")
		 If Action = 1 Then
		   SqlStr = "Select * From KS_Article Where NewsID in (" & NewsID & ")  Order BY ID"
		  Else
		   SqlStr = "Select * From KS_Article Order BY ID"
		 End If
		 'response.write sqlstr
		' response.end
		FRS.Open SqlStr, ConnItem, 1, 3
		If Not FRS.EOF Then
		   Do While Not FRS.EOF
			Call InsertIntoBase(FRS)  '调用插入主数据库函数
			FRS.Delete
			FRS.MoveNext
		   Loop
		End If
		FRS.Close
		Set FRS = Nothing
		Response.Write ("<script>alert('提示:本次共操作 " & SuccNum + ErrNum & " 篇文章\n其中成功入库 " & SuccNum & " 篇,重复而不允许入库 " & ErrNum & " 篇;');location.href='Collect_IntoDataBase.asp?Page=" & Page & "';</script>")
		End Sub
		'执行插入主数据库(文章表)
		Sub InsertIntoBase(FRS)
		  Dim Rs, SqlStr, Tid
		  Tid = FRS("Tid")
		  
		  Set Rs = Server.CreateObject("ADODB.RECORDSET")
		
		  SqlStr = "Select * From KS_Article Where Title='" & FRS("Title") & "' And Tid='" & Tid & "'"
		  Rs.Open SqlStr, conn, 1, 3
		  If Rs.EOF Then
			  Rs.AddNew
		   Rs("NewsID") = FRS("NewsID")
		   Rs("Tid") = Tid
		   Rs("Keywords") = FRS("Keywords")
		   Rs("TitleType") = FRS("TitleType")
		   Rs("Title") = FRS("Title")
		   Rs("ShowComment") = FRS("ShowComment")
		   Rs("TitleFontColor") = FRS("TitleFontColor")
		   Rs("TitleFontType") = FRS("TitleFontType")
		   Rs("Subtitle") = FRS("Subtitle")
		   Rs("ArticleContent") = FRS("ArticleContent")
		   Rs("Author") = FRS("Author")
		   Rs("Origin") = FRS("Origin")
		   Rs("Editor") = FRS("Editor")
		   Rs("Rank") = FRS("Rank")        '阅读星级
		   Rs("Hits") = FRS("Hits")
		   Rs("AddDate") = FRS("AddDate")   '更新时间
		   Rs("SpecialID") = FRS("SpecialID")
		   Rs("JSID") = FRS("JSID")
		   Rs("TemplateID") = FRS("TemplateID") '模板
		   Rs("ArticleFsoType") = FRS("ArticleFsoType")
		   Rs("Fname") = FRS("Fname")
		   'rs("PicNews")=IncludePic     '图片文章
		   Rs("ArticleInput") = FRS("ArticleInput")
		   Rs("PicNews") = FRS("PicNews")
		   Rs("Changes") = FRS("Changes")
		   Rs("Recommend") = FRS("Recommend")
		   Rs("Rolls") = FRS("Rolls")
		   Rs("strip") = FRS("strip")
		   Rs("Popular") = FRS("Popular")
		   Rs("Verific") = FRS("Verific")     '审核与否
		   Rs("Slide") = FRS("Slide")
		   Rs("BeyondSavePic") = FRS("BeyondSavePic")
		   Rs("Comment") = FRS("Comment")
		   Rs("OrderID") = 1
		   Rs.Update
		   SuccNum = SuccNum + 1
		  Else
		   ErrNum = ErrNum + 1
		  End If
		   Rs.Close
		   Set Rs = Nothing
		End Sub
End Class
%>