cls.cityreh.asp

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

<%
'r
Dim Briefness
Dim rCityID,rUrl,UrlDot,rCityEng,Area_List,r
Dim MyCity,MyCityID,MyCityEng,MyCityTempID,MyCityUrl

Briefness = Request.QueryString("Briefness")
If (Briefness = "" and IsEmpty(WRMPS.GetCookies("Briefness"))) Or IsNumeric(WRMPS.GetCookies("Briefness")) = False Then Briefness = 0
If Briefness <> "" and (Briefness = 0 or Briefness = 1) Then WRMPS.SCookies "Briefness",Briefness,365
Briefness = WRMPS.GetCookies("Briefness")

rCityID = Request.QueryString("ConversionCity")
If rCityID <> "" Then If IsNumeric(rCityID)=False Then rCityID = ""

If WRMPS.GetServer Then WR_Area(2)  = 0
If WR_Area(2) = 1 and Lcase(Left(WR_Setting(4),11)) <> "http://www." Then Response.write "<script>alert('·您启用了分站二级域名功能，请将您的网站地址设为带 http://www. 的顶级域名，否则请关闭二级域名功能')</script>"

rUrl = Request.ServerVariables("Server_NAME")
Select Case Int(WR_Area(2))
  Case 0 '常规
    If rCityID <> "" Then
	  If WRMPS.GetCookies("MyCityID") <> rCityID Then If rCityID > 0 Then Call Get_CityInfo() Else GetCity -1,""
	Else
	  If IsEmpty(WRMPS.GetCookies("MyCityID")) Then If Int(WR_Area(3)) > 0 Then Call Get_IpCity()
	End If
  Case 1 '二级/顶级域名
    If AreaList <> "" and (Instr(lcase(AreaList)&",","|"&rUrl&"|") > 0 Or Instr(lcase(AreaList)&",","|www."&rUrl&"|") > 0) Then
      If instr(lcase(rUrl),"www.") = 0 Then rUrl = "www."&rUrl
      If AreaList <> "" and Instr(lcase(AreaList)&",","|"&rUrl&"|") > 0 Then GetCity 3,lcase(rUrl)
	Else
      UrlDot = Split(Replace(WR_Setting(4) ,"http://",""),"/")(0)
      UrlDot = Ubound(Split(UrlDot,"."))
      If UBound(Split(rUrl,".")) < UrlDot Then rUrl = "www."&rUrl
	  If Lcase(Split(rUrl,".")(0)) <> "www" Then
        If Instr(lcase(AreaList),"|"&Split(rUrl,".")(0)&"|") > 0 and Split(rUrl,".")(0) <> WRMPS.GetCookies("MyCityEng") Then Call Get_CityInfo()
	  Else
	    If IsEmpty(WRMPS.GetCookies("MyCityID")) Then
		  If Int(WR_Area(3)) > 0 Then Call Get_IpCity()
		Else
		  GetCity -1,""
		End If
	  End If
	End If
End Select

If IsEmpty(WRMPS.GetCookies("MyCityID")) Then GetCity -1,""
If IsEmpty(WRMPS.GetCookies("MyCityDomain")) = False Then MyCityUrl = "http://"&WRMPS.GetCookies("MyCityDomain")&"/" Else MyCityUrl = WRMPS.GetReplace(WR_Setting(4),"http://www.","http://"&WRMPS.GetCookies("MyCityEng")&".")
If IsEmpty(WRMPS.GetCookies("CitySkip")) and Int(WR_Area(2)) = 1 and Lcase("http://"&rUrl&"/") <> MyCityUrl Then
   WRMPS.SCookies "CitySkip","YES",1
   Response.Redirect MyCityUrl
End if

MyCity = WRMPS.GetCookies("MyCity")
MyCityID = WRMPS.GetCookies("MyCityID")
MyCityEng = WRMPS.GetCookies("MyCityEng")
MyCityTempID = WRMPS.GetCookies("MyCityTempID")

'删除城市信息
Sub DelCityInfo()
   WRMPS.DelCookies "MyCity"
   WRMPS.DelCookies "MyCityID"
   WRMPS.DelCookies "MyCityEng"
   WRMPS.DelCookies "MyCityDomain"
   WRMPS.DelCookies "MyCityTempID"
