复制代码 代码如下:
<!--#include file="conn.asp"-->
<!--#include file="KS_Cls/KS.PublicCls.asp"-->
<%
'=============================================
'KesionCMSV4.0 个人空间二级域名转向处理程序
'=============================================
'****************************************************
' Software name:Kesion CMS 4.0
' Email: service@kesion.com . QQ:111394,9537636
' Web: http://www.kesion.com http://www.kesion.cn
' Copyright (C) Kesion Network All Rights Reserved.
'****************************************************
Dim KSCls
Set KSCls = New SiteIndex
KSCls.Kesion()
Set KSCls = Nothing
Class SiteIndex
Private KS
Private From,gourl,sdomain,title,username
Private Sub Class_Initialize()
If (Not Response.IsClientConnected)Then
Response.Clear
Response.End
End If
Set KS=New PublicCls
End Sub
Private Sub Class_Terminate()
Call CloseConn()
Set KS=Nothing
End Sub
Public Sub Kesion()
From = LCase(Request.ServerVariables("HTTP_HOST"))
sdomain = LCase(KS.SSetting(15))
sdomain = Replace(sdomain,"http://","")
sdomain = Replace(sdomain,"/","")
dim domain1,domain2
domain = LCase (from)
domain = Replace (domain,"http://","")
domain = Replace (domain,"/","")
if sdomain=domain and sdomain<>"" then
title=KS.Setting(1) & "-个人空间"
gourl="space/index.asp"
else
domain1= Replace (Left (domain,InStr (domain,".")),".","")
if Trim (domain1)="" or domain1="www" Then Response.Redirect("index.asp"):Response.End
dim rs:set rs=conn.execute("select username,blogname from ks_blog where [domain]='" & KS.R(domain1) & "'")
if rs.eof and rs.bof then
rs.close:set rs=nothing
'=====================这里定义其它系统非个人空间的二级域名转向，如论坛等=============================
if instr(Request.ServerVariables("SERVER_NAME"),"bbs.kesion.com")>0 then
response.redirect "bbs/index.asp"
elseif instr(Request.ServerVariables("SERVER_NAME"),"news.kesion.com")>0 then
response.redirect "news/"
elseif instr(Request.ServerVariables("SERVER_NAME"),"help.kesion.com")>0 then
response.redirect "help/"
else
response.redirect "index.asp"
end if
'============================================================================
exit sub
end if
title=rs("blogname")
domain1=rs("username")
rs.close:set rs=nothing
domain2= Right(domain,Len(domain)-InStr(domain,"."))
gourl="space/space.asp?username=" & domain1
end if
Response.Write ("<html>") & vbcrlf
Response.Write ("<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"" />") & vbcrlf
Response.Write ("<title>" & title & "</title>") & vbcrlf
Response.Write ("<head>") & vbcrlf
Response.Write ("</head>") & vbcrlf
Response.Write( "<frameset><frame src="""&gourl&"""></frameset>")
End Sub
End Class
%>
