ks_commoncls.asp

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

<!--#include file="KS_CacheCls.asp"-->
<%
'===================================================================================================================
'软件名称：科汛网站管理系统
'当前版本：科汛网站管理系统 V2.2 Free
'Copyright (C) 2006-2008 Kesion.Com  All rights reserved.
'产品咨询QQ：9537636,41904294
'技术支持QQ：111394 
'程序版权： 科汛网络
'E-Mail  :[e-mail] [e-mail]
'官方网站：http://www.kesion.com  
'演示站点：http://test.kesion.com 
'郑重声明:
'    ①、免费版本请在程序首页保留版权信息，并做上本站LOGO友情连接,商业版本无此要求;
'    ②、任何个人或组织不得在授权允许的情况下删除、修改、拷贝本软件及其他副本上一切关于版权的信息；
'    ③、科汛网络保留此软件的法律追究权利
'====================================================================================================================
'-----------------------------------------------------------------------------------------------
'科汛网站管理系统,通用函数类
'开发:林文仲 版本 v2.2
'-----------------------------------------------------------------------------------------------
Class CommonCls
        Public KSCache
		Public SiteSN
		Public PointName,PointUnit,PointStr
       '===============MD5常量定义开始===========
	    Private m_lOnBits(30)
		Private m_l2Power(30)
		Private BITS_TO_A_BYTE 
		Private BYTES_TO_A_WORD
		Private BITS_TO_A_WORD
		private adOpenForwardOnly
		private adLockReadOnly
		'===============MD5常量定义结束===========

	  Private Sub Class_Initialize()
		Set KSCache = New ClsCache
		Call KSCMSInitialize
      End Sub
	 Private Sub Class_Terminate()
	   Set KSCache=Nothing
	 End Sub
	 '*******************************************************************************************************************
	 '函数名：KSCMSInitialize
	 '作  用: 加载科汛系统的必要参数
	 '备  注：以下参数请不要更改。否则系统可能无法正常运行
	 '*******************************************************************************************************************
	 Public Function KSCMSInitialize()
	    BITS_TO_A_BYTE = 8
		BYTES_TO_A_WORD = 4
		BITS_TO_A_WORD = 32
		adOpenForwardOnly=1
		adLockReadOnly=1
		SiteSN = Replace(Replace(LCase(Request.ServerVariables("SERVER_NAME")), "/", ""), ".", "")
	    Application("VerInfo") = "科汛网站管理系统 V2.2 Sp2 Free"
		PointName=GetConfig("PointName")
		PointUnit=GetConfig("PointUnit")
		PointStr=PointUnit & PointName
	 End Function
	'*********************************************************************************************************************
	'函数名：Conn
	'作  用：连接数据库
	'返回值：无
	'*********************************************************************************************************************
	Public Function Conn()
	   On Error Resume Next
	  Dim ConnObj:Set ConnObj=Server.CreateObject("ADODB.Connection")
	  ConnObj.Open Application("ConnStr")
	  Set Conn = ConnObj
	End Function
	'采集数据库连接
	Public Function ConnItem()
	  Dim ConnObj:Set ConnObj=Server.CreateObject("ADODB.Connection")
	  ConnObj.Open Application("CollcetConnStr")
	  Set ConnItem = ConnObj
	End Function

	'**************************************************
	'函数名：GetConfig
	'作  用：获取系统配置信息
	'参  数：  ConfigField相应的字段名称
	'返回值：相应字段的值
	'**************************************************
	Public Function GetConfig(ByVal ConfigField)
	            IF Application(SiteSn & "SiteConfig_" & ConfigField)="" Then
				   Dim ConfigRS:Set ConfigRS = Server.CreateObject("Adodb.Recordset")
				   On Error Resume Next
				   ConfigRS.Open ("Select * From KS_Config"), Conn, 1, 1
				   GetConfig = ConfigRS(ConfigField)
				   If Err.Number <> 0 Then GetConfig = "":Err.clear
				   ConfigRS.Close:Set ConfigRS = Nothing
				   Application(SiteSn & "SiteConfig_" & ConfigField)=GetConfig
				Else
				 GetConfig=Application(SiteSn & "SiteConfig_" & ConfigField)
				End If
	End Function
	'**************************************************
	'函数名：GetChannelConfig
	'作  用：获取系统内置模块的配置信息
	'参  数：ChannelID--要取的系统模块ID， ConfigField相应的字段名称
	'返回值：相应字段的值
	'**************************************************
	Public Function GetChannelConfig(ChannelID, ConfigField)
	     IF Application(SiteSn & "ChannelConfig" & ChannelID & ConfigField)="" Then
			  Dim ConfigRS:Set ConfigRS = Server.CreateObject("Adodb.Recordset")
			   On Error Resume Next
			   ConfigRS.Open ("Select * From KS_Channel Where ChannelID=" & ChannelID), Conn, 1, 1
			   GetChannelConfig = ConfigRS(ConfigField)
			   If Err.Number <> 0 Then GetChannelConfig = "":Err.clear
			   Set ConfigRS = Nothing
			   Application(SiteSn & "ChannelConfig" & ChannelID &  ConfigField)=GetChannelConfig
		 Else
		       GetChannelConfig=Application(SiteSn & "ChannelConfig" & ChannelID & ConfigField)
		 End IF
	End Function
	'**************************************************
	'函数名：GetClassConfig
	'作  用：获取频道（栏目）的配置信息
	'参  数：ClassID--要取的栏目ID， ConfigField相应的字段名称
	'返回值：相应字段的值
	'**************************************************
	Public Function GetClassConfig(ClassID, ConfigField)
	     IF Application(SiteSn & "ClassConfig_" & ClassID & ConfigField)="" Then
			  Dim ConfigRS:Set ConfigRS = Server.CreateObject("Adodb.Recordset")
			   On Error Resume Next
			   ConfigRS.Open ("Select * From KS_Class Where ID='" & ClassID & "'"), Conn, 1, 1
			   GetClassConfig = ConfigRS(ConfigField)
			   If Err.Number <> 0 Then GetChannelConfig = "":Err.clear
			   Set ConfigRS = Nothing
			   Application(SiteSn & "ClassConfig_" & ClassID & ConfigField)=GetClassConfig
		 Else
		       GetClassConfig=Application(SiteSn & "ClassConfig_" & ClassID & ConfigField)
		 End IF
	End Function
	'***************************************************************************************************************
	'函数名：GetDomain
	'作  用：获取URL,包括虚拟目录 如http://www.h121.com/ 或 http://www.h121.com/Sys/  其中 Sys/为虚拟目录
	'参  数：  无
	'返回值：完整域名
	'***************************************************************************************************************
	Public Function GetDomain()
	   GetDomain = Trim(GetConfig("WebUrl") & GetConfig("InstallDir"))
	End Function
	'**************************************************
	'函数名：GetChannelDomain
	'作  用：获取包含频道的完整Url
	'参  数：ChannelID频道ID
	'返回值：完整域名
	'**************************************************
	Public Function GetChannelDomain(ChannelID)
	  Dim ArticleDir, PictureDir, DownDir, FlashDir
	   GetChannelDomain = GetDomain()
	   Select Case (ChannelID)
		Case 1
		   ArticleDir = Replace(Trim(GetConfig("ArticleDir")), "\", "/")
		   If Left(ArticleDir, 1) = "/" Then ArticleDir = Right(ArticleDir, Len(ArticleDir) - 1)
		   GetChannelDomain = GetChannelDomain & ArticleDir
		Case 2
		   PictureDir = Replace(Trim(GetConfig("PicDir")), "\", "/")
		   If Left(PictureDir, 1) = "/" Then PictureDir = Right(PictureDir, Len(PictureDir) - 1)
		   GetChannelDomain = GetChannelDomain & PictureDir
		Case 3
		   DownDir = Replace(Trim(GetConfig("DownDir")), "\", "/")
		   If Left(DownDir, 1) = "/" Then DownDir = Right(DownDir, Len(DownDir) - 1)
		   GetChannelDomain = GetChannelDomain & DownDir
		Case 4
		   FlashDir = Replace(Trim(GetConfig("FlashDir")), "\", "/")
		   If Left(FlashDir, 1) = "/" Then FlashDir = Right(FlashDir, Len(FlashDir) - 1)
		   GetChannelDomain = GetChannelDomain & FlashDir
		Case Else
		  GetChannelDomain = "":Exit Function
	  End Select
	End Function
	'**************************************************
	'函数名：GetAutoDoMain()
	'作  用：取得当前服务器IP 如：http://127.0.0.1
	'参  数：无
	'**************************************************
	Public Function GetAutoDomain()
		Dim TempPath
		If Request.ServerVariables("SERVER_PORT") = "80" Then
			GetAutoDomain = Request.ServerVariables("SERVER_NAME")
		Else
			GetAutoDomain = Request.ServerVariables("SERVER_NAME") & ":" & Request.ServerVariables("SERVER_PORT")
		End If
		'TempPath = Request.ServerVariables("APPL_MD_PATH")
		'TempPath = Right(TempPath, Len(TempPath) - InStr(TempPath, "Root") - 3)
		'GetAutoDomain = "http://" & GetAutoDomain & TempPath
		 If Instr(UCASE(GetAutoDomain),"/W3SVC")<>0 Then
			   GetAutoDomain=Left(GetAutoDomain,Instr(GetAutoDomain,"/W3SVC"))
		 End If
		 GetAutoDomain = "http://" & GetAutoDomain
	End Function
	
	
	'取得系统版权等信息
	Public Function CopyRight()
	  CopyRight = " 版权所有 &copy 2006-2008 科汛网络 "
	End Function
	'*************************************************************************
	'函数名：gotTopic
	'作  用：截字符串，汉字一个算两个字符，英文算一个字符
	'参  数：str   ----原字符串
	'       strlen ----截取长度
	'返回值：截取后的字符串
	'*************************************************************************
	Public Function GotTopic(ByVal Str, ByVal strlen)
		If Str = "" Then GotTopic = "":Exit Function
		Dim l, T, c, I, strTemp
		Str = Replace(Replace(Replace(Replace(Str, "&nbsp;", " "), "&quot;", Chr(34)), "&gt;", ">"), "&lt;", "<")
		l = Len(Str)
		T = 0
		strTemp = Str
		strlen = CLng(strlen)
		For I = 1 To l
			c = Abs(Asc(Mid(Str, I, 1)))
			If c > 255 Then
				T = T + 2
			Else
				T = T + 1
			End If
			If T >= strlen Then
				strTemp = Left(Str, I)
				Exit For
			End If
		Next
		If strTemp <> Str Then	strTemp = strTemp
		GotTopic = Replace(Replace(Replace(Replace(strTemp, " ", "&nbsp;"), Chr(34), "&quot;"), ">", "&gt;"), "<", "&lt;")
	End Function
	
	'**************************************************
	'函数名：ListTitle
	'作  用：取标题
	'参  数：TitleStr 标题, TitleNum 取字符数
	'返回值：将标题分解成两行
	'**************************************************
	Public Function ListTitle(TitleStr, TitleNum)
		  Dim LeftStr, RightStr
			ListTitle = Trim(GotTopic(Trim(TitleStr), TitleNum))
			If Len(ListTitle) > CInt(TitleNum / 2) Then
			  LeftStr = GotTopic(ListTitle, CInt(TitleNum / 2))
			  RightStr = Mid(ListTitle, Len(LeftStr) + 1)
			  ListTitle = LeftStr & "<br>" & RightStr
			End If
	 End Function
	
	'**************************************************
	'函数名：ReplaceBadChar
	'作  用：过滤非法的SQL字符
	'参  数：strChar-----要过滤的字符
	'返回值：过滤后的字符
	'**************************************************
	Public Function ReplaceBadChar(strChar)
		If strChar = "" Or IsNull(strChar) Then ReplaceBadChar = "":Exit Function
		Dim strBadChar, arrBadChar, tempChar, I
		strBadChar = "',%,^,&,?,(,),<,>,[,],{,},/,\,;,:," & Chr(34) & "," & Chr(0) & ""
		arrBadChar = Split(strBadChar, ",")
		tempChar = strChar
		For I = 0 To UBound(arrBadChar)
			tempChar = Replace(tempChar, arrBadChar(I), "")
		Next
		ReplaceBadChar = tempChar
	End Function