📄 classcommon.asp

📁 依蓝旅游网站管理系统Elan2008.SP2
💻 ASP
📖 第 1 页 / 共 5 页
字号:
      Next
	  Set Matches = Nothing
	  Label_ShowAnnounce = ReturnString
   End Function
   
   Private Function AnnounceList(ByVal ShowType, ByVal AnnounceNum, ByVal TitleLen, ByVal ContentLen, ByVal ShowAuthor, ByVal ShowDate)
      Dim AnnounceCmd, rsAnnounce, i, ListString, PopString, RowCount
	  Dim SQLTables, SQLFields, SQLCondition
	  
	  ShowType = EL_Common.ELClng(ShowType)
	  AnnounceNum = EL_Common.ELClng(AnnounceNum)
	  TitleLen = EL_Common.ELClng(TitleLen)
	  ContentLen = EL_Common.ELClng(ContentLen)
	  ShowAuthor = Eval(ShowAuthor)
	  ShowDate = Eval(ShowDate)
	  
	  SQLTables = "EL_Announce"
	  SQLFields = "AnnounceID,Title,ShowType"
	  If ContentLen > 0 Then SQLFields = SQLFields &",Content"
	  If ShowAuthor Then SQLFields = SQLFields &",Inputer"
	  If ShowDate Then SQLFields = SQLFields &",UpdateTime"
	  
	  SQLCondition = " Actived="& EL_True &" "
	  
	  Call EL_Common.InitCommonCmd(AnnounceCmd, rsAnnounce, SQLTables, " TOP "& AnnounceNum &" "& SQLFields, SQLCondition &" ORDER BY UpdateTime DESC")
	  rsAnnounce.Close()
	  RowCount = AnnounceCmd(0)
	  If RowCount = 0 Then
	     Set rsAnnounce = Nothing
		 Set AnnounceCmd = Nothing
		 AnnounceList = EL_Common.Lang("Announce.NoList", "没有任何公告")
		 Exit Function
	  End If
	  rsAnnounce.Open()
	  ListString = ""
	  PopString = ""
	  
	  Dim ListItem, PopWindow
	  ListItem = EL_Common.Lang("Announce.ListItem", "&nbsp;&nbsp;·<a class='AnnounceList' href='#' onclick=""javascript:window.open('{$URL}', 'NewAnnWindow', 'height=540, width=600, toolbar=no, menubar=no, scrollbars=auto, resizable=no, location=no, status=no')"" title='{$Content}'>{$Title}&nbsp;&nbsp;{$Author}{$UpdateDateTime}</a>")
	  PopWindow = EL_Common.Lang("Announce.PopWindow", "window.open('{$URL}', 'PopAnnWindow', 'height=450, width=500, toolbar=no, menubar=no, scrollbars=auto, resizable=no, location=no, status=no')")
	  
	  For i = 1 To RowCount
	     If rsAnnounce("ShowType") = 1 Or rsAnnounce("ShowType") = 3 Then
		    ListString = ListString & ListItem
			ListString = Replace(ListString, "{$URL}", InstallDir &"Announce.asp?AnnounceID="& rsAnnounce("AnnounceID"))
			ListString = Replace(ListString, "{$Title}", rsAnnounce("Title"))
			If ContentLen > 0 Then
			   ListString = Replace(ListString, "{$Content}", "&nbsp;&nbsp;&nbsp;&nbsp;"& GetTopic(RemoveHTML(rsAnnounce("Content")), ContentLen))
			Else
			   ListString = Replace(ListString, "{$Content}", "")
			End If
			If ShowAuthor Then
			   ListString = Replace(ListString, "{$Author}", "["& rsAnnounce("Inputer") &"]")
			Else
			   ListString = Replace(ListString, "{$Author}", "")
			End If
			If ShowDate Then
			   ListString = Replace(ListString, "{$UpdateDateTime}", "["& rsAnnounce("UpdateTime") &"]")
			Else
			   ListString = Replace(ListString, "{$UpdateDateTime}", "")
			End If
			If ShowType > 1 And i<RowCount Then ListString = ListString &"<br>"
		 End If
		 If rsAnnounce("ShowType") = 2 Or rsAnnounce("ShowType") = 3 Then
		    PopString = PopString &"<scr"&"ipt>"& PopWindow &"</scr"&"ipt>"
			PopString = Replace(PopString, "{$URL}", InstallDir &"Announce.asp?AnnounceID="& rsAnnounce("AnnounceID"))
		 End If
		 If i<RowCount Then rsAnnounce.MoveNext
	  Next
	  rsAnnounce.Close()
	  Set rsAnnounce = Nothing
	  Set AnnounceCmd = Nothing
	  Dim str
	  If ShowType = 1 Then	     
		 str = EL_Common.Lang("Announce.M1", "<MARQUEE direction='left' scrollAmount=2 scrollDelay=4 width=100% align='left' onMouseOver='this.stop()' onMouseOut='this.start()'>{$AnnounceList}</MARQUEE>")
	  Else
	     str = EL_Common.Lang("Announce.M2", "<MARQUEE direction='up' scrollAmount=2 scrollDelay=4 width=100% align='left' onMouseOver='this.stop()' onMouseOut='this.start()'>{$AnnounceList}</MARQUEE>")
	  End If
	  ListString = Replace(str, "{$AnnounceList}", ListString)
	  AnnounceList = ListString & PopString
   End Function
   
   Private Function Label_ShowFriendSite(ByVal HTML)
      Dim Match, Matches, ReturnString, Parameters, Temp
	  CommonRegExp.Pattern = "<!--\{\$ShowFriendSite\(([ 0-9]+),([ 0-9]+),([ 0-9]+),([ 0-9]+),([ 0-9]+),[ ]*(True|False)[ ]*,([ 0-9]+)\)\}-->"        
      Set Matches = CommonRegExp.Execute(HTML)
	  ReturnString = HTML
	  Temp = ""
      For Each Match in Matches
		 Parameters = GetLabelParameters(Match.Value, "ShowFriendSite")
		 Temp = FriendSite(Parameters(0), Parameters(1), Parameters(2), Parameters(3), Parameters(4), Parameters(5), Parameters(6))
		 ReturnString = Replace(ReturnString, Match.Value, Temp)
      Next
	  
	  CommonRegExp.Pattern = "\{\$ShowFriendSite\(([ 0-9]+),([ 0-9]+),([ 0-9]+),([ 0-9]+),([ 0-9]+),[ ]*(True|False)[ ]*,([ 0-9]+)\)\}"
	  Set Matches = CommonRegExp.Execute(ReturnString)
	  For Each Match in Matches
		 Parameters = GetLabelParameters(Match.Value, "ShowFriendSite")
		 Temp = FriendSite(Parameters(0), Parameters(1), Parameters(2), Parameters(3), Parameters(4), Parameters(5), Parameters(6))
		 ReturnString = Replace(ReturnString, Match.Value, Temp)
      Next
	  Set Matches = Nothing
	  Label_ShowFriendSite = ReturnString
   End Function
   
   Private Function FriendSite(ByVal LinkType, ByVal SiteNum, ByVal ColNum, ByVal ShowType, ByVal TDWidth, ByVal IsCommend, ByVal OrderType)
      Dim FriendSiteCmd, rsFriendSite, i, ReturnString, RowCount
	  Dim SQLTables, SQLFields, SQLCondition, SQLOrder
	  Dim LogoWidth, LogoHeight, Title_SiteName, Title_SiteURL, Title_Content, tClickReg, tYourSite
	  Dim RndObjectID
	  
	  LinkType = EL_Common.ELClng(LinkType)
	  SiteNum = EL_Common.ELClng(SiteNum)
	  ColNum = EL_Common.ELClng(ColNum)
	  ShowType = EL_Common.ELClng(ShowType)
	  TDWidth = EL_Common.ELClng(TDWidth)
	  IsCommend = Eval(IsCommend)
	  OrderType = EL_Common.ELClng(OrderType)
	  
	  SQLTables = "EL_FriendSite"
	  SQLFields = "SiteID,SiteName,SiteURL,SiteLogo,Content"
	  
	  SQLCondition = " Passed="& EL_True &" "
	  If IsCommend Then SQLCondition = SQLCondition &" AND Commended="& EL_True &" "
	  If LinkType = 1 Then
	     SQLCondition = SQLCondition &" AND SiteLogo<>'' AND SiteLogo IS NOT NULL "
	  Else
	     SQLCondition = SQLCondition &" AND SiteLogo='' OR SiteLogo IS NULL"
	  End If
	  
	  Select Case OrderType
	    Case 1: SQLOrder = "EL_FriendSite.SiteID ASC"
		Case 2: SQLOrder = "EL_FriendSite.SiteID DESC"
		Case 3: SQLOrder = "EL_FriendSite.RegDateTime ASC"
		Case 4: SQLOrder = "EL_FriendSite.RegDateTime DESC"
		Case Else:  SQLOrder = "EL_FriendSite.SiteID DESC"
	  End Select
	  
	  LogoWidth = Lang("FriendSite.LogoWidth", 88)
	  LogoHeight = Lang("FriendSite.LogoHeight", 31)
	  Title_SiteName = Lang("FriendSite.t1", "网站名称")
	  Title_SiteURL = Lang("FriendSite.t2", "网站地址")
	  Title_Content = Lang("FriendSite.t3", "网站简介")
	  tClickReg = Lang("FriendSite.t4", "点击申请")
	  tYourSite = Lang("FriendSite.t5", "您的位置")
	  
	  RndObjectID = GetRndNumber()
	  If SiteNum < 1 Then SiteNum = Lang("FriendSite.SiteNum", 7)
	  Call EL_Common.InitCommonCmd(FriendSiteCmd, rsFriendSite, SQLTables, " TOP "& SiteNum &" "& SQLFields, SQLCondition &" ORDER BY "& SQLOrder)
	  rsFriendSite.Close()
	  RowCount = FriendSiteCmd(0)
	  ReturnString = ""
	  If ShowType = 1 Then
		 ReturnString = "<table width='100%' border='0' cellspacing='5' cellpadding='0'><tr>"
	  ElseIf ShowType = 2 Then
	     ReturnString = "<div id=FriendSite_"& RndObjectID &"_1 style=""overflow:hidden;height:"& (SiteNum / ColNum) * LogoHeight &";width:100%""><div id=FriendSite_"& RndObjectID &"_2>"
		 ReturnString = ReturnString &"<table width='100%' border='0' cellspacing='5' cellpadding='0'><tr>"
	  Else
		 ReturnString = "<select onChange=""javascript:window.open(this.value);"">"
	  End If
	  If RowCount = 0 Then
	     Set rsFriendSite = Nothing
		 Set FriendSiteCmd = Nothing			 
		 For i = 1 To SiteNum
		    Select Case ShowType
			   Case 1, 2:
			      If LinkType = 1 Then
				     ReturnString = ReturnString &"<td width='"& TDWidth &"'><a href='"& InstallDir &"FriendSite/FriendSiteReg.asp' title='"& tClickReg &"' target='_blank'><img src='"& InstallDir &"Images/nologo.gif' width='"& LogoWidth &"' height='"& LogoHeight &"' border='0'></a></td>"
				  Else
				     ReturnString = ReturnString &"<td width='"& TDWidth &"'><a href='"& InstallDir &"FriendSite/FriendSiteReg.asp' title='"& tClickReg &"' target='_blank'>"& tYourSite &"</a></td>"
				  End If
				  If (i Mod ColNum) = 0 And i<SiteNum Then ReturnString = ReturnString &"</tr><tr>"
			   Case Else:
			      ReturnString = ReturnString &"<option value="""& InstallDir &"FriendSite/FriendSiteReg.asp"" title='"& tClickReg &"'>"& tYourSite &"</option>"
			End Select
		 Next
		 Select Case ShowType
		    Case 1:
			   ReturnString = ReturnString &"</tr></table>"
			Case 2:
			   ReturnString = ReturnString &"</tr></table></div><div id=FriendSite_"& RndObjectID &"_3></div></div>"
			   ReturnString = ReturnString &"<script>"& VBCRLF
			   ReturnString = ReturnString &"var speed = 30;"& VBCRLF
			   ReturnString = ReturnString &"FriendSite_"& RndObjectID &"_3.innerHTML = FriendSite_"& RndObjectID &"_2.innerHTML;"& VBCRLF
			   ReturnString = ReturnString &"function Marquee(){"& VBCRLF
			   ReturnString = ReturnString &"   if(FriendSite_"& RndObjectID &"_3.offsetTop - FriendSite_"& RndObjectID &"_1.scrollTop<=0){"& VBCRLF
			   ReturnString = ReturnString &"      FriendSite_"& RndObjectID &"_1.scrollTop -= FriendSite_"& RndObjectID &"_2.offsetHeight;"& VBCRLF
			   ReturnString = ReturnString &"   }else{"& VBCRLF
			   ReturnString = ReturnString &"      FriendSite_"& RndObjectID &"_1.scrollTop++;"& VBCRLF
			   ReturnString = ReturnString &"   }"& VBCRLF
			   ReturnString = ReturnString &"}"& VBCRLF
			   ReturnString = ReturnString &"var FsInterv = setInterval(Marquee, speed);"& VBCRLF
			   ReturnString = ReturnString &"FriendSite_"& RndObjectID &"_1.onmouseover = function() {clearInterval(FsInterv)}"& VBCRLF
			   ReturnString = ReturnString &"FriendSite_"& RndObjectID &"_1.onmouseout = function() { FsInterv = setInterval(Marquee, speed)}"& VBCRLF
			   ReturnString = ReturnString &"</script>"& VBCRLF
			Case Else:
			   ReturnString = ReturnString &"</select>"
		 End Select
		 FriendSite = ReturnString
		 Exit Function
	  End If	  
	  
	  rsFriendSite.Open()	  
	  For i = 1 To RowCount
	     Select Case ShowType
		    Case 1, 2:			   
			   If LinkType = 1 Then
				  ReturnString = ReturnString &"<td width='"& TDWidth &"'><a href='"& rsFriendSite("SiteURL") &"' target='_blank' title="""& Title_SiteName & EL_Common.ServerHTMLEncode(rsFriendSite("SiteName")) &"&#13;"& Title_SiteURL & EL_Common.ServerHTMLEncode(rsFriendSite("SiteURL")) &"&#13;"& Title_Content & EL_Common.ServerHTMLEncode(rsFriendSite("Content")) &"""><img src='"& rsFriendSite("SiteLogo") &"' width='"& LogoWidth &"' height='"& LogoHeight &"' border='0'></a></td>"
			   Else
				  ReturnString = ReturnString &"<td width='"& TDWidth &"'><a href='"& rsFriendSite("SiteURL") &"' target='_blank' title="""& Title_SiteName & EL_Common.ServerHTMLEncode(rsFriendSite("SiteName")) &"&#13;"& Title_SiteURL & EL_Common.ServerHTMLEncode(rsFriendSite("SiteURL")) &"&#13;"& Title_Content & EL_Common.ServerHTMLEncode(rsFriendSite("Content")) &""">"& rsFriendSite("SiteName") &"</a></td>"
			   End If
			   If (i Mod ColNum) = 0 And i<RowCount Then ReturnString = ReturnString &"</tr><tr>"
			Case Else:
			   ReturnString = ReturnString &"<option value="""& rsFriendSite("SiteURL") &""">"& rsFriendSite("SiteName") &"</option>"
		 End Select
		 If i < RowCount Then rsFriendSite.MoveNext
	  Next
	  rsFriendSite.Close()
	  Set rsFriendSite = Nothing
	  Set FriendSiteCmd = Nothing
	  If ShowType = 1 Or ShowType = 2 Then
	     For i = RowCount To SiteNum-1
		    If (i Mod ColNum) = 0 And i<SiteNum Then ReturnString = ReturnString &"</tr><tr>"
			If LinkType = 1 Then
			   ReturnString = ReturnString &"<td width='"& TDWidth &"'><a href='"& InstallDir &"FriendSite/FriendSiteReg.asp' title='"& tClickReg &"' target='_blank'><img src='"& InstallDir &"Images/nologo.gif' width='"& LogoWidth &"' height='"& LogoHeight &"' border=0></a></td>"
		    Else
		       ReturnString = ReturnString &"<td width='"& TDWidth &"'><a href='"& InstallDir &"FriendSite/FriendSiteReg.asp' title='"& tClickReg &"' target='_blank'>"& tYourSite &"</a></td>"
			End If			
	     Next
	  End If
	  Select Case ShowType
		 Case 1:
			   ReturnString = ReturnString &"</tr></table>"
		 Case 2:
			   ReturnString = ReturnString &"</tr></table></div><div id=FriendSite_"& RndObjectID &"_3></div></div>"
			   ReturnString = ReturnString &"<script>"& VBCRLF
			   ReturnString = ReturnString &"var speed = 30;"& VBCRLF
			   ReturnString = ReturnString &"FriendSite_"& RndObjectID &"_3.innerHTML = FriendSite_"& RndObjectID &"_2.innerHTML;"& VBCRLF
			   ReturnString = ReturnString &"function Marquee(){"& VBCRLF
			   ReturnString = ReturnString &"   if(FriendSite_"& RndObjectID &"_3.offsetTop - FriendSite_"& RndObjectID &"_1.scrollTop<=0){"& VBCRLF
			   ReturnString = ReturnString &"      FriendSite_"& RndObjectID &"_1.scrollTop -= FriendSite_"& RndObjectID &"_2.offsetHeight;"& VBCRLF
			   ReturnString = ReturnString &"   }else{"& VBCRLF
			   ReturnString = ReturnString &"      FriendSite_"& RndObjectID &"_1.scrollTop++;"& VBCRLF
			   ReturnString = ReturnString &"   }"& VBCRLF
			   ReturnString = ReturnString &"}"& VBCRLF
			   ReturnString = ReturnString &"var FsInterv = setInterval(Marquee, speed);"& VBCRLF
			   ReturnString = ReturnString &"FriendSite_"& RndObjectID &"_1.onmouseover = function() {clearInterval(FsInterv)}"& VBCRLF
			   ReturnString = ReturnString &"FriendSite_"& RndObjectID &"_1.onmouseout = function() {MyMar=setInterval(Marquee, speed)}"& VBCRLF
			   ReturnString = ReturnString &"</script>"& VBCRLF
		 Case Else:
			   ReturnString = ReturnString &"</select>"
	  End Select
	  
	  FriendSite = ReturnString
   End Function     
   
   Private Function ReplaceDynamicLabel(ByVal HTML, ByVal LabelName, ByVal Parameters, ByVal TSQL, ByVal LabelContent)
      Dim Match, Matches, ReturnString, StrPattern, i, LParameters  
	  If Parameters  = "" Or ISNULL(Parameters) Then
	     StrPattern = LabelName
	  Else
	     Dim ArrParameters
		 ArrParameters = Split(Parameters, VBCRLF)
		 StrPattern = LabelName &"\("
		 For i = 0 To Ubound(ArrParameters)
		    StrPattern = StrPattern &"([ A-Za-z0-9]+),"
		 Next
		 StrPattern = LEFT(StrPattern, Len(StrPattern)-1)
		 StrPattern = StrPattern &"\)"
	  End If
	  CommonRegExp.Pattern = "<!--\{\$"& StrPattern &"\}-->"        
      Set Matches = CommonRegExp.Execute(HTML)
	  ReturnString = HTML
      For Each Match in Matches
		 LParameters = GetLabelParameters(Match.Value, LabelName)		 
		 ReturnString = Replace(HTML, Match.Value, UserDefinedDynamicLabel(LParameters, TSQL, LabelContent))
      Next
	  
	  CommonRegExp.Pattern = "\{\$"& StrPattern &"\}"
	  Set Matches = CommonRegExp.Execute(ReturnString)
	  For Each Match in Matches
	     LParameters = GetLabelParameters(Match.Value, LabelName)
		 ReturnString = Replace(ReturnString, Match.Value, UserDefinedDynamicLabel(LParameters, TSQL, LabelContent))
      Next
	  Set Matches = Nothing
	  
	  ReplaceDynamicLabel = ReturnString
   End Function 
   
   Private Function UserDefinedDynamicLabel(ByVal ArrParameter, ByVal TSQL, ByVal Content)      
	  Dim ListCmd, rsList, i, k, RowCount
	  Dim TableList, FieldList, StrCondition
	  Dim RecordNum, MainTable, SubTable, MainCheckField, SubCheckField, MainField, SubField, Where
	  Dim Match, Matches, MatchString, ReturnString, LenField, arr
	  
	  TSQL = Split(TSQL, "@")
	  RecordNum = TSQL(0)
	  MainTable = TSQL(1)
	  SubTable = TSQL(2)
	  MainCheckField = TSQL(3)
	  SubCheckField = TSQL(4)
	  MainField = TSQL(5)
	  SubField = TSQL(6)
	  Where = TSQL(7)	  	  
	  Where = DynamicLabelPara(Where, ArrParameter)
	  
	  TableList = MainTable
	  FieldList = MainField
	  If SubTable <> "" Then
	     TableList = TableList &","& SubTable
		 FieldList = FieldList &","& SubField
		 If MainCheckField <> "" AND SubCheckField <> "" Then
		    StrCondition = MainTable &"."& MainCheckField &"="& SubTable &"."& SubCheckField
		 End If
	  End If
	  If StrCondition = "" Then
	     StrCondition = Where
	  Else
	     StrCondition = StrCondition &" AND "& Where
	  End If
	  If StrCondition = "" Or IsNULL(StrCondition) Then StrCondition = "1=1"
	  arr = Split(FieldList, ",")
	  LenField = UBound(arr)
	  Call InitCommonCmd(ListCmd, rsList, TableList, FieldList, StrCondition)
	  rsList.Close()
	  RowCount = ListCmd(0)
	  If RowCount = 0 Then
	     Set rsList = Nothing
		 Set ListCmd = Nothing
		 UserDefinedDynamicLabel = ""
		 Exit Function
	  End If
	  
	  CommonRegExp.Pattern = "\[Loop\][\w\W]*\[\/Loop\]"
⌨️ 快捷键说明

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