⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 ks_refreshcls.asp

📁 SK信息采集2.0功能介绍: 1.可针对任何静态网页,动态网页进行采集。包括htm,html,shtml,ASP,ASPX,JSP,PHP等。 2.增加自定文件采集.用户可采集网页中的所有文件.
💻 ASP
📖 第 1 页 / 共 5 页
字号:
🔍
12345 
			JSRS.Close:Set JSRS = Nothing
			 '刷新完毕后,移除缓存Application
			Call KSCMS.DelApplication
		End Sub
		Function ReplaceJsBr(Content)
		 Dim i
		 Dim JsArr:JSArr=Split(Content,Chr(13) & Chr(10))
		 For I=0 To Ubound(JsArr)
		   ReplaceJsBr=ReplaceJsBr & "document.writeln('" & JsArr(I) &"')" & vbcrlf 
		 Next
		End Function
		'*********************************************************************************************************
		'函数名：RefreshWordJS
		'作  用：发布文字JS
		'参  数：JSID JSID,JSConfig JS参数
		'*********************************************************************************************************
		Function RefreshWordJS(JSID, JSConfig)
		   Dim JSConfigArr:JSConfigArr = Split(JSConfig, ",")
			 If UBound(JSConfigArr) = 17 Then
					RefreshWordJS = KMRFObj.RefreshCss(JSID, UCase(JSConfigArr(0)), JSConfigArr(1), JSConfigArr(2), JSConfigArr(3), JSConfigArr(4), JSConfigArr(5), JSConfigArr(6), JSConfigArr(7), JSConfigArr(8), JSConfigArr(9), JSConfigArr(10), JSConfigArr(11), JSConfigArr(12), JSConfigArr(13), JSConfigArr(14), JSConfigArr(15), JSConfigArr(16), JSConfigArr(17))
					RefreshWordJS = Replace(RefreshWordJS, "'", """")
					RefreshWordJS = "document.write('" & RefreshWordJS & "');"
			 Else
					RefreshWordJS = "document.write('标签参数溢出！');"
			 End If
		End Function
		'*********************************************************************************************************
		'函数名：RefreshPicJS
		'作  用：发布图片JS
		'参  数：JSID JSID,JSConfig JS参数
		'*********************************************************************************************************
		Function RefreshPicJS(JSID, JSConfig)
		
		End Function
		
		
		
		
		
		
		
		
		
		'=================================以下为相关栏目,内容页,频道首页等的刷新函数=====================================
		'   增加日期 2005-9-29  作者:林文仲
		'===================================================================================================================
		
		'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
		'函数名：RefreshArticleContent
		'作  用：刷新文章内容页面
		'参  数：RefreshRS Recordset数据集
		'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
		Function RefreshArticleContent(RefreshRS)
			 Dim TFileContent, FileContent, FilePath, FilePathAndName, FilePathAndNameTemp, ArticleDir, Fname, FExt, TempFileContent,FolderDomain, ArticleContent, ArticleContentArr, TotalPage, I, N, CurrPage, ArticlePageStr, FolderPath,Flag
			  '设置刷新类型,以取得当前导航位置
			   Application(KSCMS.SiteSN & "RefreshType") = "ArticleContent"
			   Application(KSCMS.SiteSN & "RefreshFolderID") = RefreshRS("Tid")
			   Application(KSCMS.SiteSN & "RefreshArticleID") = RefreshRS("NewsID")
			  
				'读出内容页对应的模板
			   TempFileContent = LoadTemplate(RefreshRS("TemplateID"))
			   If Trim(TempFileContent) = "" Then TempFileContent = "模板不存在!"
				TempFileContent = ReplaceAllLabel(TempFileContent)
			   '如果有发现相关文章标签,则进行{$GetCorrelativeArticle(替换为[$GetCorrelativeArticle(,使该标签无效,因为每篇文章的相关文章都不一样,要重新刷新!
				If InStr(TempFileContent, "{$GetCorrelativeArticle(") <> 0 Then
				 TempFileContent = Replace(TempFileContent, "{$GetCorrelativeArticle(", "[$GetCorrelativeArticle(")
				 Flag = True
				Else
				 Flag = False
				End If
			   If Flag = True Then
				TFileContent = ReplaceLableFlag(ReplaceGeneralLabelContent(TempFileContent))
			   '为了提高刷新速度,采用Application缓存
			   ElseIf (RefreshRS("TemplateID") <> Application(KSCMS.SiteSN & "RefreshArticleContentTemplateID")) Or (Trim(RefreshRS("Tid")) <> Trim(Application(KSCMS.SiteSN & "RefreshArticleContentTid"))) Or Application(KSCMS.SiteSN & "RefreshArticleContentTempFileContent") = "" Then
				Application(KSCMS.SiteSN & "RefreshArticleContentTid") = RefreshRS("Tid")
				Application(KSCMS.SiteSN & "RefreshArticleContentTemplateID") = RefreshRS("TemplateId")
				Application(KSCMS.SiteSN & "RefreshArticleContentTempFileContent") = ReplaceLableFlag(ReplaceGeneralLabelContent(TempFileContent))  '替换函数标签
				TFileContent = Application(KSCMS.SiteSN & "RefreshArticleContentTempFileContent")
			  Else
				TFileContent = Application(KSCMS.SiteSN & "RefreshArticleContentTempFileContent")
			  End If
			   
			  '分离文件名和扩展名
			  FExt = Mid(Trim(RefreshRS("Fname")), InStrRev(Trim(RefreshRS("Fname")), ".")) '分离出扩展名
			  Fname = Replace(Trim(RefreshRS("Fname")), FExt, "")  '分离出文件名 如 2005/9-10/1254ddd
			   
			  Dim FolderRS:Set FolderRS= Server.CreateObject("ADODB.Recordset")
			  FolderRS.Open "Select FolderDomain,Folder From KS_Class WHERE ID='" & Trim(RefreshRS("Tid")) & "'", Conn, 1, 1
			  
			  FolderDomain = Trim(FolderRS("FolderDomain"))
			  ArticleDir = KSCMS.GetConfig("ArticleDir")
			  If Left(ArticleDir, 1) = "/" Or Left(ArticleDir, 1) = "\" Then ArticleDir = Right(ArticleDir, Len(ArticleDir) - 1)
			  FilePathAndNameTemp = KSCMS.GetConfig("InstallDir") & ArticleDir
			  FilePathAndName = FilePathAndNameTemp & FolderRS("Folder") & RefreshRS("Fname")
			  FilePath = Replace(FilePathAndName, Mid(FilePathAndName, InStrRev(FilePathAndName, "/")), "")
			  Call KSCMS.CreateListFolder(FilePath)
			  
			  FolderPath = KSCMS.GetFolderPath(RefreshRS("Tid"), False)
			  ArticleContent =RefreshRS("ArticleContent")

			  If IsNull(ArticleContent) Then ArticleContent = ""
			  ArticleContentArr = Split(ArticleContent, "[NextPage]")
			  TotalPage = UBound(ArticleContentArr) + 1
			  
			  For I = 0 To UBound(ArticleContentArr)
			   CurrPage = I + 1
			   
			   If TotalPage > 1 Then
					   If I = 0 Then
						 ArticlePageStr = "<p><div align=center><a href=" & FolderPath & Fname & "_" & (CurrPage + 1) & FExt & ">下一页</a><br>"
					   ElseIf I = 1 And I <> TotalPage - 1 Then '对于最后一页刚好是第二页的要做特殊处理
						 ArticlePageStr = "<p><div align=center><a href=" & FolderPath & RefreshRS("Fname") & ">上一页</a>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<a href=" & FolderPath & Fname & "_" & (CurrPage + 1) & FExt & ">下一页</a><br>"
					   ElseIf I = 1 And I = TotalPage - 1 Then
						 ArticlePageStr = "<p><div align=center><a href=" & FolderPath & RefreshRS("Fname") & ">上一页</a><br>"
					   ElseIf I = TotalPage - 1 Then
						 ArticlePageStr = "<p><div align=center><a href=" & FolderPath & Fname & "_" & (CurrPage - 1) & FExt & ">上一页</a><br>"
					   Else
						ArticlePageStr = "<p><div align=center><a href=" & FolderPath & Fname & "_" & (CurrPage - 1) & FExt & ">上一页</a>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<a href=" & FolderPath & Fname & "_" & (CurrPage + 1) & FExt & ">下一页</a><br>"
					   End If
					   
					   ArticlePageStr = ArticlePageStr & "本文共<font color=red> " & TotalPage & " </font>页,第&nbsp;&nbsp;"
					
				   For N = 1 To TotalPage
					  If N = 1 Then
						 If CurrPage = N Then
						  ArticlePageStr = ArticlePageStr & "[" & N & "]&nbsp;&nbsp;"
						 Else
						  ArticlePageStr = ArticlePageStr & "<a href=" & FolderPath & RefreshRS("Fname") & ">[" & N & "]</a>&nbsp;&nbsp;"
						 End If
					   Else
						 If CurrPage = N Then
						   ArticlePageStr = ArticlePageStr & "[" & N & "]&nbsp;&nbsp;"
						 Else
						   ArticlePageStr = ArticlePageStr & "<a href=" & FolderPath & Fname & "_" & N & FExt & ">[" & N & "]</a>&nbsp;&nbsp;"
						End If
					  End If
					  
					  If TotalPage > 10 Then
					   If N Mod 10 = 0 Then ArticlePageStr = ArticlePageStr & "<br>"
					  End If
					
					Next
					ArticlePageStr = ArticlePageStr & "页</div></p>"
				 Else
				  ArticlePageStr = ""
				 End If
				 
			   If CurrPage <> 1 Then FilePathAndName = FilePathAndNameTemp & FolderRS("Folder") & Fname & "_" & CurrPage & FExt
				 
			   FileContent = TFileContent
				'如果有发现相关文章标签,$GetCorrelativeArticle(替换回{$GetCorrelativeArticle(,使该标签重新生效,因为每篇文章的相关文章都不一样,要重新刷新!
			   If InStr(FileContent, "[$GetCorrelativeArticle(") <> 0 Then FileContent = ReplaceLableFlag(Replace(FileContent, "[$GetCorrelativeArticle(", "{$GetCorrelativeArticle("))
			  
			   FileContent = ReplaceNewsContent(RefreshRS, FileContent, ArticleContentArr(I) & ArticlePageStr)
			   FileContent = ReplaceRA(FileContent, FolderDomain) '如果采用根相对路径,则替换绝对路径为根相对路径
			   
			  '生成文件
			   Call FSOSaveFile(Published() & FileContent, FilePathAndName)
			
			Next
			FolderRS.Close:Set FolderRS = Nothing
		End Function
		
		'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
		'函数名：RefreshArticleFolder
		'作  用：刷新文章栏目页面
		'参  数：RefreshRS Recordset数据集
		'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
		
		Function RefreshArticleFolder(RefreshRS)
			Dim FileContent, ArticleDir, FilePath, TempFilePath,Index
			
			'设置刷新类型,以取得当前导航位置
			Application(KSCMS.SiteSN & "RefreshType") = "ArticleFolder"
			Application(KSCMS.SiteSN & "RefreshFolderID") = RefreshRS("ID")
			
			'检查当前刷新的是否是频道(栏目)首页
			If Trim(RefreshRS("TN")) = "0" Then
				Application(KSCMS.SiteSN & "RefreshChannelHomeFlag") = True
			Else
				Application(KSCMS.SiteSN & "RefreshChannelHomeFlag") = False
			End If
		
			'读出栏目对应的模板
			FileContent = LoadTemplate(RefreshRS("FolderTemplateID"))
			If Trim(FileContent) = "" Then FileContent = "模板不存在!"
			
			FileContent = ReplaceGeneralLabelContent(FileContent)          '替换网站通用标签
			
			FileContent = ReplaceAllLabel(FileContent)
			'如果有发现文章分页列表标签,则进行{$GetLastArticleList(替换为{PageListStr}{$GetLastArticleList(
			If InStr(FileContent, "{$GetLastArticleList(") <> 0 Then FileContent = Replace(FileContent, "{$GetLastArticleList(", "{PageListStr}{$GetLastArticleList(")
			 FileContent = ReplaceLableFlag(FileContent)   '替换函数标签
			 
			 Index = RefreshRS("FolderFsoIndex")
			 ArticleDir = KSCMS.GetConfig("ArticleDir")
			 If Left(ArticleDir, 1) = "/" Or Left(ArticleDir, 1) = "\" Then ArticleDir = Right(ArticleDir, Len(ArticleDir) - 1)
			
			  FilePath = KSCMS.GetConfig("InstallDir") & ArticleDir & RefreshRS("Folder")
			  Call KSCMS.CreateListFolder(FilePath)
				
			If (InStr(FileContent, "{PageListStr}") <> 0) And (Application(Cstr(KSCMS.SiteSN & "PageArticleList")) <> "") Then
			  Call GetPageStr(Application(Cstr(KSCMS.SiteSN & "PageArticleList")), Trim(KSCMS.GetDomain & ArticleDir & RefreshRS("Folder")), Index, FileContent, FilePath, Trim(RefreshRS("FolderDomain")), True)
			  Application.Contents.Remove (KSCMS.SiteSN & "PageArticleList")
			Else
			 FileContent = Replace(FileContent, "{PageListStr}", "")
			 FileContent = ReplaceRA(FileContent, Trim(RefreshRS("FolderDomain")))
			 '生成文件
			 Call FSOSaveFile(Published() & FileContent, FilePath & Index)
		   End If
		End Function
		'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
		'函数名：RefreshSpecials
		'作  用：刷新专题页面
		'参  数：RefreshRS Recordset数据集
		'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
		Function RefreshSpecials(RefreshRS)
			Dim FileContent, SpecialDir, FilePath,Index
			
			'设置刷新类型,以取得当前导航位置
			Application(Cstr(KSCMS.SiteSN & "RefreshType")) = "Special"
			Application(Cstr(KSCMS.SiteSN & "RefreshFolderID")) = Trim(RefreshRS("FolderID"))
			Application(Cstr(KSCMS.SiteSN & "CurrSpecialID")) = Trim(RefreshRS("ID"))            '缓存当前专题ID,以备专题文章分页调用
			'读出专题页对应的模板
			FileContent = LoadTemplate(RefreshRS("TemplateID"))
			If Trim(FileContent) = "" Then FileContent = "专题页模板不存在!"
			
			  FileContent = ReplaceGeneralLabelContent(FileContent)          '替换网站通用标签
			  FileContent = ReplaceAllLabel(FileContent)
			   '如果有发现专题分页列表标签,则进行{$GetLastSpecialArticle(替换为{PageListStr}{$GetLastSpecialArticle(
			  If InStr(FileContent, "{$GetLastSpecialArticle(") <> 0 Then FileContent = Replace(FileContent, "{$GetLastSpecialArticle(", "{PageListStr}{$GetLastSpecialArticle(")
			  FileContent = ReplaceLableFlag(FileContent)                    '替换函数标签
			  
			 Index = Trim(RefreshRS("FsoSpecialIndex"))
			  SpecialDir = KSCMS.GetConfig("SpecialDir")
			  If Left(SpecialDir, 1) = "/" Or Left(SpecialDir, 1) = "\" Then SpecialDir = Right(SpecialDir, Len(SpecialDir) - 1)
			  FilePath = KSCMS.GetConfig("InstallDir") & SpecialDir & RefreshRS("SpecialEName") & "/"
			  
			  Call KSCMS.CreateListFolder(FilePath)
12345

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -