我想修改一下科讯的首页文件
主要是想自动识别web和wap客户端
我想达到的是：
当客户以手机访问科讯程序时自动进入手机页面
当手机以wap.xxx.com域名进入网站时进入wap 目录
而电脑用wap.xxx.com域名进入网站时则进入wapmo目录
当手机以3g.xxx.com域名进入网站时进入wap 目录
而电脑用3g.xxx.com域名进入网站时则进入wapmo目录
请高手帮忙改一下谢谢了！
- <%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
- <%option explicit%>
- <!--#include file="KS_Cls/Kesion.AppCls.asp"-->
- <%
- '****************************************************
- ' Software name:Kesion CMS 7.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
- Const AllowSecondDomain=true '是否允许开启空间二级域名 true-开启 false-不开启
- Class SiteIndex
- Private KS,AppCls
- Private Sub Class_Initialize()
- If (Not Response.IsClientConnected)Then
- Response.Clear
- Response.End
- End If
- Set AppCls=New KesionAppCls
- Set KS=New PublicCls
- End Sub
- Private Sub Class_Terminate()
- Set KS=Nothing
- Set AppCls=Nothing
- Call CloseConn()
- End Sub
- Public Sub Kesion()
- '================================判断自动生成==============================
- Const PerTime=2 '自动生成间隔的时间数，单位为分钟。
- Dim Template,KSR,LastModified,FsoIndex:FsoIndex=KS.Setting(5)
- If PerTime>0 and Split(FsoIndex,".")(1)<>"asp" Then
- Set KSR = New Refresh
- Dim fs:set fs=Server.CreateObject(KS.Setting(99))
- If KS.CheckFile(KS.Setting(5))=false Then
- LastModified="1990-1-1"
- Else
- Dim f:set f=fs.getfile(server.MapPath(KS.Setting(5)))
- LastModified=f.DateLastModified
- End If
- if datediff("n",LastModified,Now)>=PerTime Then
- Template = KSR.LoadTemplate(KS.Setting(110))
- FCls.RefreshType = "INDEX" '设置刷新类型，以便取得当前位置导航等
- FCls.RefreshFolderID = "0" '设置当前刷新目录ID 为"0" 以取得通用标签
- Template=KSR.KSLabelReplaceAll(Template)
- Call KS.WriteTOFile(KS.Setting(5),Template)
- Set KSR=Nothing
- End If
- End If
- '===================================自动生成结束======================================
- If AllowSecondDomain=True And KS.IsNul(Request.QueryString("do")) Then
- SecondDomain
- Else
- Call AppCls.HomePage()
- End If
- End Sub
- Public Sub SecondDomain()
- dim From,gourl,sdomain,title,username,domain
- 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 lcase(domain)=lcase(KS.Setting(69)) or lcase(domain)=lcase(KS.JSetting(41)) or (sdomain=domain and sdomain<>"") Then '小论坛
- Call AppCls.Domain(domain)
- Exit Sub
- else
- domain1= Replace (Left (domain,InStr (domain,".")),".","")
- if Trim (domain1)="" or (domain1="www" and domain=replace(lcase(KS.Setting(2)),"http://","")) or (Request.ServerVariables("HTTP_HOST")="http://" & KS.Setting(2)) or ("http://" & lcase(Request.ServerVariables("HTTP_HOST"))=lcase(KS.Setting(2))) Then
- Call AppCls.HomePage() : Exit Sub
- Else
- '=====================这里定义其它系统非个人空间的二级域名转向，如论坛等=============================
- if instr(Request.ServerVariables("SERVER_NAME"),"bbs.XXX.com")>0 then
- response.redirect KS.GetDomain & "club/index.asp"
'===我改动的部分===
elseif instr(Request.ServerVariables("HTTP_ACCEPT"),"text/vnd.wap.wml")>0 then
- response.redirect KS.GetDomain & "wap/" '我主要是想让网站如果手机访问自己动跳转到wap目录这句好像是没问题的
'===出错的代码===
elseif instr(Request.ServerVariables("SERVER_NAME"),"wap.XXX.com")>0 Then
- if instr(Request.ServerVariables("HTTP_ACCEPT"),"text/vnd.wap.wml")>0 then
- response.redirect KS.GetDomain & "wap" '这里我是想要手机访问自动跳转到网站WAP地址
- else
- response.redirect KS.GetDomain & "wapmo" '而电脑用这个wap.XXX.com的域名访问则跳转到网站WEB地址，这里我的想法是做个wap模拟页面
- elseif instr(Request.ServerVariables("SERVER_NAME"),"3g.XXX.com")>0 Then
- if instr(Request.ServerVariables("HTTP_ACCEPT"),"text/vnd.wap.wml")>0 then
- response.redirect KS.GetDomain & "wap" '网站WAP地址 这里同上
- else
- response.redirect KS.GetDomain & "wapmo" '网站WEB地址
'===出错的代码===
'===我改动的部分结束===
- end if
- '============================================================================
- End If
- Set AppCls=New KesionAppCls
- if instr(domain,replace(replace(lcase(KS.Setting(2)),"http://",""),"www.",""))=0 and domain1="www" then
- Call AppCls.Domain(domain)
- else
- Call AppCls.Domain(domain1)
- end if
- Exit Sub
- end if
- End Sub
- End Class
- %>
- <%
- dim enterurl
- if instr(Request.ServerVariables("SERVER_NAME"),"www.xxx.com")>0 then
- response.redirect "/index.asp"
- elseif instr(Request.ServerVariables("SERVER_NAME"),"wap.xxx.com")>0 Then
- if instr(Request.ServerVariables("http_accept"),"wap")>0 then
- enterurl="wap" '网站WAP地址
- else
- enterurl="wapmo" '网站WEB地址
- end if
- Response.Redirect(enterurl)
- elseif instr(Request.ServerVariables("SERVER_NAME"),"bbs.xxx.com")>0 then
- response.redirect "bbs"
- end if
- %>
当前位置：
支持(0) | 
反对(0)
顶端 
底部
![电子邮件:[ admin@d2wl.com ]](http://bbs.kesion.com/club/images/email.gif){kind=small}
sanyoudouji 发表于：2011/5/7 9:40:43 | 只看该作者 查看该作者主题
藤椅 
