function.asp

20041230162250801409： 浙江省丽水市公铁联运有限公司OA系统（物流） 开发语言：PHP/ASP/PERL 本系统包括各个部门的管理

<%
'****************************
'系统预处理类
'****************************
Class System_Cls
	Private LocalCacheName,Cache_Data
	Public Reloadtime,CacheName,CacheData,savelog,SqlQueryNum '新增变量
	Public pNum,pNum2

	'声明System_Cls类预处理内容
	Private Sub Class_Initialize()
		Dim UserAgent,web_CacheName
		web_CacheName = "asp163"   '缓存名称，如果一个站点有多个站请更改成不同名称
		UserAgent = Trim(Lcase(Request.Servervariables("HTTP_USER_AGENT")))
		If InStr(UserAgent,"teleport") > 0 or InStr(UserAgent,"webzip") > 0 or InStr(UserAgent,"flashget")>0 or InStr(UserAgent,"offline")>0 Then
			Response.Write "请不要采用teleport/Webzip/Flashget/Offline等工具来浏览网站！"
			Response.End
		End If
		CacheName=Replace(Server.MapPath("\index.asp"),"index.asp","")
		if right(CacheName,3)="inc" then
			CacheName=Replace(CacheName,"inc","")
		end if
		CacheName=Replace(CacheName,":","")
		CacheName=Replace(CacheName,"\","")	'重大错误，阿炜发现修正	
		CacheName=CacheName & web_CacheName  '一枝梅添加
		Reloadtime=14400
		savelog=0
		SqlQueryNum=0
		pNum=1:pNum2=0
	End Sub

	'声明System_Cls类终止处理内容
	Private Sub class_terminate()
		If IsObject(Conn) Then 
			Conn.Close
			Set Conn = Nothing
		End If 
	End Sub

	'Cache处理过程
	Public Property Let Name(ByVal vNewValue)
		LocalCacheName=LCase(vNewValue)
	End Property

	Public Property Let Value(ByVal vNewValue)
		If LocalCacheName<>"" Then 
			ReDim Cache_Data(2)
			Cache_Data(0)=vNewValue
			Cache_Data(1)=Now()
			Application.Lock
			Application(CacheName & "_" & LocalCacheName) = Cache_Data
			Application.unLock
		Else
			Err.Raise vbObjectError + 1, "CacheServer", " please change the CacheName."
		End If
	End Property
	Public Property Get Value()
		If LocalCacheName<>"" Then 
			Cache_Data=Application(CacheName & "_" & LocalCacheName)	
			If IsArray(Cache_Data) Then
				Value=Cache_Data(0)
			Else
				Err.Raise vbObjectError + 1, "CacheServer", " The Cache_Data("&LocalCacheName&") Is Empty."
			End If
		Else
			Err.Raise vbObjectError + 1, "CacheServer", " please change the CacheName."
		End If
	End Property
	Public Function ObjIsEmpty()
		ObjIsEmpty=True	
		Cache_Data=Application(CacheName & "_" & LocalCacheName)
		If Not IsArray(Cache_Data) Then Exit Function
		If Not IsDate(Cache_Data(1)) Then Exit Function
		If DateDiff("s",CDate(Cache_Data(1)),Now()) < (60*Reloadtime) Then ObjIsEmpty=False		
	End Function
	Public Sub DelCahe(MyCaheName)
		Application.Lock
		Application.Contents.Remove(CacheName&"_"&MyCaheName)
		Application.unLock
	End Sub



	'定义系统资源变量
	Public Site_Info,Site_Setting,Site_Version,Site_Copyright,BadWords,rBadWord
	'取得系统定义资源
	Public Sub GetSite_Setting()
		Name="setup"
		If ObjIsEmpty() Then ReloadSetup()
		CacheData=value

		'每日更新数据
		Name="Date"
		'第一次起用网站或者重启IIS的时候加载缓存
		If ObjIsEmpty() Then
			value=Date()
		End If
		Name="Date"
		If Cstr(value) <> Cstr(Date()) Then
			Name="setup"
		        value=Date()
			ReloadSetup()
			CacheData=value
			DelCahe("SiteCount")
		End If
		Dim Setting
		Setting = CacheData(1,0)
		Setting = Split(Setting,"|||")
		Site_Info = Setting(0)
		Site_Info = Split(Site_Info,",")
		Site_Setting = Setting(1)
		Site_Setting = Split (Site_Setting,",")
		Site_Version = CacheData(2,0)
		Site_Copyright = CacheData(3,0)
		BadWords = Split(CacheData(5,0),"|")
		rBadWord = Split(CacheData(6,0),"|")
	End Sub

	Public Sub ReloadSetup()
		Dim SQL,Rs,i
		SQL = "Select * from [AC_setup]"
		Set Rs = Execute(SQL)
		value = Rs.GetRows(1)
		Set Rs = Nothing
	End Sub 


	'定义风格相关变量
	Public StyleName,Site_CSS,Site_PicUrl,Site_UserFace,Site_PostFace,Site_Emot,mainhtml,lanstr,mainpic,mainsetting

	'装载页面模板
	Public Sub LoadTemplates(Page_Fields)
		Dim Style_Pic,Main_Style,TempStyle

		Name="StyleName"
		If ObjIsEmpty() Then TemplatesToCache ("StyleName")
		StyleName=value					'取得风格名称

		Name="Site_CSS"
		If ObjIsEmpty() Then TemplatesToCache ("Site_CSS")
		TempStyle = value
		TempStyle = Split(TempStyle,"@@@")
		Site_CSS = Split(TempStyle(1),"|||")(0)				'风格内容
		Site_PicUrl = Split(TempStyle(2),"|||")(0)				'图片路径

		Name = "Main_Style"
		If ObjIsEmpty() Then TemplatesToCache ("Main_Style")
		Main_Style = Replace(value,"{$PicUrl}",Site_PicUrl)		'风格图片路径替换

		mainhtml = Split(Main_Style,"|||")
		mainsetting = Split(mainhtml(0),"||")
		Site_CSS = Replace(Site_CSS,"{$width}",mainsetting(0))
		Site_CSS = Replace(Site_CSS,"{$PicUrl}",Site_PicUrl)


		'取得页面模板
		If Page_Fields<>"" Then
			Name="page_"&Page_Fields
			If ObjIsEmpty() Then TemplatesToCache ("page_"&Page_Fields)
			Template.value = value
		End If
	End Sub

	'模板装载函数
	Public Sub TemplatesToCache(Page_Fields)
		Dim Rs,SQL
		SQL = "Select "&Page_Fields&" from AC_Style where isdefault=1"
		Set Rs = execute(sql)
		If Not Rs.EOF Then
			value=Rs(0)&""
		Else
			Call FixSetupsid()
		End If
		Set Rs = Nothing
	End Sub

	Private Sub FixSetupsid()
		Dim Rs,SQL
		SQL = "Select Top 1 ID from AC_Style Order by ID"
		Set Rs = execute(sql)
		If Rs.EOF Then
			Response.Write "模板数据是空的，请添加。"
			Response.End 	
		Else
			Execute("Update AC_style Set isdefault=1")
		End If
		Set rs=Nothing 
	End Sub

	Public Sub ReloadTemplateslist()		
		Dim Rs,SQL,tmpdata
		SQL = "select ID,StyleName from AC_Style"
		Set Rs = execute(SQL)
		tmpdata = Rs.GetString(,,"|||","@@@","")
		tmpdata = Left(tmpdata,Len(tmpdata)-3)	
		Set Rs = Nothing 
		value=tmpdata
	End Sub

	Public Sub Reloaddefaultstyleid()		
		Dim Rs,SQL,tmpdata
		SQL = "select ID from AC_Style where isdefault=1"
		Set Rs = execute(SQL)
		tmpdata = Rs(0)
		Set Rs = Nothing 
		value=tmpdata
	End Sub


	'页面显示类函数
	Public Sub head()
		Name="head"
		If ObjIsEmpty() Then
			value = Replace(Replace(Replace(Replace(mainhtml(1),"{$sitename}",Site_info(0)),"{$keyword}",Replace(Site_info(2),"|",",")),"{$description}",Site_info(3)),"{$Site_CSS}",Site_CSS)&vbNewLine
		End If
		Response.Write value	    '写入HTTP头
		dim strtmp,strrow,strcol,channelstr,i,j
		if Site_Setting(2)=1 then
			channelstr="|&nbsp;"
			Name="channel"
			If ObjIsEmpty() Then loadchannel()
			strrow=Split(value,"@@@")
			For i = 0 to UBound(strrow)-1
				strcol=Split(strrow(i),"|||")
				channelstr=channelstr & "<a href=" & strcol(2) &" class=Channel>" 
				if strcol(1)="" then
				    channelstr=channelstr & strcol(0)
				else
				    channelstr=channelstr & "<img src="&strcol(1)&">"
				end if
				channelstr=channelstr & "</a>&nbsp;|&nbsp;"
			next
		else
			channelstr=""
		end if
		strtmp = Replace(mainhtml(2),"{$channel}",channelstr)


		Name="classlist"&ChannelID 
		If ObjIsEmpty() Then loadclasslist()
		strtmp = Replace(strtmp,"{$ClassMenu}",value)

		'取当前路径
		if PageTitle<>"" then
			strPath=strPath & "&nbsp;&gt;&gt;&nbsp;" & PageTitle
		end if
		strtmp = Replace(strtmp,"{$width}",mainsetting(0))
		strtmp = Replace(strtmp,"{$PicUrl}",Site_PicUrl)
		strtmp = Replace(strtmp,"{$ShowAnnounce}",Announcestr(2,5))
		strtmp = Replace(strtmp,"{$SiteUrl}",nt2003.site_info(4)) 
		strtmp = Replace(strtmp,"{$SiteName}",nt2003.site_info(0)) 
		strtmp = Replace(strtmp,"{$path}",strPath)
		Response.Write strtmp '写入head表格
		End Sub

	Public Sub bottom()
		Dim strtmp
		strtmp = mainhtml(3)
		If Site_Setting(0) = "1" Then '是否显示网站运行时间
			Dim Endtime
			Endtime = Timer()	
			strtmp = Replace(strtmp,"{$runtime}","执行时间：" & CStr(FormatNumber((Timer-BeginTime)*1000,2)) & " 毫秒") 
		Else
			strtmp = Replace(strtmp,"{$runtime}","")
		End If
		strtmp = Replace(strtmp,"{$width}",mainsetting(0))
		strtmp = Replace(strtmp,"{$PicUrl}",Site_PicUrl)
		strtmp = Replace(strtmp,"{$powered}",Site_Version)
		strtmp = Replace(strtmp,"{$copyright}",Site_Copyright)
		strtmp = Replace(strtmp,"{$webmaster}",Site_Info(7))
		strtmp = Replace(strtmp,"{$webmastemail}",site_info(8))
		strtmp = Replace(strtmp,"{$StyleName}",StyleName)
		strtmp = Replace(strtmp,"{$SqlQueryNum}"," | 查询数据库："&SqlQueryNum&" 次") 
		strtmp = strtmp & mainhtml(4)
		Response.Write strtmp 
	End Sub


'页面显示内容函数
	'读取网站频道名称
	Public Sub loadchannelname()
		dim strrow,strcol,i
		Name="channel"
		If ObjIsEmpty() Then loadchannel()
		strrow=Split(value,"@@@")
			strcol=Split(strrow(Channelid-1),"|||")
			ChannelUrl=strcol(2)
			ChannelName=strcol(0)
	end sub
	'读取网站频道列表
	Public Sub loadchannel()
		Dim Rs,SQL,tmpdata
		SQL = "select ChannelName,ChannelPicUrl,LinkUrl from channel order by OrderID"
		Set Rs = execute(SQL)
		tmpdata = Rs.GetString(,,"|||","@@@","")
		Set Rs = Nothing 
		value=tmpdata
	end Sub
	'读取网站栏目列表
	Public Sub loadclasslist()
		if ChannelID<5 then
			value = "<script type='text/javascript' language='JavaScript1.2'>" & vbcrlf & "<!--" & vbcrlf
			value = value & "stm_bm(['uueoehr',400,'','images/blank.gif',0,'','',0,0,0,0,0,1,0,0]);" & vbcrlf
			value = value & "stm_bp('p0',[0,4,0,0,2,2,0,0,100,'',-2,'',-2,90,0,0,'#000000','transparent','',3,0,0,'#000000']);" & vbcrlf
			value = value & "stm_ai('p0i0',[0,'|','','',-1,-1,0,'','_self','','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#000000','#000000','#000000','9pt 宋体','9pt 宋体',0,0]);" & vbcrlf