cls.common.asp

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

<!--#include file="../API/HiAPI/API_Config.asp" -->
<!--#include file="MD5.asp"-->
<% 
Class Cls_Main
'a
   Private aRs
   Private a_Page,a_SmallID,a_SID,a_P,aFileName
   Private aStartTag,aEndTag
   Private alStr,aSpecial,aC,aI,aV
   Private aUrl,aN,aCityID,aCity
   Private aPic1,aPic2,aPic3

   Private Sub Class_Initialize()
	 Call Cache()
	 If GetCache("FlagTime") = "" Then SCache "FlagTime",Now()
	 UrlPath = WR_Setting(3)
	 Set regE = New RegExp
   End Sub
   Private Sub Class_Terminate()
     WR_Setting = Empty:WR_Mail = Empty:WR_UpLoad = Empty:WR_ClassAD = Empty:WR_Other = Empty:WR_User = Empty:WR_Company = Empty:WR_Area = Empty:WR_Prop = Empty:WR_Faith = Empty:W_UserNum = Empty:W_NewUser = Empty:W_ClassNum = Empty:W_ArticleNum = Empty:W_CompanyNum = Empty:W_UserFaith = Empty:W_CompanyReNum = Empty:Server_Url = Empty:SystemVersionType = Empty:ConnTime = Empty:AreaList = Empty
     Set Matchess=Nothing
	 Set regE = Nothing
     Set aRs = Nothing
   End Sub
   '表单对应 Str：表单值 StrDB：数据库值 Num：0为 select(selected), 1为 radio(checked)和checkbox(checked) 2多选包含
   Function GetCheckVer(Str, StrDB, Num)
     If Str = "" Or StrDB = "" Then GetCheckVer = "":Exit Function
     Select Case Num
       Case 0
         If Str = StrDB Then GetCheckVer = " selected" Else GetCheckVer = ""
       Case 1
         If Str = StrDB Then GetCheckVer = " checked" Else GetCheckVer = ""
	   Case 2
	     If Instr(Ucase(","&Str&","),","&Ucase(StrDB)&",") > 0 Then GetCheckVer = " checked" Else GetCheckVer = ""
     End Select
   End Function
   '判断是否要验证码
   'n 1为验证码 　2为验证问题
   Function CheckCode(byval str,byval n)
     CheckCode = False
     Select Case n
	   Case 1
	     If Instr(Ucase(","&WR_Code(0)&","),","&Ucase(str)&",") > 0 Then CheckCode = True
	   Case 2
	     If Instr(Ucase(","&WR_Code(1)&","),","&Ucase(str)&",") > 0 Then CheckCode = True
	 End Select
   End Function
   '组件支持检测
   Function GetDll(DllSort)
     Dim WM_ObJ
     On Error Resume Next
     Set WM_ObJ = Server.CreateObject(DllSort)
     If Err Then
	   GetDll = "×"
	 Else
	   GetDll = "√"
	   Select Case DllSort
		  Case "Persits.Jpeg"
			If WM_ObJ.Expires <= Now Then GetDll = "×"
          Case "wsImage.Resize"
			If InStr(WM_ObJ.errorinfo, "已经过期") > 0 Then GetDll = "×"
          Case "SoftArtisans.ImageGen"
			WM_ObJ.CreateImage 500, 500, RGB(255, 255, 255)
			If Err Then GetDll = "×"
	   End Select
	 End If
     Set WM_ObJ = Nothing
   End Function
   '获取页面执行时间
   Function ExecuteTime()
     eEndTime = Timer()
     ExecuteTime = GetFormatNumber((eEndTime - eStarTime),5) & " 秒"
   End Function
   '得到地区URL
   'aType : URL NAME
   Function GetAreaUrl(aID,aType)
     Dim Area_List,R
	 If AreaList <> "" and Instr(","&AreaList,","&aID&"|") > 0 Then
	   Area_List = Split(AreaList,",")
	   For r = 0 To Ubound(Area_List)
	     If Area_List(r) <> "" Then
		   If Int(Split(Area_List(r),"|")(0)) = Int(aID) Then
             Select Case WR_Area(2)
	           Case 0 '不启用
			     Select Case Ucase(aType)
				   Case "URL"
				     Select Case Int(WR_Setting(9))
				       Case 0
				         GetAreaUrl = UrlPath&"Index.asp?ConversionCity="&aID
				       Case 1
				         GetAreaUrl = UrlPath&"city_"&aID&"/"
				     End Select
				   Case "NAME"
		             GetAreaUrl = Split(Area_List(r),"|")(1)
				 End Select
	           Case 1 '启用
			     Select Case Ucase(aType)
				   Case "URL"
			         GetAreaUrl = Replace(WR_Setting(4),"http://www","http://"&Split(Area_List(r),"|")(2))
				   Case "NAME"
		             GetAreaUrl = Split(Area_List(r),"|")(1)
				 End Select
	         End Select
		   End If
		 End If
	   Next
	 Else
       If IsObject(Conn) = False Then Call DBConnBegin()
	   Set aRs = Conn.Execute("Select WM_Name From WM_Area Where WM_ID = "&aID&"")
	   If Not aRs.Eof Then
		 Select Case Ucase(aType)
		   Case "URL"
			 GetAreaUrl = "#"
		   Case "NAME"
		     GetAreaUrl = aRs(0)
		 End Select
	   End If
	   aRs.Close
	 End If
	 Area_List = Empty
   End Function
   '得到首页URL
   Function GetIndexUrl(aID)
     Select Case aID
	   Case 0
         GetIndexUrl = UrlPath&"Index."&WR_Setting(15)
	   Case Else
	     Select Case Ucase(WR_Setting(15))
		   Case "ASP"
             GetIndexUrl = UrlPath&"Index."&WR_Setting(15)
		   Case Else
             GetIndexUrl = UrlPath&"City/"&aID&"/"
         End Select
	 End Select
	 If GetIndexUrl = "" Then GetIndexUrl = "#"
   End Function
   '得到总菜单URL
   '生成HTML方式|频道首页的扩展名|频道类型|aDir|aUrl
   Function GetChannelUrl(aCreateHTML,aIndex,aType,aDir,aUrl)
     GetChannelUrl = ""
	 Select Case aType
	   Case 0 '外部
	     GetChannelUrl = aUrl
	   Case Else '内部
	     Select Case aCreateHTML
	       Case 1,3 '不生成
		     GetChannelUrl = UrlPath&aDir & "/"
	       Case Else '生成
		     If MyCityID > 0 Then
		       GetChannelUrl = UrlPath&"City/"&MyCityID&"/"&aDir & "/"
			 Else
		       GetChannelUrl = UrlPath&aDir & "/"
			 End If
	     End Select
	 End Select
	 If GetChannelUrl = "" Then GetChannelUrl = "#"
   End Function
   '得到栏目URL
   '排序,页数
   'aType 栏目类型 0外部 1内部
   'aDir  为外部栏目时则为URL，反则为栏目目录
   Function GetClassUrl(aOrder,aPage,aType,aDir,aID)
     GetClassUrl = ""
     Select Case aType
	   Case 0 '外部
	     GetClassUrl = aDir
	   Case 1 '内部
         aDir = GetReplace(aDir,"//","/")
	     If Right(aDir,1) = "/" Then aDir = Left(aDir,Len(aDir)-1)
	     If Left(aDir,1) = "/" Then aDir = Right(aDir,Len(aDir)-1)
		 If aPage = "" Then aPage = 1
		 If aOrder = "" Then aOrder = 0
	     Select Case Int(WR_Setting(9))
	       Case 0
	         GetClassUrl = UrlPath&Split(aDir,"/")(0)&"/Class.asp?ID="&aID
	         If aPage > 1 Then GetClassUrl = GetClassUrl & "&Page="&aPage
	         If aOrder > 0 Then GetClassUrl = GetClassUrl & "&Order="&aOrder
	       Case 1
	         GetClassUrl = UrlPath&Split(aDir,"/")(0)&"_"&aID&"_"&aPage&"_"&aOrder&"/"
	     End Select
     End Select
	 If GetClassUrl = "" Then GetClassUrl = "#"
   End Function
   '得到点评页地址
   Function GetCritiqueUrl(byval ID)
     If ID = "" Then ID = 0
	 Select Case Int(WR_Setting(9))
	   Case 0
	     If ID > 0 Then
	       GetCritiqueUrl = UrlPath&"Company/Critique/?ComID="&ID
		 Else
	       GetCritiqueUrl = UrlPath&"Company/Critique/"
		 End If
	   Case 1
	     GetCritiqueUrl = UrlPath&"re_"&ID&"_1/"
	 End Select
     If GetCritiqueUrl = "" Then GetCritiqueUrl = "#"
   End Function
   '得到礼品地址
   Function GetGiftUrl(byval ID)
	 Select Case Int(WR_Setting(9))
	   Case 0
	     GetGiftUrl = UrlPath&"Gift/Show.asp?ID="&ID
	   Case 1
	     GetGiftUrl = UrlPath&"g_s_"&ID&"/"
	 End Select
     If GetGiftUrl = "" Then GetGiftUrl = "#"
   End Function
   '得到礼品列表页地址
   Function GetGiftListUrl()
	 Select Case Int(WR_Setting(9))
	   Case 0
	     GetGiftListUrl = UrlPath&"Gift/Class.asp"
	   Case 1
	     GetGiftListUrl = UrlPath&"g_1/"
	 End Select
     If GetGiftListUrl = "" Then GetGiftListUrl = "#"
   End Function
   '得到店铺地址
   Function GetCompanyUrl(aID)
	 Select Case Int(WR_Setting(9))
	   Case 0
	     GetCompanyUrl = UrlPath&"Co/Index.asp?ID="&aID
	   Case 1
	     GetCompanyUrl = UrlPath&"co_"&aID&"/"
	 End Select
     If GetCompanyUrl = "" Then GetCompanyUrl = "#"
   End Function
   
   '得到个人空间地址
   'aStr 0 为正常地址 1为完整地址
   Function GetSpaceUrl(aStr,aUser)
     Select Case Int(aStr)
	   Case 0
	     GetSpaceUrl = WR_Setting(3)
	   Case 1
	     GetSpaceUrl = WR_Setting(4)
	 End Select
	 GetSpaceUrl = GetSpaceUrl&"Space/?UserName="&escape(aUser)
     If GetSpaceUrl = "" Then GetSpaceUrl = "#"
   End Function
   '得到内容URL
   'aIsIndex 如果后缀为 Index.html 则 0为显示,1为不显示
   'aPageNum 当前第几页
   'aType 0为内容地址，1为静态目录，2为静态生成路径
   Function GetShowUrl(aIsIndex,aPageNum,aType,aID,aTime,aDir,aChannelID)
     Dim aPNum
	 GetShowUrl = ""
     aDir = GetReplace(aDir,"//","/")
	 If Right(aDir,1) = "/" Then aDir = Left(aDir,Len(aDir)-1)
	 If Left(aDir,1) <> "/" Then aDir = aDir&"/"
	 If aPageNum = "" Then aPageNum = 1
	 If aPageNum > 1 Then aPNum = "_"&aPageNum Else aPNum = ""
	 If Int(WR_Setting(9)) = 1 and aType = 0 Then GetShowUrl = UrlPath&Split(aDir,"/")(0)&"_"&aID&"_"&aPageNum&"/":Exit Function
	 Set aRs = Conn.Execute("Select WM_CreateHTML,WM_StructureType,WM_FileNameType,WM_FileExt_Item From WM_Channel Where WM_ID="&aChannelID&"")
	 If Not aRs.Eof Then
	   Select Case aRs(0)
	     Case 1 '不生成
		   GetShowUrl = UrlPath&Split(aDir,"/")(0)&"/Show.asp?ID="&aID
		 Case Else '生成
		   Select Case aRs(1) '目录结构
		     Case 0
			   GetShowUrl = aDir&Year(aTime)&"/"&Month(aTime)&"/"&Day(aTime)&"/"
		     Case 1
			   GetShowUrl = aDir&Year(aTime)&Month(aTime)&"/"
		     Case 2
			   GetShowUrl = aDir&Split(aTime," ")(0)&"/"
		     Case 3
			   GetShowUrl = aDir
		     Case 4
			   GetShowUrl = Split(aDir,"/")(0)&"/"&Split(Left(aDir,Len(aDir)-1),"/")(UBound(Split(Left(aDir,Len(aDir)-1),"/")))&"/"&Year(aTime)&Month(aTime)&"/"
		     Case 5
			   GetShowUrl = Split(aDir,"/")(0)&"/"&Split(Left(aDir,Len(aDir)-1),"/")(UBound(Split(Left(aDir,Len(aDir)-1),"/")))&"/"&Split(aTime," ")(0)&"/"
		     Case 6
			   GetShowUrl = Split(aDir,"/")(0)&"/"&Split(Left(aDir,Len(aDir)-1),"/")(UBound(Split(Left(aDir,Len(aDir)-1),"/")))&"/"
		     Case 7
			   GetShowUrl = Split(aDir,"/")(0)&"/"
		     Case 8
			   GetShowUrl = Split(aDir,"/")(0)&"/HTML/"
		     Case 9
			   GetShowUrl = Split(aDir,"/")(0)&"/"&Year(aTime)&"/"
		     Case 10
			   GetShowUrl = Split(aDir,"/")(0)&"/"&Year(aTime)&Month(aTime)&"/"
		     Case 11
			   GetShowUrl = Split(aDir,"/")(0)&"/"&Split(aTime," ")(0)&"/"
		     Case 12
			   GetShowUrl = Split(aDir,"/")(0)&"/"&Year(aTime)&"/"&Year(aTime)&Month(aTime)&"/"
		     Case 13
			   GetShowUrl = Split(aDir,"/")(0)&"/"&Year(aTime)&"/"&Split(aTime," ")(0)&"/"
		     Case 14
			   GetShowUrl = Split(aDir,"/")(0)&"/"&Year(aTime)&Month(aTime)&"/"&Split(aTime," ")(0)&"/"
		     Case 15
			   GetShowUrl = Split(aDir,"/")(0)&"/"&Year(aTime)&"/"&Year(aTime)&Month(aTime)&"/"&Split(aTime," ")(0)&"/"
		   End Select
		   Select Case aType
		     Case 0
		       Select Case aRs(2) '文件名
		         Case 1
			       GetShowUrl = UrlPath & GetShowUrl & aID & aPNum & "." & aRs(3)
		         Case 2
			       GetShowUrl = UrlPath & GetShowUrl & GetReplace(GetReplace(GetReplace(GetReplace(aTime,"-","")," ",""),":",""),"/","") & aID & aPNum & "." & aRs(3)
		         Case 3
			       GetShowUrl = UrlPath & GetShowUrl & Split(aDir,"/")(0) & "_" & aID & aPNum & "." & aRs(3)
		         Case 4
			       GetShowUrl = UrlPath & GetShowUrl & Split(aDir,"/")(0) & "_" & GetReplace(GetReplace(GetReplace(GetReplace(aTime,"-","")," ",""),":",""),"/","") & aPNum & "." & aRs(3)
		         Case 5
			       GetShowUrl = UrlPath & GetShowUrl & GetReplace(GetReplace(GetReplace(GetReplace(aTime,"-","")," ",""),":",""),"/","") & "_" & aID & aPNum & "." & aRs(3)
		         Case 6
			       GetShowUrl = UrlPath & GetShowUrl & Split(aDir,"/")(0) & "_" & GetReplace(GetReplace(GetReplace(GetReplace(aTime,"-","")," ",""),":",""),"/","") & "_" & aID & aPNum & "." & aRs(3)
		         Case 7
			       If aPageNum > 1 Then
				     GetShowUrl = UrlPath & GetShowUrl & aID & "/Index" & aPNum & "." & aRs(3)
				   Else
				     Select Case aIsIndex
					   Case 0
				         GetShowUrl = UrlPath & GetShowUrl & aID & "/Index." & aRs(3)
					   Case 1
				         GetShowUrl = UrlPath & GetShowUrl & aID & "/"
					 End Select
				   End If
		         Case 8
			       If aPageNum > 1 Then
				     GetShowUrl = UrlPath & GetShowUrl & GetReplace(GetReplace(GetReplace(GetReplace(aTime,"-","")," ",""),":",""),"/","") & aID & "/Index" & aPNum & "." & aRs(3)
				   Else
				     Select Case aIsIndex
					   Case 0