ks_commoncls.asp

1.支持文章

	'**************************************************
	'函数名: GetFolderPath
	'功 能:取得目录Url
	'参 数: FolderID目录的ID,FullPathFlag是否完整路径(取栏目首页与否),包括栏目首页 如 "http://www.h121.com/article/computer/photoshop/index.html"
	'**************************************************
	Public Function GetFolderPath(FolderID,FullPathFlag)
			  KSCache.name=Cstr(SiteSN & "ClassPath" &FolderID&FullPathFlag)
			  IF KSCache.valid and KSCache.value<>"" Then 
			   GetFolderPath=KSCache.value
			  Else   
				   Call KSCache.clean
				   Dim FolderSql, Folder,ClassPurview
					 FolderSql = "Select ID,ChannelID,TN,Folder,FolderDomain,FolderFsoIndex,ClassPurview From KS_Class Where ID='" & FolderID & "'"
					 Dim FolderRS:Set FolderRS=Server.CreateObject("ADODB.RECORDSET")
					 FolderRS.Open FolderSql, Conn, 1, 1
					 If Not FolderRS.EOF Then
					       ClassPurview=FolderRS("ClassPurview")
						   If Cbool(FullPathFlag) = True Then
								'判断是否绑定域名
							   If Trim(FolderRS(4)) <> "" And CStr(FolderRS(2)) = "0" Then
									IF ClassPurview=2 Or GetChannelConfig(FolderRS(1),"FsoHtmlTF")=0 Then
									 GetFolderPath = Trim(FolderRS(4)) & GetChannelNoHtmlUrl(FolderRS(1),FolderRS(0))
								   Else
									 GetFolderPath = Trim(FolderRS(4)) & FolderRS("FolderFsoIndex")
								   End If
							   ElseIf Trim(FolderRS(4)) <> "" Then
								 Folder = Trim(FolderRS(3))
								 Folder = Right(Mid(Folder, InStr(Folder, "/")), Len(Mid(Folder, InStr(Folder, "/"))) - 1)
								 
									IF ClassPurview=2 Or GetChannelConfig(FolderRS(1),"FsoHtmlTF")=0 Then
									 GetFolderPath = Trim(FolderRS(4)) & GetChannelNoHtmlUrl(FolderRS(1),FolderRS(0))
								   Else
									 GetFolderPath = Trim(FolderRS(4)) & Folder & FolderRS("FolderFsoIndex")
								   End If
							   Else
									IF ClassPurview=2 Or GetChannelConfig(FolderRS(1),"FsoHtmlTF")=0 Then
									 GetFolderPath = GetChannelNoHtmlUrl(FolderRS(1),FolderRS(0))
								   Else
									 GetFolderPath = GetChannelDomain(FolderRS(1)) & FolderRS(3) & FolderRS("FolderFsoIndex")
								   End If
								 
							   End If
							   
							Else
							   If Trim(FolderRS(4)) <> "" And CStr(FolderRS("TN")) = "0" Then
								'	IF ClassPurview=2 Then
								'	 GetFolderPath = Trim(FolderRS(4)) & GetChannelNoHtmlUrl(FolderRS(1),FolderRS(0))
								'   Else
									 GetFolderPath = Trim(FolderRS(4))
								'   End If
							   ElseIf Trim(FolderRS(4)) <> "" Then
								 Folder = Trim(FolderRS(3))
								 Folder = Right(Mid(Folder, InStr(Folder, "/")), Len(Mid(Folder, InStr(Folder, "/"))) - 1)
								'	IF ClassPurview=2 Then
								'	 GetFolderPath = Trim(FolderRS(4)) & GetChannelNoHtmlUrl(FolderRS(1),FolderRS(0))
								'   Else
									 GetFolderPath = Trim(FolderRS(4)) & Folder
								'   End If
								   
							   Else
								'	IF ClassPurview=2 Then
								'	 GetFolderPath = GetChannelNoHtmlUrl(FolderRS(1),FolderRS(0))
								'   Else
									 GetFolderPath = GetChannelDomain(FolderRS(1)) & FolderRS(3)
								'   End If
									
							   End If
							End If
					 Else
					  GetFolderPath = ""
					 End If
					 FolderRS.Close:Set FolderRS = Nothing
					 KSCache.add GetFolderPath,dateadd("n",1000000,now)
			End IF
		End Function
		'************************************************************************
		'函数名: GetFolderNameAndLink
		'功 能: 取得目录名称并加上链接
		'参 数: FolderID目录的ID,OpenTypeStr 窗口打开类型,FolderCss 栏目名称样式	          
		'*************************************************************************
		Function GetFolderNameAndLink(FolderID, OpenTypeStr, FolderCss)
			  KSCache.name=SiteSN &"ClassNameAndPath" & FolderID & OpenTypeStr & FolderCss
			  IF KSCache.valid and KSCache.value<>"" Then 
			   GetFolderNameAndLink=KSCache.value
			  Else   
				   Call KSCache.clean
				   Dim FolderSql, Folder,ClassPurview,ChannelFsoHtmlTF
					 FolderSql = "Select ID,ChannelID,FolderName,Folder,FolderDomain,TN,ClassPurview,FolderFsoIndex From KS_Class Where ID='" & FolderID & "'"
					 Dim FolderRS:Set FolderRS=Server.CreateObject("ADODB.RECORDSET")
					 FolderRS.Open FolderSql, Conn, 1, 1
					 ClassPurview=FolderRS("ClassPurview")
					 ChannelFsoHtmlTF=GetChannelConfig(FolderRS(1),"FsoHtmlTF")
					 
					 If Not FolderRS.EOF Then
					  '判断根目录是否有绑定二级域名
					  If Trim(FolderRS(4)) <> "" And CStr(FolderRS(5)) = "0" Then
							 IF ClassPurview=2 Or ChannelFsoHtmlTF=0 Then
								 GetFolderNameAndLink = "<a " & GetCss(FolderCss) & " href=""" & Trim(FolderRS(4)) & GetChannelNoHtmlUrl(FolderRS(1),FolderRS(0)) & """" & OpenTypeStr & ">"
							   Else
								 GetFolderNameAndLink = "<a " & GetCss(FolderCss) & " href=""" & Trim(FolderRS(4)) & Trim(FolderRS("FolderFsoIndex")) & """" & OpenTypeStr & ">"
							   End If
						   ElseIf Trim(FolderRS(4)) <> "" Then
							  Folder = Trim(FolderRS(3))
							  Folder = Right(Mid(Folder, InStr(Folder, "/")), Len(Mid(Folder, InStr(Folder, "/"))) - 1)
							  IF ClassPurview=2 Or ChannelFsoHtmlTF=0 Then
								 GetFolderNameAndLink = "<a " & GetCss(FolderCss) & " href=""" & Trim(FolderRS(4)) & GetChannelNoHtmlUrl(FolderRS(1),FolderRS(0)) & """" & OpenTypeStr & ">"
							   Else
								  GetFolderNameAndLink = "<a " & GetCss(FolderCss) & " href=""" & Trim(FolderRS(4)) & Folder & Trim(FolderRS("FolderFsoIndex")) & """" & OpenTypeStr & ">"
							   End If
							 
						  Else
							   IF ClassPurview=2 Or ChannelFsoHtmlTF=0 Then
								 GetFolderNameAndLink = "<a " & GetCss(FolderCss) & " href=""" & GetChannelNoHtmlUrl(FolderRS(1),FolderRS(0)) & """" & OpenTypeStr & ">"
							   Else
								 GetFolderNameAndLink = "<a " & GetCss(FolderCss) & " href=""" & (GetChannelDomain(CInt(FolderRS(1))) & FolderRS(3) & Trim(FolderRS("FolderFsoIndex"))) & """" & OpenTypeStr & ">"
							   End If
						  End If
					  GetFolderNameAndLink = GetFolderNameAndLink & Trim(FolderRS(2)) & "</a>"
					 Else
					  GetFolderNameAndLink = ""
					 End If
					 FolderRS.Close:Set FolderRS = Nothing
					 KSCache.add GetFolderNameAndLink,dateadd("n",1000000,now)
			End if
		End Function
		'取得栏目的链接URL
		Public Function GetChannelNoHtmlUrl(ChannelID,ClassID)
		  Select Case ChannelID
		   Case 1
		     GetChannelNoHtmlUrl=GetDomain & "Article/ShowClass.asp?ID=" & ClassID
		   Case 2
		     GetChannelNoHtmlUrl=GetDomain & "Photo/ShowClass.asp?ID=" & ClassID
		   Case 3
		     GetChannelNoHtmlUrl=GetDomain & "DownLoad/ShowClass.asp?ID=" & ClassID
		   Case 4
		     GetChannelNoHtmlUrl=GetDomain & "Flash/ShowClass.asp?ID=" & ClassID
		  End Select
		End Function
		'***************************************************************************
		'函数名: GetInfoUrl
		'功 能: 取得每篇文章、图片等的Url链接
		'参 数: ChannelID频道的ID,RSObj--信息的recordset对象      
		'****************************************************************************
        Public Function GetInfoUrl(ByVal ChannelID,ByVal RSObj)
		  IF Not Isnumeric(ChannelID) Then GetInfoUrl="#":Exit Function
		  Select Case ChannelID
		   Case 1
				 '当需要点数阅读或是指定的会员组才能查看或是继承栏目且该栏目的权限为半开放或认证栏目时，不能生成静态
				 If  RSObj("ReadPoint")>0 Or GetChannelConfig(ChannelID,"FsoHtmlTF")=0 Or RSObj("InfoPurview")=2  Or (RSObj("InfoPurview")=0 And (GetClassConfig(RSObj("Tid"),"ClassPurview")=1 Or GetClassConfig(RSObj("Tid"),"ClassPurview")=2)) Then 
				   GetInfoUrl=GetDomain & "Article/ShowInfo.asp?ID=" &RSObj("ID")
				 Else
				   GetInfoUrl=GetFolderPath(RSObj("Tid"), False) & RSObj("Fname")
				 End If
		   Case 2
				 '当需要点数阅读或是指定的会员组才能查看或是继承栏目且该栏目的权限为半开放或认证栏目时，不能生成静态
				 If  RSObj("ReadPoint")>0 Or GetChannelConfig(ChannelID,"FsoHtmlTF")=0 Or RSObj("InfoPurview")=2  Or (RSObj("InfoPurview")=0 And (GetClassConfig(RSObj("Tid"),"ClassPurview")=1 Or GetClassConfig(RSObj("Tid"),"ClassPurview")=2)) Then 
				   GetInfoUrl=GetDomain & "Photo/ShowInfo.asp?ID=" &RSObj("ID")
				 Else
				   GetInfoUrl=GetFolderPath(RSObj("Tid"), False) & RSObj("Fname")
				 End If
		   Case 3
				 '当需要点数阅读或是指定的会员组才能查看或是继承栏目且该栏目的权限为半开放或认证栏目时，不能生成静态
				 If  GetChannelConfig(ChannelID,"FsoHtmlTF")=0 Then 
				   GetInfoUrl=GetDomain & "DownLoad/ShowInfo.asp?ID=" &RSObj("ID")
				 Else
				   GetInfoUrl=GetFolderPath(RSObj("Tid"), False) & RSObj("Fname")
				 End If
		   Case 4
				 '当需要点数阅读或是指定的会员组才能查看或是继承栏目且该栏目的权限为半开放或认证栏目时，不能生成静态
				 If  RSObj("ReadPoint")>0 Or GetChannelConfig(ChannelID,"FsoHtmlTF")=0 Or RSObj("InfoPurview")=2  Or (RSObj("InfoPurview")=0 And (GetClassConfig(RSObj("Tid"),"ClassPurview")=1 Or GetClassConfig(RSObj("Tid"),"ClassPurview")=2)) Then 
				   GetInfoUrl=GetDomain & "Flash/ShowInfo.asp?ID=" &RSObj("ID")
				 Else
				   GetInfoUrl=GetFolderPath(RSObj("Tid"), False) & RSObj("Fname")
				 End If
		  End Select
		End Function
		'取消HTML
		Public Function LoseHtml(ContentStr)
			Dim TempLoseStr, regEx
			TempLoseStr = CStr(ContentStr)
			Set regEx = New RegExp
			regEx.Pattern = "<\/*[^<>]*>"
			regEx.IgnoreCase = True
			regEx.Global = True
			TempLoseStr = regEx.Replace(TempLoseStr, "")
			LoseHtml = TempLoseStr
		End Function
		'-----------------------------------------------------------------------------------------------------------------------
		'函数名: GetCss
		'功 能:取得样式
		'参 数: CssName样式名称
		'--------------------------------------------------------------------------------------------
		Function GetCss(CssName)
			 If CssName = "" Then
			   GetCss = ""
			 Else
			   GetCss = " class=""" & CssName & """"
			 End If
		End Function
	'**************************************************
	'函数名：ReturnChannel
	'作  用：返回频道名称
	'参  数：ChannelID--频道ID
	'返回值：频道名称
	'**************************************************
	Public Function ReturnChannel(ChannelID)
		 Dim RS:Set RS=Server.CreateObject("ADODB.RECORDSET")
		 If ChannelID = "" Then
		  ReturnChannel = "":Exit Function
		 End If
		 RS.Open "SELECT ChannelName FROM [KS_Channel] WHERE ShowChannel=1 And ChannelID=" & ChannelID, Conn, 1, 1
		 If Not RS.EOF Then
		  ReturnChannel = RS(0)
		 Else
		  ReturnChannel = " "
		 End If
		  RS.Close:Set RS = Nothing
	End Function
	'**************************************************
	'函数名：ReturnChannelAllowUpFilesTF
	'作  用：返回频道的是否允许上传文件
	'参  数：ChannelID--频道ID
	'**************************************************
	Public Function ReturnChannelAllowUpFilesTF(ChannelID)
	Dim InstallDir
	  If ChannelID = "" Or Not IsNumeric(ChannelID) Then
	  ChannelID = 0
	  End If
	   Dim CRS:Set CRS=Server.CreateObject("ADODB.RECORDSET")
	   CRS.Open "Select UpFilesTF From KS_Channel Where ChannelID=" & ChannelID, Conn, adOpenForwardOnly, adLockReadOnly
	  If CInt(ChannelID) = 0 Or (CRS.EOF And CRS.BOF) Then  '默认允许上传文件
		ReturnChannelAllowUpFilesTF = True
	  Else
		If CRS(0) = 1 Then
		 ReturnChannelAllowUpFilesTF = True
		Else
		 ReturnChannelAllowUpFilesTF = False
		End If
	  End If
	CRS.Close:Set CRS = Nothing
	End Function
	'**************************************************
	'函数名：ReturnChannelUpFilesDir
	'作  用：返回频道后台的上传目录
	'参  数：ChannelID--频道ID
	'返回值：目录字符串
	'**************************************************
	Public Function ReturnChannelUpFilesDir(ChannelID)
	 Dim InstallDir
	  If ChannelID = "" Or Not IsNumeric(ChannelID) Then
	  ChannelID = 0
	  End If
	   Dim CRS:Set CRS=Server.CreateObject("ADODB.RECORDSET")
	   CRS.Open "Select UpFilesDir From KS_Channel Where ChannelID=" & ChannelID, Conn, adOpenForwardOnly, adLockReadOnly
	  If CInt(ChannelID) = 0 Or (CRS.EOF And CRS.BOF) Then
		ReturnChannelUpFilesDir = GetConfig("UpFilesDir")
	  Else
		ReturnChannelUpFilesDir = CRS(0)
	  End If
	InstallDir = GetConfig("InstallDir")
	ReturnChannelUpFilesDir = Left(ReturnChannelUpFilesDir, Len(ReturnChannelUpFilesDir) - 1)
	If InstallDir = "/" Then ReturnChannelUpFilesDir = "/" & ReturnChannelUpFilesDir
	CRS.Close:Set CRS = Nothing
	End Function