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

📄 cls_js.asp

📁 asp源码 图片ASP整站
💻 ASP
📖 第 1 页 / 共 5 页
字号:
<%
'==============================================================================
'软件名称:风讯网站信息管理系统
'当前版本:Foosun Content Manager System(FoosunCMS V3.2SP1)
'最新更新:2006.50
'==============================================================================
'Copyright (C) 2002-2004 Foosun.Net  All rights reserved.
'商业注册联系:028-85098980-601,项目开发:028-85098980-606、609,客户支持:608
'产品咨询QQ:394226379,159410,125114015
'技术支持QQ:315485710,66252421 
'项目开发QQ:415637671,655071
'程序开发:四川风讯科技发展有限公司(Foosun Inc.)
'Email:service@Foosun.cn
'MSN:skoolls@hotmail.com
'论坛支持:风讯在线论坛(http://bbs.foosun.net)
'官方网站:www.Foosun.cn  演示站点:test.cooin.com 
'网站通系列(智能快速建站系列):www.ewebs.cn
'==============================================================================
'免费版本请在程序首页保留版权信息,并做上本站LOGO友情连接
'风讯公司保留此程序的法律追究权利
'如需进行2次开发,必须经过风讯公司书面允许。否则将追究法律责任
'==============================================================================
Class JSClass
	Private TempSysRootDir
	Private RowSpace,ListSpace,ListSpaceStr,Temp_i,TableCellSpace,TitleSpace,TitleSpaceStr,MoreContentStr
	Private AvailableDoMain
	Private Sub Class_initialize() 
		TitleSpace = 3 '新闻内容抬头空格字符个数 
		TitleSpaceStr = ""
		for Temp_i = 1 to TitleSpace
			TitleSpaceStr = TitleSpaceStr & "&nbsp;"
		next 
		AvailableDoMain = GetConfig(0)
	End Sub 
	
	Public Property Let SysRootDir(ExteriorValue)
		TempSysRootDir = ExteriorValue
	End Property
	
	Private Sub Class_Terminate()
	End Sub 
	
	Private Function GetOneNewsLinkURL(NewsID)
		Dim DoMain,TempParentID,RsParentObj,RsDoMainObj,ReturnValue
		Dim CheckRootClassIndex,CheckRootClassNumber,TempClassSaveFilePath
		Dim NewsSql,RsNewsObj
		'-----------------------/l
		dim DatePathStr
		CheckRootClassNumber = 30
		ReturnValue = ""
		NewsSql = "Select *,FS_NewsClass.FileExtName as ClassFileExtName,FS_News.FileExtName as NewsFileExtName from FS_News,FS_NewsClass where FS_News.ClassID=FS_NewsClass.ClassID and FS_News.AuditTF=1 and FS_News.NewsID='" & NewsID & "'"
		Set RsNewsObj = Conn.Execute(NewsSql)
		if RsNewsObj.Eof then
			Set RsNewsObj = Nothing
			GetOneNewsLinkURL = ""
			Exit Function
		else
			if RsNewsObj("HeadNewsTF") = 1 then
				ReturnValue = RsNewsObj("HeadNewsPath")
			else
				if RsNewsObj("ParentID") <> "0" then
					Set RsParentObj = Conn.Execute("Select ParentID,Domain from FS_NewsClass where ClassID='" & RsNewsObj("ParentID") & "'")
					if Not RsParentObj.Eof then
						CheckRootClassIndex = 1
						TempParentID = RsParentObj("ParentID")
						do while Not (TempParentID = "0")
							CheckRootClassIndex = CheckRootClassIndex + 1
							RsParentObj.Close
							Set RsParentObj = Nothing
							Set RsParentObj = Conn.Execute("Select ParentID,Domain from FS_NewsClass where ClassID='" & TempParentID & "'")
							if RsParentObj.Eof then
								Set RsParentObj = Nothing
								Set RsNewsObj = Nothing
								GetOneNewsLinkURL = ""
								Exit Function
							end if
							TempParentID = RsParentObj("ParentID")
							if CheckRootClassIndex > CheckRootClassNumber then TempParentID = "0" '防止死循环
						Loop
						DoMain = RsParentObj("DoMain")
						Set RsParentObj = Nothing
					else
						Set RsParentObj = Nothing
						Set RsNewsObj = Nothing
						GetOneNewsLinkURL = ""
						Exit Function
					end if
				else
					DoMain = RsNewsObj("DoMain")
				end if
				'---------------/l
				If Application(LoginCacheNameStr)(21)="1" Then DatePathStr=RsNewsObj("Path") else DatePathStr=""
				if (Not IsNull(DoMain)) And (DoMain <> "") then
					ReturnValue = "http://" & DoMain & "/" & RsNewsObj("ClassEName") & DatePathStr &"/" & RsNewsObj("FileName") & "." & RsNewsObj("NewsFileExtName")
				else
					if RsNewsObj("SaveFilePath") = "/" then
						TempClassSaveFilePath = RsNewsObj("SaveFilePath")
					else
						TempClassSaveFilePath = RsNewsObj("SaveFilePath") & "/"
					end if
					ReturnValue = AvailableDoMain & TempClassSaveFilePath & RsNewsObj("ClassEName") & DatePathStr & "/" & RsNewsObj("FileName") & "." & RsNewsObj("NewsFileExtName")
				end if
				'------------------/l
			end if
		end if
		Set RsNewsObj = Nothing
		GetOneNewsLinkURL = ReturnValue
	End Function
	
	Public Function WCssA(EName,CreateFileTF)
		Dim ClsJSObj,ClsJSFileObj,ClsFileSql,ClsNewsObj,TempEName,JSCodeStr,i,MyFile,CrHNJS,OpenMode
		Set ClsJSObj = Conn.Execute("Select * From FS_FreeJS where EName='"&EName&"'")
			If Not ClsJSObj.eof then
			  JSCodeStr = "document.write('<table class="""&ClsJSObj("BackCSS")&""" width=""100%"" border=""0"" cellpadding=""0"" cellspacing="""&ClsJSObj("RowSpace")&"""><tr>"
			  Set ClsJSFileObj=server.createobject(G_FS_RS)
			  ClsFileSql="select * from FS_FreeJsFile where JSName='"&EName&"' and DelFlag=0 order by ToJsTime desc"
			  ClsJSFileObj.open ClsFileSql,Conn,1,1
			  If ClsJSFileObj.eof then
				JSCodeStr = JSCodeStr & "<td>此JS内暂无新闻</td>"
			  End If
			  If ClsJSObj("OpenMode")=1 then
				  OpenMode = "target=_blank"
			  Else
				  OpenMode = "target=_self"
			  End If
			  for i=1 to ClsJSObj("NewsNum")
				  If ClsJSFileObj.eof then Exit For
				  Set ClsNewsObj = Conn.Execute("Select * From FS_News where FileName='"&ClsJSFileObj("FileName")&"'")
				  If ClsJSObj("ShowTimeTF")="1" then
					  JSCodeStr = JSCodeStr &"<td valign=middle >"&ClsJSObj("NaviPic")&"<a class="""&ClsJSObj("TitleCSS")&""" href=" & GetOneNewsLinkURL(ClsNewsObj("NewsID")) &" "&OpenMode&">"&GotTopic(ClsNewsObj("Title"),ClsJSObj("NewsTitleNum"))&"</a></td><td><Span class="""&ClsJSObj("DateCSS")&""">"&DateFormat(ClsNewsObj("AddDate"),""&ClsJSObj("DateType")&"")&"</Span></td>"
				  Else
					  JSCodeStr = JSCodeStr &"<td valign=middle>"&ClsJSObj("NaviPic")&"<a class="""&ClsJSObj("TitleCSS")&""" href=" & GetOneNewsLinkURL(ClsNewsObj("NewsID")) &" "&OpenMode&">"&GotTopic(ClsNewsObj("Title"),ClsJSObj("NewsTitleNum"))&"</a></td>"
				  End If
				  ClsNewsObj.Close
				  Set ClsNewsObj = Nothing
				  ClsJSFileObj.MoveNext
				  if i mod Cint(ClsJSObj("RowNum")) = 0 or ClsJSFileObj.eof then
					if ClsJSObj("ShowTimeTF")=1 then
						  JSCodeStr = JSCodeStr &"</tr><tr><td colspan="""&Cint(ClsJSObj("RowNum"))*2&""" height="""&ClsJSObj("RowSpace")&""" background="""& AvailableDoMain & ClsJSObj("RowBettween")&"""></td></tr><tr>"
					else
						  JSCodeStr = JSCodeStr &"</tr><tr><td colspan="""&Cint(ClsJSObj("RowNum"))&""" height="""&ClsJSObj("RowSpace")&""" background="""& AvailableDoMain & ClsJSObj("RowBettween")&"""></td></tr><tr>"
					end if
				  end if
			  next 
			  ClsJSFileObj.Close 
			  Set ClsJSFileObj = Nothing 
			  JSCodeStr = JSCodeStr & "</tr></table>');"
			  JSCodeStr = Replace(JSCodeStr,"<tr></tr>","")
			  JSCodeStr = Replace(Replace(JSCodeStr,Chr(13),""),Chr(10),"")
			  Set MyFile=Server.CreateObject(G_FS_FSO)
			  If MyFile.FileExists(Server.MapPath(TempSysRootDir&"\JS\FreeJs")&"\"& EName &".js") then
				 MyFile.DeleteFile(Server.MapPath(TempSysRootDir&"\JS\FreeJs")&"\"& EName &".js")
			  End if
			  Set CrHNJS=MyFile.CreateTextFile(Server.MapPath(TempSysRootDir&"\JS\FreeJs")&"\"& EName &".js")
				  CrHNJS.write JSCodeStr
			  Set MyFile=nothing
			  '---------
			  ClsJSObj.Close
			  Set ClsJSObj = Nothing
			Else
				WCssA = "生成JS文件时未找到参数"
			End If
	End Function 

	Public Function WCssB(EName,CreateFileTF)
		Dim ClsJSObj,ClsJSFileObj,ClsFileSql,ClsNewsObj,TempEName,JSCodeStr,i,MyFile,CrHNJS,OpenMode
		Dim NewsLinkStr
		Set ClsJSObj = Conn.Execute("Select * From FS_FreeJS where EName='"&EName&"'")
			If Not ClsJSObj.eof then
			  JSCodeStr = "document.write('<table class="""&ClsJSObj("BackCSS")&""" width=100% border=0 cellpadding=0 cellspacing="""&ClsJSObj("RowSpace")&"""><tr>"
			  Set ClsJSFileObj=server.createobject(G_FS_RS)
			  ClsFileSql="select * from FS_FreeJsFile where JSName='"&EName&"' and DelFlag=0 order by ToJsTime desc"
			  ClsJSFileObj.open ClsFileSql,Conn,1,1
			  If ClsJSFileObj.eof then 
				JSCodeStr = JSCodeStr & "<td>此JS内暂无新闻</td>"
			  end if
			  If ClsJSObj("OpenMode")=1 then
				  OpenMode = "target=_blank"
			  Else
				  OpenMode = "target=_self"
			  End If
				ListSpaceStr = ""
				for Temp_i = 1 to Cint(ClsJSObj("RowSpace"))
					ListSpaceStr = ListSpaceStr & "&nbsp;"
				next 
			  for i=1 to ClsJSObj("NewsNum")
				  If ClsJSFileObj.eof then Exit For
				  Set ClsNewsObj = Conn.Execute("Select * From FS_News where FileName='"&ClsJSFileObj("FileName")&"'")
				  NewsLinkStr = GetOneNewsLinkURL(ClsNewsObj("NewsID"))
				  If ClsJSObj("ShowTimeTF")=1 then
					  JSCodeStr = JSCodeStr &"<td width="&Cint(100/Cint(ClsJSObj("RowNum")))&"% valign=""top""><table width=100% border=0 cellpadding=0 cellspacing="""&ClsJSObj("RowSpace")&"""><tr><td>"& ClsJSObj("NaviPic") &"<a class="""&ClsJSObj("TitleCSS")&""" href=" & NewsLinkStr &" "&OpenMode&">"&GotTopic(ClsNewsObj("Title"),ClsJSObj("NewsTitleNum"))&"</a></td><td><Span class="""&ClsJSObj("DateCSS")&""">"&DateFormat(ClsNewsObj("AddDate"),""&ClsJSObj("DateType")&"")&"</Span></td><td rowspan=2>"&ListSpaceStr&"</td></tr>"
				  Else
					  JSCodeStr = JSCodeStr &"<td width="&Cint(100/Cint(ClsJSObj("RowNum")))&"% valign=""top""><table width=100% border=0 cellpadding=0 cellspacing="""&ClsJSObj("RowSpace")&"""><tr><td>"& ClsJSObj("NaviPic") &"<a class="""&ClsJSObj("TitleCSS")&""" href=" & NewsLinkStr &" "&OpenMode&">"&GotTopic(ClsNewsObj("Title"),ClsJSObj("NewsTitleNum"))&"</a></td><td rowspan=2>"&ListSpaceStr&"</td></tr>"
				  End If
				  If ClsJSObj("ShowTimeTF")=1 then
					If ClsJSObj("MoreContent")=1 then
					  JSCodeStr = JSCodeStr & "<tr><td colspan=2><Span class="""&ClsJSObj("ContentCSS")&""">"&TitleSpaceStr&GotTopic(Replace(Replace(Replace(LoseHtml(ClsNewsObj("Content")),chr(13) & chr(10),""),"[Page]",""),"&nbsp;",""),ClsJSObj("ContentNum"))&"</Span>......<br><div align=""right""><a class="""&ClsJSObj("LinkCSS")&""" href="&NewsLinkStr&" "&OpenMode&">"&ClsJSObj("LinkWord")&"</a></div></td></tr></table></td>"
					Else
					  JSCodeStr = JSCodeStr & "<tr><td colspan=2><Span class="""&ClsJSObj("ContentCSS")&""">"&TitleSpaceStr&GotTopic(Replace(Replace(Replace(LoseHtml(ClsNewsObj("Content")),chr(13) & chr(10),""),"[Page]",""),"&nbsp;",""),ClsJSObj("ContentNum"))&"</Span>......</td></tr></table></td>"
					End If
				  Else
					If ClsJSObj("MoreContent")=1 then
					  JSCodeStr = JSCodeStr & "<tr><td><Span class="""&ClsJSObj("ContentCSS")&""">"&TitleSpaceStr&GotTopic(Replace(Replace(Replace(Replace(LoseHtml(ClsNewsObj("Content")),chr(13) & chr(10),""),chr(13) & chr(10),""),"[Page]",""),"&nbsp;",""),ClsJSObj("ContentNum"))&"</Span>......<br><div align=""right""><a class="""&ClsJSObj("LinkCSS")&""" href="&NewsLinkStr&" "&OpenMode&">"&ClsJSObj("LinkWord")&"</a></div></td></tr></table></td>"
					Else
					  JSCodeStr = JSCodeStr & "<tr><td><Span class="""&ClsJSObj("ContentCSS")&""">"&TitleSpaceStr&GotTopic(Replace(Replace(Replace(LoseHtml(ClsNewsObj("Content")),chr(13) & chr(10),""),"[Page]",""),"&nbsp;",""),ClsJSObj("ContentNum"))&"</Span>......</td></tr></table></td>"
					End If
				  End If
				  ClsNewsObj.Close
				  Set ClsNewsObj = Nothing
				  ClsJSFileObj.MoveNext
				  if i mod Cint(ClsJSObj("RowNum")) = 0 or ClsJSFileObj.eof then
					  JSCodeStr = JSCodeStr &"</tr><tr><td colspan="""&Cint(ClsJSObj("RowNum"))&""" height="""&ClsJSObj("RowSpace")&""" background="""&ClsJSObj("RowBettween")&"""></td></tr><tr>"
				  end if

⌨️ 快捷键说明

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