End Sub
'加载城市信息
Sub GetCity(byval n,byval Str)
  Select Case n
    Case -1
	  If IsEmpty(WRMPS.GetCookies("MyCityID")) Then
	    DelCityInfo()
        WRMPS.SCookies "MyCity",DefaultArea(1),1
        WRMPS.SCookies "MyCityID",DefaultArea(0),1
        WRMPS.SCookies "MyCityEng",DefaultArea(2),1
        WRMPS.SCookies "MyCityDomain",DefaultArea(3),1
        WRMPS.SCookies "MyCityTempID",DefaultArea(4),1
	  Else
	    DelCityInfo()
        WRMPS.SCookies "MyCity",WR_Area(0),1
        WRMPS.SCookies "MyCityID",0,1
        WRMPS.SCookies "MyCityEng","www",1
        WRMPS.SCookies "MyCityDomain","",1
        WRMPS.SCookies "MyCityTempID",0,1
	  End If
	Case Else
	  DelCityInfo()
      Area_List = Split(AreaList,",")
      For r = 0 To Ubound(Area_List)
	    If Area_List(r) <> "" Then
          If lcase(Split(Area_List(r),"|")(n)) = Str Then
            WRMPS.SCookies "MyCityID",Split(Area_List(r),"|")(0),1
            WRMPS.SCookies "MyCity",Split(Area_List(r),"|")(1),1
            WRMPS.SCookies "MyCityEng",Split(Area_List(r),"|")(2),1
            WRMPS.SCookies "MyCityDomain",Split(Area_List(r),"|")(3),1
            WRMPS.SCookies "MyCityTempID",Split(Area_List(r),"|")(4),1
            Exit For
	      End If
	    End If
      Next
  End Select
End Sub

Sub Get_CityInfo()
   rCityEng = Lcase(Split(rUrl,".")(0))
   Select Case Int(WR_Area(2))
     Case 1 '二级域名
	   If AreaList <> "" and Instr(lcase(AreaList),"|"&rCityEng&"|") > 0 Then GetCity 2,lcase(rCityEng)
     Case 0 '城市ID
	   If AreaList <> "" and Instr(","&AreaList,","&rCityID&"|") > 0 Then GetCity 0,rCityID
   End Select
End Sub

Sub Get_IpCity()
    If AreaList = "" Then Exit Sub
    Dim IPConn,IPRs,City_IP,City_Name
	On Error Resume Next
	Set IPConn=Server.CreateObject("Adodb.Connection")
	IPConn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source="&Server.MapPath(IP_Data)
	If Err.Number<>0 Then
		Err.Clear
		Response.Write("IP切换数据库连接失败！")
		Response.End()
	End If
	City_IP = IP2Num(Request.ServerVariables("Remote_Addr"))
	Set IPRs = IPConn.Execute("Select City From IP_Address Where "&City_IP&">=IP1 and "&City_IP&"<=IP2")
	If Not IPRs.Eof Then
	  City_Name = IPRs(0)
	  If Instr(lcase(AreaList)&",","|"&City_Name&"|") > 0 Then GetCity 1,City_Name
	Else
	  GetCity -1,""
	End If
	Set IPRs = Nothing
	IPConn.Close
	Set IPConn = Nothing
End Sub
Function IP2Num(IP)
	Dim IPArr
	IPArr=Split(IP,".")
	IP2Num=Int(IPArr(0))*256*256*256+Int(IPArr(1))*256*256+Int(IPArr(2))*256+Int(IPArr(3))
End	Function

 '生成内容页面时调用
Function GetCityInfo(ID)
  GetCityInfo = False
  Select Case ID
    Case 0
     MyCity = WR_Area(0)
     MyCityID = 0
     MyCityEng = "www"
	 GetCityInfo = True
	Case Else
       '由传来的城市ID得到相关信息
	   If AreaList <> "" and Instr(","&AreaList,","&ID&"|") > 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(ID) Then
		  	   MyCityID = Split(Area_List(r),"|")(0)
			   MyCity = Split(Area_List(r),"|")(1)
			   MyCityEng = Split(Area_List(r),"|")(2)
		     End If
		   End If
	     Next
	     GetCityInfo = True
	   End If
  End Select
End Function
%>