classcommon.asp

依蓝旅游网站管理系统Elan2008.SP2

<%
Class ClassCommon   

   Public ShowPath, PageTitle, ArrOpenType(1), IndexLink, CurrentPage, Suspension, TitleDivide
   Private LangXML, CommonRegExp
   
   Private Sub Class_Initialize()       
	  
	  Set CommonRegExp = New RegExp
	  CommonRegExp.IgnoreCase = True 
      CommonRegExp.Global = True 
	  
	  Set LangXML = Server.CreateObject("Microsoft.XMLDOM")
	  LangXML.async = False
	  LangXML.load(Server.MapPath(InstallDir &"Language/lang.xml"))	  
	  Suspension = Lang("BaseConfig.Suspension", "…")
	  TitleDivide = Lang("BaseConfig.TitleDivide", "——")  
	  
	  IndexLink = "<a href='"& InstallDir &"'>"& Lang("BaseConfig.PathIndex", SiteName) &"</a>"    	  
	  ShowPath = IndexLink
	  PageTitle = SiteTitle
	  ArrOpenType(0) = ""
	  ArrOpenType(1) = " target='_blank'"
	  CurrentPage = ELRequest("Page", 2)	  
	  If CurrentPage < 1 Then CurrentPage = 1
	  
   End Sub
   
   Private Sub Class_Terminate()
      Set LangXML = Nothing
	  Set CommonRegExp = Nothing
   End Sub
   
   Public Function ReplaceCommonLabels(ByVal Html)
	  Dim ReturnHtml
	  If Trim(Html) = "" Then Exit Function
	  ReturnHtml = Html
	  
	  ReturnHtml = ReplaceUserDefineLabels(ReturnHtml)	
	  ReturnHtml = BaseLabel(ReturnHtml)	
	  ReturnHtml = Label_SiteLogo(ReturnHtml)
	  ReturnHtml = Label_ShowChannel(ReturnHtml)	  
	  ReturnHtml = Label_ShowAnnounce(ReturnHtml)
	  ReturnHtml = Label_ShowFriendSite(ReturnHtml)
	  ReturnHtml = Label_ShowVote(ReturnHtml)
	  ReturnHtml = EL_User.Label_UserInfo(ReturnHtml)
	  
	  ReplaceCommonLabels = ReturnHtml
   End Function 
   
   Private Function BaseLabel(ByVal Html)
      Dim ReturnHtml
	  If Trim(Html) = "" Then Exit Function
	  ReturnHtml = Html  	  
	  ReturnHtml = RegExpStaticLabel(ReturnHtml, "{$SiteName}", SiteName)
	  ReturnHtml = RegExpStaticLabel(ReturnHtml, "{$SiteTitle}", SiteTitle)
	  ReturnHtml = RegExpStaticLabel(ReturnHtml, "{$SiteURL}", SiteURL) 
	  ReturnHtml = RegExpStaticLabel(ReturnHtml, "{$LogoURL}", SiteLogo) 	  
	  ReturnHtml = RegExpStaticLabel(ReturnHtml, "{$CookieName}", EL_Sn)
	  ReturnHtml = RegExpStaticLabel(ReturnHtml, "{$Copyright}", Copyright)
	  ReturnHtml = RegExpStaticLabel(ReturnHtml, "{$WebmasterName}", HTMLEncode(WebmasterName))
	  ReturnHtml = RegExpStaticLabel(ReturnHtml, "{$WebmasterEmail}", WebmasterEmail)	
	  If ShowAdminLogin Then  
	     ReturnHtml = RegExpStaticLabel(ReturnHtml, "{$ShowAdminLogin}", "<a class='AdminLogin' href='"& InstallDir & AdminDir &"/Admin_Index.asp' target='_blank'>管理登陆</a>")
	  Else
	     ReturnHtml = RegExpStaticLabel(ReturnHtml, "{$ShowAdminLogin}", "")	     
	  End If
	  ReturnHtml = RegExpStaticLabel(ReturnHtml, "{$JScript}", "<script language='javascript' src='"& InstallDir &"js/Common.js'></script><script language='javascript' src='"& InstallDir &"js/InstallDir.js'></script><script language='javascript' src='"& InstallDir &"js/Ajax.js'></script><script src='"& InstallDir &"Calendar/calendar.js'></script><script language='javascript' src='"& InstallDir &"Js/City.js'></script><script language='javascript' src='"& InstallDir &"Js/Company.js'></script>")
	  ReturnHtml = RegExpStaticLabel(ReturnHtml, "{$MenuJs}", "<script language='javascript' src='"& InstallDir &"js/stm31.js'></script>")
	  ReturnHtml = RegExpStaticLabel(ReturnHtml, "{$Now}", FormatDate(Date()))
	   
	  ReturnHtml = RegExpStaticLabel(ReturnHtml, "{$PointItemName}", PointItemName)
	  ReturnHtml = RegExpStaticLabel(ReturnHtml, "{$PointItemUnit}", PointItemUnit)
	  ReturnHtml = RegExpStaticLabel(ReturnHtml, "{$ExpItemName}", ExpItemName)
	  ReturnHtml = RegExpStaticLabel(ReturnHtml, "{$ExpItemUnit}", ExpItemUnit) 
	  ReturnHtml = RegExpStaticLabel(ReturnHtml, "{$InstallDir}", InstallDir)
	  BaseLabel = ReturnHtml
   End Function
   
   Private Function ReplaceUserDefineLabels(ByVal Html)
      Dim LabelCmd, rsLabel, LabelCount
	  Dim ReturnHtml, i
	  If Trim(Html) = "" Then Exit Function
	  ReturnHtml = Html
	  
	  Call InitCommonCmd(LabelCmd, rsLabel, "EL_Label", "LabelName,LabelType,Parameters,TSQL,Content", "1=1 ORDER BY LabelLevel DESC")
	  rsLabel.Close()
	  LabelCount = LabelCmd(0)	  
	  If LabelCount > 0 Then
	     rsLabel.Open()
		 For i = 1 To LabelCount
			If rsLabel(1) = 1 Then			   
			   ReturnHtml = RegExpStaticLabel(ReturnHtml, "{$"& rsLabel(0) &"}", rsLabel(4))
			Else
			   ReturnHtml = ReplaceDynamicLabel(ReturnHtml, rsLabel(0), rsLabel(2), rsLabel(3), rsLabel(4))
			End If
			If i<LabelCount Then rsLabel.MoveNext
		 Next
		 rsLabel.Close()
	  End If
	  Set rsLabel = Nothing
	  Set LabelCmd = Nothing
	  ReplaceUserDefineLabels = ReturnHtml
   End Function       
   
   Public Function RegExpStaticLabel(ByVal HTML, ByVal LabelName, ByVal RContent)
      Dim Match, Matches, ReturnString  	  
	  If IsNULL(RContent) Then RContent = ""	  
	  CommonRegExp.Pattern = "<!--\{\$"& GetLabelName(LabelName) &"\}-->"        
      Set Matches = CommonRegExp.Execute(HTML)
	  ReturnString = HTML
      For Each Match in Matches
		 ReturnString = Replace(HTML, Match.Value, RContent)
      Next
	  
	  CommonRegExp.Pattern = "\{\$"& GetLabelName(LabelName) &"\}"
	  Set Matches = CommonRegExp.Execute(ReturnString)
	  For Each Match in Matches
		 ReturnString = Replace(ReturnString, Match.Value, RContent)
      Next
	  Set Matches = Nothing
	  
	  RegExpStaticLabel = ReturnString
   End Function   
   
   Public Function ReplaceText(ByVal StrText, ByVal StrPattern, ByVal RContent)
      Dim Match, Matches, ReturnString   
	  If IsNULL(RContent) Then RContent = ""   
	  CommonRegExp.Pattern = StrPattern
      Set Matches = CommonRegExp.Execute(StrText)
	  ReturnString = StrText
      For Each Match in Matches
		 ReturnString = Replace(StrText, Match.Value, RContent)
      Next
	  
	  Set Matches = Nothing	  
	  ReplaceText = ReturnString
   End Function 
   
   Private Function Label_ShowVote(ByVal HTML)
      Dim Match, Matches, ReturnString, Parameters, Temp	  
	  CommonRegExp.Pattern = "<!--\{\$ShowVote\([ 0-9]+\)\}-->"        
      Set Matches = CommonRegExp.Execute(HTML)
	  ReturnString = HTML
	  Temp = ""
      For Each Match in Matches
		 Parameters = GetLabelParameters(Match.Value, "ShowVote")
		 Temp = GetVote(Parameters(0))
		 ReturnString = Replace(ReturnString, Match.Value, Temp)
      Next
	  
	  CommonRegExp.Pattern = "\{\$ShowVote\([ 0-9]+\)\}"
	  Set Matches = CommonRegExp.Execute(ReturnString)
	  For Each Match in Matches
		 Parameters = GetLabelParameters(Match.Value, "ShowVote")
		 Temp = GetVote(Parameters(0))
		 ReturnString = Replace(ReturnString, Match.Value, Temp)
      Next
	  Set Matches = Nothing
	  
	  Label_ShowVote = ReturnString
   End Function
   
   Private Function Vote(ByVal VoteID)
      Dim IsCache
	  IsCache = FoundInArray(Split(Cache_Others, ","), "2")
	  If IsCache Then
	     Vote = EL_Cache.GetCache("Vote."& VoteID, 0)
		 If Vote = "" Then
		    Vote = GetVote(VoteID)
			Call EL_Cache.SetCache("Vote."& VoteID, Vote, -1)
		 End If
	  Else
	     Vote = GetVote(VoteID)
	  End If
   End Function
   
   Private Function GetVote(ByVal VoteID)
      Dim VoteCmd, rsVote
	  Dim i, temp, VoteBody, ItemsBody, VoteType
	  Call EL_Common.InitCommand(VoteCmd, "EL_SP_GetVote")
	  With VoteCmd
	     .Parameters.Append .CreateParameter("RETURN", 2, 4)
		 .Parameters.Append .CreateParameter("@Type", 3, 1, 4, 0)
		 .Parameters.Append .CreateParameter("@VoteID", 3, 1, 4, VoteID)
		 Set rsVote = .Execute()
	  End With
	  rsVote.Close()
	  If VoteCmd(0) <> 1 Then
	     GetVote = EL_Common.Lang("Vote.NoVote", "没有任何调查")
		 Set rsVote = Nothing
		 Set VoteCmd = Nothing
		 Exit Function
	  End If
	  
	  VoteBody = Lang("Vote.VoteBody", "调查模板错误")
	  rsVote.Open()
	  VoteType = rsVote("VoteType")
	  ItemsBody = ""
	  For i = 1 To 10
	     temp = rsVote("Options"& i)
		 If temp <> "" And Not IsNULL(temp) Then
		    If VoteType = 0 Then
			   ItemsBody = ItemsBody &"<div class='voteItems'><input name='VoteItems' id='VoteItems' type='radio' value='"& i &"'/>"& temp &"</div>"
			Else
			   ItemsBody = ItemsBody &"<div class='voteItems'><input name='VoteItems' id='VoteItems' type='checkbox' value='"& i &"'/>"& temp &"</div>"
			End If
		 End If
	  Next  	  
	  VoteBody = RegExpStaticLabel(VoteBody, "{$InstallDir}", InstallDir)
	  VoteBody = RegExpStaticLabel(VoteBody, "{$VoteID}", VoteID)
	  VoteBody = RegExpStaticLabel(VoteBody, "{$VoteType}", VoteType)
	  VoteBody = RegExpStaticLabel(VoteBody, "{$Title}", EL_Common.ServerHTMLEncode(rsVote("Title")))
	  VoteBody = RegExpStaticLabel(VoteBody, "{$VoteItems}", ItemsBody)
	  rsVote.Close()
	  Set rsVote = Nothing
	  Set VoteCmd = Nothing
	  GetVote = VoteBody
   End Function
   
   Private Function Label_SiteLogo(ByVal HTML)
      Dim Match, Matches, ReturnString, Parameters
	  CommonRegExp.Pattern = "<!--\{\$SiteLogo\(([ 0-9]+),([ 0-9]+)\)\}-->"        
      Set Matches = CommonRegExp.Execute(HTML)
	  ReturnString = HTML
      For Each Match in Matches
		 Parameters = GetLabelParameters(Match.Value, "SiteLogo")
		 ReturnString = Replace(ReturnString, Match.Value, "<img src="""& SiteLogo &""" width='"& Parameters(0) &"' height='"& Parameters(1) &"' border=""0"">")
      Next
	  
	  CommonRegExp.Pattern = "\{\$SiteLogo\(([ 0-9]+),([ 0-9]+)\)\}"
	  Set Matches = CommonRegExp.Execute(ReturnString)
	  For Each Match in Matches
		 Parameters = GetLabelParameters(Match.Value, "SiteLogo")
		 ReturnString = Replace(ReturnString, Match.Value, "<img src="""& SiteLogo &""" width='"& Parameters(0) &"' height='"& Parameters(1) &"' border=""0"">")
      Next
	  Set Matches = Nothing
	  
	  Label_SiteLogo = ReturnString
   End Function
   
   Private Function Label_ShowChannel(ByVal HTML)
      Dim Match, Matches, ReturnString, Parameters, Temp
	  CommonRegExp.Pattern = "<!--\{\$ShowChannel\([ 0-9]+\)\}-->"        
      Set Matches = CommonRegExp.Execute(HTML)
	  ReturnString = HTML
	  Temp = ""
      For Each Match in Matches
		 Parameters = GetLabelParameters(Match.Value, "ShowChannel")
		 Temp = ChannelList(ELClng(Parameters(0)))
		 ReturnString = Replace(ReturnString, Match.Value, Temp)
      Next
	  
	  CommonRegExp.Pattern = "\{\$ShowChannel\([ 0-9]+\)\}"
	  Set Matches = CommonRegExp.Execute(ReturnString)
	  For Each Match in Matches
		 Parameters = GetLabelParameters(Match.Value, "ShowChannel")
		 Temp = ChannelList(ELClng(Parameters(0)))
		 ReturnString = Replace(ReturnString, Match.Value, Temp)
      Next
	  Set Matches = Nothing
	  Label_ShowChannel = ReturnString
   End Function   
   
   Private Function ChannelList(ByVal N)
      Dim IsCache
	  IsCache = FoundInArray(Split(Cache_Others, ","), "1")	  
	  If IsCache Then
	     ChannelList = EL_Cache.GetCache("Sys.ChannelList", 0)
		 If ChannelList = "" Then
		    ChannelList = GetChannel(N)
			Call EL_Cache.SetCache("Sys.ChannelList", ChannelList, -1)
		 End If
	  Else
	     ChannelList = GetChannel(N)
	  End If	  
   End Function
   
   Private Function GetChannel(ByVal N)
      Dim ChannelCmd, rsChannel, i, RowCount, StrChannel, ChannelDivide
	  ChannelDivide = Lang("BaseConfig.ChannelDivide", "&nbsp;|&nbsp;")
	  Call InitCommonCmd(ChannelCmd, rsChannel, "EL_Channel", "ChannelName,ChannelName_Color,ChannelDir,ChannelPictrue,OpenType,ChannelType,LinkURL", "ShowName="& EL_True &" AND Disabled="& EL_False &" ORDER BY OrderID")
	  rsChannel.Close()
	  RowCount = ChannelCmd(0)
	  StrChannel = ChannelDivide &"<a href='"& InstallDir &"' class='channelA'>"& Lang("BaseConfig.SiteIndex", "") &"</a>"& ChannelDivide
	  If RowCount > 0 Then
	     rsChannel.Open()
		 Dim Num
		 Num = 0
		 For i = 1 To RowCount
		    If rsChannel(5) = 0 Then
			   StrChannel = StrChannel &"<a href='"& InstallDir & rsChannel(2) &"'"& ArrOpenType(rsChannel(4)) &" class='channelA'>"
			Else
			   StrChannel = StrChannel &"<a href='"& rsChannel(6) &"'"& ArrOpenType(rsChannel(4)) &" class='channelA'>"
			End If
			If rsChannel(3) = "" Or IsNULL(rsChannel(3)) Then
			   If rsChannel(1) = "" Or IsNULL(rsChannel(1)) Then
			      StrChannel = StrChannel & rsChannel(0)
			   Else
			      StrChannel = StrChannel &"<font color='"& rsChannel(1) &"'>"& rsChannel(0) &"</font>"
			   End If
			Else
			   StrChannel = StrChannel &"<img src='"& rsChannel(3) &"' border='0'>"
			End If
			 StrChannel = StrChannel &"</a>"& ChannelDivide			
			Num = Num + 1
			If (Num Mod N) = 0 And Num < N Then StrChannel = StrChannel &"<br>"& ChannelDivide
			If i<RowCount Then rsChannel.MoveNext
		 Next
		 rsChannel.Close()
	  End If
	  Set rsChannel = Nothing
	  Set ChannelCmd = Nothing
	  GetChannel = StrChannel
   End Function
   
   Private Function Label_ShowAnnounce(ByVal HTML)
      Dim Match, Matches, ReturnString, Parameters, Temp
	  CommonRegExp.Pattern = "<!--\{\$ShowAnnounce\(([ 0-9]+),([ 0-9]+),([ 0-9]+),([ 0-9]+),[ ]*(True|False)[ ]*,[ ]*(True|False)[ ]*\)\}-->"        
      Set Matches = CommonRegExp.Execute(HTML)
	  ReturnString = HTML
	  Temp = ""
      For Each Match in Matches
		 Parameters = GetLabelParameters(Match.Value, "ShowAnnounce")
		 Temp = AnnounceList(Parameters(0), Parameters(1), Parameters(2), Parameters(3), Parameters(4), Parameters(5))
		 ReturnString = Replace(ReturnString, Match.Value, Temp)
      Next
	  
	  CommonRegExp.Pattern = "\{\$ShowAnnounce\(([ 0-9]+),([ 0-9]+),([ 0-9]+),([ 0-9]+),[ ]*(True|False)[ ]*,[ ]*(True|False)[ ]*\)\}"
	  Set Matches = CommonRegExp.Execute(ReturnString)
	  For Each Match in Matches
		 Parameters = GetLabelParameters(Match.Value, "ShowAnnounce")
		 Temp = AnnounceList(Parameters(0), Parameters(1), Parameters(2), Parameters(3), Parameters(4), Parameters(5))
		 ReturnString = Replace(ReturnString, Match.Value, Temp)