cls.label.asp

网人分类信息5.0商业版。非常优秀的分类信息系统。比较少见。

<%
Class Cls_Label
'e
   Private eRs,eI,eRso,eN,eRst,eBCount,eCount,eTop,eTitColor,e_Sql
   Private eSiteMenu,eChannelID,eModule,eShow,eExport,eTDCSS,eIndexText,eTDStopCSS,eColsNum,eExplain,eCSS,eOpenType,eSymbol,eSymbolCSS,eLi
   Private eUrl,eTarget,e_CSS,e_Explain,eCreateHTML,eStructureType,eFileNameType,eIndex,eItem,e_ChannelID,eChannelDir,eChannelTitle
   Private eTDCSS1,eTDCSS2,eCTDCSS,eCTDCSS1,eCTDCSS2,eBNum,eBCols,eBFontNum,eBCss,eBCompart,eBCompartCss,eChild,eBigID,eCNum,eCCols,eCCss,eCFontNum,eCCompart,eCCompartCss,eCTarget,eBShow,eBShowCss,eCShow,eCShowCss
   Private e_BNum,eBigTitle,e_BigID,e_CNum,eCTitle,e_CPage
   Private eType,eCommend,e_Commend,eTempLinks,eIsRecruit
   Private eArticleSort,eDir,eParentDir,eArticlePic
   Private eChannel,eClass,eChildClass,eArea,eIsDefault,eIsHot,eIsElite,eShowNum,eInputerName,eDayNum,eTitleHand,eHandLinkCss,eHandOpenType,eHandSymbol,eHandSymbolCSS,eLen,eTitleEllipsis,eTips,eShowIncludePic,eOrderType,eLinkCss,eCommentLink,eCommentCss,eHotSign,eHotNum,eDateType,eNewSign,eNewNum,eEditor,eHits,eTeilSymbol,eTeilSymbolCSS,eContentLen,eContentCSS,eWidth,eHeight
   Private elChannel,elWidth,elHeight,elClass,elClassID,elNum,elSParentPath,elArea,elAParentPath,elAreaID,elHand,elShowIncludePic,elCommentLink,elContentLen,elTitLink,elCauda,elCaudaLogo,elTDWidth,elTitle,elTips,elIsHot,elIsDefault,elIsElite,elDayNum,elOrderType,eANum,elST5,ePics,eLinks,eTexts,elOLen,elTLen,elTitHand,elTitCauda,elTD_WNum,elTD_HNum,elTD,elTDPIC,elPIC,eCID,elRevert,eln,eChildArea
   Private eChildID,eIsOver,eIsPic,eAuthor,eDate,eHand,eHCss,eHTarget,eHSymbol,eHSymbolCSS,eEllipsis,eQQ,eCDate,eCAuthor,eCHit,eCRe,ePic,eElite,eCNew,eCNewDay,eCSymbol,eCSymbolCSS,ePicW,ePicH
   Private eSql,eLSql,eH,eC,eP,eToUrl,eHit,elHit,eHitCss,eRe,elRe
   Private eTime,eContentNum,elChannelID,elContent,elBeginDate,elEndDate
   Private eParentID,eAreaID,eSortNum,eSortColsNum,eContent,elSortNum,eLDir,elID,eSortList,eEliteSign,elParentID,elPICUrl
   Private eTemp,eTitle,eTag,eTags,eTagCss
   Private eCompanySort,eCom,eFaith,eUserFaith,eFaithPic,eCommendProduct,eLastPhoto,eUser,eComID,eTypeID
   Private eReSer,eRePrice,eAll,eConsume,eThinkGo,etThinkGo,eThinkGoNum,eIsGo,etIsGo,eIsGoNum,eACProduct,eCProduct,eClassSort,eMap,eMapSign,ezTopSign,eTopSign
   
   Private Sub Class_Initialize()
	 Set eRs = Server.CreateObject("ADODB.Recordset")
	 Set eRso = Server.CreateObject("ADODB.Recordset")
   End Sub
   Private Sub Class_Terminate()
     Set eRst = Nothing
     Set eRso = Nothing
     Set eRs = Nothing
   End Sub

   '菜单
   Function GetMenu(Str)
	 eSiteMenu = "":eUrl=""
     Str = Split(Str,",")
	 eChannelID = Int(Str(0))
	 eModule = Int(Str(1))
	 eShow = Int(Str(2))
	 eExport = Int(Str(3))
	 eTDCSS = Str(4)
	 eIndexText = Str(5)
	 eTDStopCSS = Str(6)
	 eColsNum = Int(Str(7))
	 eExplain = Int(Str(8))
	 eCSS = Str(9)
	 eOpenType = Str(10)
	 eSymbol = Str(11)
	 eSymbolCSS = Str(12)
	 eTDCSS1 = Str(13)
	 eTDCSS2 = Str(14)
	 If eChannelID <> 0 Then '栏目
	   If eChannelID = -1 Then
	     eChannelID = ChannelID
		 eModule = Module
	   End If
	   Set eRs = Conn.Execute("Select WM_Title,WM_ChannelDir,WM_CreateHTML,WM_StructureType,WM_FileNameType,WM_FileExt_Index,WM_FileExt_Item From WM_Channel Where WM_ID="&eChannelID)
	   If Not eRs.Eof Then
		 eChannelTitle = eRs(0)
		 eChannelDir = eRs(1)
         eCreateHTML = eRs(2)
		 eStructureType = eRs(3)
		 eFileNameType = eRs(4)
		 eIndex = eRs(5)
		 eItem = eRs(6)
	   End If
	   eRs.Close
	   If eChannelID <> 0 Then
	     If eChannelID > -1 Then
           e_ChannelID = " WM_ChannelID="&eChannelID
	     Else
	       e_ChannelID = " WM_ChannelID="&ChannelID
		 End If
         eOpenType = " target="&eOpenType
         e_CSS = WRMPS.LabelCss(eCSS)
	     If eExplain = 1 Then e_Explain = " title='"&eChannelTitle&"'" Else e_Explain = ""
	     If eIndexText <> "" Then eSiteMenu = "<a href="&WRMPS.GetChannelUrl(eCreateHTML,eIndex,1,eChannelDir,"")&eOpenType&e_CSS&e_Explain&">"&eIndexText&"</a>"
		 Select Case eModule
	       Case 1 '文章
	         eRs.Open"Select WM_ID,WM_Name,WM_Type,WM_Title,WM_Url,WM_Dir,WM_ParentDir,WM_ChannelDir From WM_ArticleSort Where"&e_ChannelID&"and WM_Depth = 0 And WM_ShowOnTop=1 Order By WM_ClassID,WM_ID",Conn,1,1
	         Do While Not eRs.Eof
			 eUrl = eRs(4)
	         If eExplain = 1 Then e_Explain = " title='"&eRs(3)&"'" Else e_Explain = ""
	         Select Case eRs(2)
	           Case 0
		         eToUrl = WRMPS.GetClassUrl(0,1,0,eUrl,eRs(0))
		       Case 1
		         eToUrl = WRMPS.GetClassUrl(0,1,1,eRs(7)&eRs(6)&eRs(5),eRs(0))
	         End Select
			 If eSiteMenu = "" Then
			   eSiteMenu = "<a href="&eToUrl&eOpenType&e_CSS&e_Explain&">"&eRs(1)&"</a>"
			 Else
			   eSiteMenu = eSiteMenu & "|" & "<a href="&eToUrl&eOpenType&e_CSS&e_Explain&">"&eRs(1)&"</a>"
			 End If
	         eRs.MoveNext
	         Loop
	         eRs.Close

	       Case 6 '店铺
	         eRs.Open"Select WM_ID,WM_Name,WM_Dir,WM_ParentDir,WM_ChannelDir From WM_CompanySort Where"&e_ChannelID&"and WM_Depth = 0 Order By WM_ClassID,WM_ID",Conn,1,1
	         Do While Not eRs.Eof
			 If eSiteMenu = "" Then
			   eSiteMenu = "<a href="&WRMPS.GetClassUrl(0,1,1,eRs(4)&eRs(3)&eRs(2),eRs(0))&eOpenType&e_CSS&">"&eRs(1)&"</a>"
			 Else
			   eSiteMenu = eSiteMenu & "|" & "<a href="&WRMPS.GetClassUrl(0,1,1,eRs(4)&eRs(3)&eRs(2),eRs(0))&eOpenType&e_CSS&">"&eRs(1)&"</a>"
			 End If
	         eRs.MoveNext
	         Loop
	         eRs.Close
			 
	       Case 2 '分类信息
	         eRs.Open"Select WM_ID,WM_Name,WM_Dir,WM_ParentDir,WM_ChannelDir From WM_ClassSort Where"&e_ChannelID&"and WM_Depth = 0 Order By WM_ClassID,WM_ID",Conn,1,1
	         Do While Not eRs.Eof
			 If eSiteMenu = "" Then
			   eSiteMenu = "<a href="&WRMPS.GetClassUrl(0,1,1,eRs(4)&eRs(3)&eRs(2),eRs(0))&eOpenType&e_CSS&">"&eRs(1)&"</a>"
			 Else
			   eSiteMenu = eSiteMenu & "|" & "<a href="&WRMPS.GetClassUrl(0,1,1,eRs(4)&eRs(3)&eRs(2),eRs(0))&eOpenType&e_CSS&">"&eRs(1)&"</a>"
			 End If
	         eRs.MoveNext
	         Loop
	         eRs.Close
	     End Select
	   End If

	 Else '频道
	   If eExplain = 1 Then e_Explain = " title='"&WR_Setting(0)&"'" Else e_Explain = ""
       e_CSS = WRMPS.LabelCss(eCSS)
	   If eIndexText <> "" Then eSiteMenu = "<a href="&WRMPS.GetIndexUrl(0)&" target="&eOpenType&e_CSS&e_Explain&">"&eIndexText&"</a>"
	   Set eRs = Conn.Execute("Select WM_ID,WM_ChannelName,WM_Target,WM_Title,WM_ChannelType,WM_ChannelDir,WM_ChannelUrl,WM_TitleClass,WM_CreateHTML,WM_FileExt_Index From WM_Channel Where WM_Key = 1 And WM_View="&eShow&" Order By WM_OrderID")
	   Do While Not eRs.Eof
		 If eRs(2) = 1 Then eTarget = " target=_blank" Else eTarget = " target=_parent"
		 If eRs(7) <> "" Then
		   e_CSS = WRMPS.LabelCss(eRs(7))
		 Else
           e_CSS = WRMPS.LabelCss(eCSS)
		 End If
	     If eExplain = 1 Then e_Explain = " title='"&eRs(3)&"'" Else e_Explain = ""
		 If eSiteMenu = "" Then
		   eSiteMenu = "<a href="&WRMPS.GetChannelUrl(eRs(8),eRs(9),eRs(4),eRs(5),eRs(6))&eTarget&e_CSS&e_Explain&">"&eRs(1)&"</a>"
		 Else
		   eSiteMenu = eSiteMenu & "|" & "<a href="&WRMPS.GetChannelUrl(eRs(8),eRs(9),eRs(4),eRs(5),eRs(6))&eTarget&e_CSS&e_Explain&">"&eRs(1)&"</a>"
		 End If
	   eRs.MoveNext
	   Loop
	   eRs.Close
	 End If
	 If eSymbol <> "" and eSymbolCSS <> "" Then eSymbol = "<font"&WRMPS.LabelCss(eSymbolCSS)&">"&eSymbol&"</font>"
	 eSiteMenu = Split(eSiteMenu,"|")
	 Select Case eExport
	   Case 2
	     GetMenu = "<table border=0 cellspacing=0 cellpadding=0><tr>" & vbCrLf
	   Case 3
	     GetMenu = "<div"&WRMPS.LabelCss(eTDCSS)&"><ul"&WRMPS.LabelCss(eTDCSS1)&">" & vbCrLf
	 End Select
	 For eI = 0 To UBound(eSiteMenu)
		If eColsNum > 0 Then 
		  If eI > 0 and eI Mod eColsNum <> 0 and eExport = 1 Then GetMenu = GetMenu & eSymbol
		Else
		  If eI > 0 Then GetMenu = GetMenu & eSymbol
		End If
		Select Case eExport
		  Case 1
		    GetMenu = GetMenu&eSiteMenu(eI)
		  Case 2
		    GetMenu = GetMenu&"  <td"&WRMPS.LabelCss(eTDCSS)&" onMouseOut='mOver(this.ClassName="""&eTDCSS&""")' onMouseOver='mOver(this.ClassName="""&eTDStopCSS&""")'>"&eSiteMenu(eI)&"</td>" & vbCrLf
		  Case 3
		    GetMenu = GetMenu&"  <li"&WRMPS.LabelCss(eTDCSS2)&" onMouseOut='mOver(this.ClassName="""&eTDCSS2&""")' onMouseOver='mOver(this.ClassName="""&eTDStopCSS&""")'>"&eSiteMenu(eI)&"</li>"
		End Select
		If eColsNum > 0 Then
		If (eI + 1) mod eColsNum = 0 Then
		  Select Case eExport
		    Case 1
		      GetMenu = GetMenu&"<br>" & vbCrLf
		    Case 2
			  If UBound(eSiteMenu) > eI Then GetMenu = GetMenu&"</tr>" & vbCrLf & "<tr>"
		    Case 3
		      If UBound(eSiteMenu) > eI Then GetMenu = GetMenu&"</ul>" & vbCrLf & "<ul"&WRMPS.LabelCss(eTDCSS1)&">" & vbCrLf
		  End Select
		End If
		End If
	 Next
	 Select Case eExport
	   Case 2
	     GetMenu = GetMenu & "</tr></table>" & vbCrLf
	   Case 3
	     GetMenu = GetMenu & "</ul></div>" & vbCrLf
	 End Select
   End Function
   '========================================================================================
   '友情链接
   Function GetLinks(Str)
     Str = Split(Str,",")
     eType = Int(Str(0))
	 eShowNum = Int(Str(1))
	 eColsNum = Int(Str(2))
	 eCommend = Int(Str(3))
	 eCss = Str(4)
	 eOrderType = Int(Str(5))
	 eExport = Int(Str(6))
	 eTDCSS = Str(7)
	 eTDCSS1 = Str(8)
	 eTDCSS2 = Str(9)
	 eIsRecruit = Int(Str(10))
	 eSymbol = Str(11)
	 eArea = Int(Str(12))
	 eSql = "":e_Commend = "":elOrderType = "":elNum = ""
     If eShowNum > 0 Then elNum = " Top "&eShowNum
	 If eCommend = 1 Then eSql = eSql & " And WM_Commend = 1"
     eSql = eSql & " And WM_Type = "&eType
	 If eAreaID = -1 Then eAreaID = MyCityID
     If eAreaID > 0 Then
	  eAreaID = WRDB.GetChildClass(eAreaID,"WM_Area")
	  eSql = eSql & " and WM_AreaID in("&eAreaID&")"
	 End If
     Select Case eOrderType
       Case 0
	     elOrderType = " Order By WM_Taxis Desc,WM_ID Desc"
       Case 1
	     elOrderType = " Order By WM_ID Desc"
       Case 2
	     elOrderType = " Order By WM_ID"
     End Select
     eRs.Open "Select"&elNum&" WM_SiteName,WM_Content,WM_Url,WM_Logo,WM_Type From WM_Links Where WM_Key = 1"&eSql&elOrderType,Conn,1,1
     eTempLinks = ""
     eN = 0
     Do While Not eRs.Eof
       eN = eN + 1
       Select Case eType
         Case 0
	       eTempLinks = eTempLinks & "§<a href="&eRs(2)&" target=_blank title='"&eRs(1)&"'"&WRMPS.LabelCss(eCss)&">"&eRs(0)&"</a>"
	     Case 1
	       eTempLinks = eTempLinks & "§<a href="&eRs(2)&" target=_blank title='"&eRs(1)&"'"&WRMPS.LabelCss(eCss)&"><img Src='"&eRs(3)&"' border=0 width=88 height=31></a>"
       End Select
     eRs.Movenext
     Loop
     eRs.Close
	 If eIsRecruit > 0 and eShowNum - eN > 0 Then
       For eI = 1 To Int(eShowNum - eN)
         Select Case eType
           Case 0
	         eTempLinks = eTempLinks & "§<a href=Links.asp?Action=Apply target=_blank title='现在申请'"&WRMPS.LabelCss(eCss)&">您的位置</a>"
	       Case 1
	         eTempLinks = eTempLinks & "§<a href=Links.asp?Action=Apply target=_blank title='现在申请'"&WRMPS.LabelCss(eCss)&"><img Src='"&UrlPath&"Skins/"&WR_Setting(5)&"/NoLogo.gif' border=0 width=88 height=31></a>"
         End Select
	   Next
     End If 
     If Left(eTempLinks,1) = "§" Then eTempLinks = Right(eTempLinks,Len(eTempLinks)-1)
	 Select Case eExport
	   Case 2
	     GetLinks = "<table border=0 cellspacing=0 cellpadding=0><tr>" & vbCrLf
	   Case 3
	     GetLinks = "<div"&WRMPS.LabelCss(eTDCSS)&"><ul"&WRMPS.LabelCss(eTDCSS1)&">" & vbCrLf
	 End Select
     eN = 0
     For eI = 0 To UBound(Split(eTempLinks,"§"))
       eN = eN + 1
	   Select Case eExport
	     Case 1
		   If GetLinks <> "" Then
		     GetLinks = GetLinks & eSymbol
		   End If 
	       GetLinks = GetLinks & Split(eTempLinks,"§")(eI) & vbCrLf
	     Case 2
	       GetLinks = GetLinks & "<td"&WRMPS.LabelCss(eTDCSS)&">"&Split(eTempLinks,"§")(eI) & "</td>" & vbCrLf
	     Case 3
	       GetLinks = GetLinks & "<li"&WRMPS.LabelCss(eTDCSS2)&">"&Split(eTempLinks,"§")(eI) & "</li>"
	   End Select
	   If eColsNum > 0 Then
	   If (eN) mod eColsNum = 0 Then
		 Select Case eExport
		   Case 1
		     GetLinks = GetLinks & "<br>" & vbCrLf
		   Case 2
		     If UBound(Split(eTempLinks,"§"))+1 > eN Then GetLinks = GetLinks & "</tr>" & vbCrLf & "<tr>" & vbCrLf
		   Case 3
		     If UBound(Split(eTempLinks,"§"))+1 > eN Then GetLinks = GetLinks & "</ul>" & vbCrLf & "<ul"&WRMPS.LabelCss(eTDCSS1)&">" & vbCrLf