对动网论坛作搜索引擎优化

对动网论坛作搜索引擎优化

- 中国WEB开发者网络 (http://www.webasp.net)
-- 技术教程 (http://www.webasp.net/article/)
--- 对动网论坛作搜索引擎优化 (http://www.webasp.net/article/24/23756.htm)

-- 作者：未知
-- 发布日期： 2005-05-11

今天对车米网的论坛作了优化，发现动网论坛7.0本来就考虑到了搜索引擎的问题，只需要简单修改就可以很好的优化了.

动网论坛采用javascript+模版的方式显示页面，服务器将没有深加工的数据和js代码一起发送到客户端解析，减轻了服务器负担，但是搜索引擎一般不会解析javascript代码的，不过动网论坛的主要页面都有判断浏览器类型，如果是搜索引擎，自动跳转到专门为浏览器显示的页面，但是这些页面做得不是太好，下面是我修改的结果：

昨天我把论坛的meta标签的description部分去掉，google发现这个标签后就会忽略下面的内容，直接区标签中的内容。

修改index.asp:

      将函数Sub Show_Index_Footer()中的

Dim BrowserType

If BrowserType.IsSearch Then Response.redirect "indexNew.asp"

提升到index.asp的前面，让页面一检测到是搜索引擎就跳转到优化后的页面，原来那样子的结果是google仅仅抓取了Show_Index_Footer()中的信息，前面的都给忽略了。

修改indexnew.asp

将Dvbbs.head()改为Dvbbs.head()

注释掉

Dvbbs.ActiveOnline()

Show_Index_Top

Show_Index_Footer

Response.Write Replace(template.html(9),"{$Getlink}",Getlink())

If Dvbbs.Forum_setting(29)="1" Then Call birthuser()

Dvbbs.Footer()

Response.Write Dvbbs.value

Response.Write template.html(8)(1)

这样子跳转后的首页显示的就相对比较简单了，但是代码还是有些冗余，如果想再精简些，就不要用dvbbs的模版了，直接用asp生成静态页面，能去掉的都去掉。

同样修改list_show.asp

将Dvbbs.head()改为Dvbbs.head()

注释掉

News

Board_Online

Show_List_Footer

Dvbbs.ActiveOnline()

Dvbbs.Footer()

再修改printpage.asp

如果你的论坛需要注册用户才能浏览，而你又要搜索引擎能够抓取信息的话，把If Dvbbs.GroupSetting(2)="0" Then Dvbbs.AddErrcode(31)这行注释掉。

其他的没什么好改的，这个页面的模版已经做得非常精简了，你可以试着修改page_postjob模版来增加些其他的连接。

下面作一个更有实际效果的索引页面，很多不错的php论坛都有这样的页面，效果很好：

新建一个目录，随便什么，然后在里面建立一个index.asp文件，这个文件的代码我直接用了动网论坛的newtopic.asp，把里面的js去掉就行了：



<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />

<title>车米网</title>
<link rel="stylesheet" href="../style.css" type="text/css" />
</head>
<body>
<div class="main">
<div class="top"><a href="../index.asp">车米网</a> - 论坛新贴</div>
<div class="body">
<%
'DVBBS 7.0 动网论坛首页调用-----主题调用
dim bbsurl,lockboardid,picurl
'############以下为修改项######################
dim lockurl
lockurl=""
'只允许调用网址,要以"HTTP://"开头,为空则不开放此功能.(可允许多网址限制，要以","分隔。)
'例如只允许此两个网址调用: lockurl="http://www.artistsky.net/,http://www.artbbs.net/"
bbsurl="http://bbs.my-car.cn/"       '请填写你论坛的正确地址,要以"HTTP://"开头
lockboardid="1,2,3"          '请填写限制调用的论坛版块ID,用逗号隔开。（当lock参数为1，2时生效）
picurl="http://bbs.my-car.cn/skins/default/topicface/" '心情图标目录地址
'############以上为修改项######################
'bbsurl=getservepath(request.ServerVariables("server_name")&request.ServerVariables("URL"))
'function getservepath(str)
'dim tmpstr
'tmpstr=split(str,"/")
'getservepath="http://"&replace(str, tmpstr(ubound(tmpstr)), "")
'end function
'*************************************
'上传到与CONN.ASP同级的目录下
'以上地址参数一定要修改,否则所调用的链接是去了以上的论坛.
'若有问题,可以运行一起上传的newscode.ASP文件进行调试(newscode.ASP运行前要修改调用参数)
' FSSUNWIN 2003.12.31
'*************************************
'if trim(lockurl)<>"" and checkserver(lockurl)=false then
' response.write "document.write ('数据被保护,禁止被其他站点调用!"
' response.end
'end if

Private function checkserver(str)
dim i,servername
checkserver=false
if str="" then exit function
str=split(Cstr(str),",")
servername=Request.ServerVariables("HTTP_REFERER")
for i=0 to Ubound(str)
if right(str(i),1)="/" then str(i)=left(trim(str(i)),len(str(i))-1)
  if Lcase(left(servername,len(str(i))))=Lcase(str(i)) then
   checkserver=true
   exit for
  else
   checkserver=false
  end if
next
end function

dim rs,sql
dim orders,reply,topic,isbest,lock,board,action,info,tlen,showpic
dim bname,ars
dim postinfo,postname,POSTTIME
dim NowUseBbs,boardname,boardid
dim i,k,n,sdate,searchdate
i=0:k=0
lock=0  'cint(trim(request("lock")))
orders=4 'trim(request("orders"))
boardid="all" 'trim(request("boardid"))
sdate=3 'trim(request("sdate"))
action=1 'cint(request("action"))
info=3  'request("info")
tlen=16  'request("tlen")
reply=0  'request("reply")
showpic=0 'request("showpic")
n=100  'trim(request("n"))
bname=0  'request("bname")
if n<>"" and IsNumeric(n) then
n=cint(n)
else
n=1
end if

if orders=1 then
  orders="hits desc,"
Elseif orders=2 or orders=3 then
  orders="dateandtime desc,"
end if
If boardid<>"all" and isnumeric(boardid) then
  if boardid=444 then
  response.write "document.write ('错误的版块参数，调用被中止！"
  response.end
  Else
  board=" and BoardID="&cint(boardid)
  if lock=3 then board=" and BoardID in (select boardid from board where ParentID="&cint(boardid)&") "
  End If
End If

if lock=1 then
  board=" and boardid not in ("&lockboardid&") "
elseif lock=2 then
  board=" and boardid in ("&lockboardid&") "
end if

Dvbbs.GetForum_Setting
connectionDatabase
if sdate<>"" and IsNumeric(sdate) then
  sdate=cint(sdate)
  if IsSqlDataBase=1 Then
  searchdate=" and datediff(day,dateandtime,"&SqlNowString&")<"&sdate
  else
  searchdate=" and datediff('d',dateandtime,"&SqlNowString&")<"&sdate
  end if
else
searchdate=""
end if

if action=1 then
  '显示主题
  if orders=2 then orders="lastposttime,"
  if orders=4 then orders=""
  set rs=conn.execute("select top "&n&" PostUserName,Title,topicid,boardid,dateandtime,topicid,hits,Expression,LastPost from Dv_topic where boardid<>444 "&board&searchdate&" ORDER BY "&orders&" topicid desc")
elseif action=2 then
  '显示精华主题
  if searchdate<>"" then searchdate=replace(searchdate," and"," where")
  if searchdate="" and board<>"" then board=replace(board," and"," where")
  set rs=conn.execute("select top "&n&" PostUserName,Title,rootid,boardid,dateandtime,Announceid,id,Expression from Dv_BestTopic "&board&searchdate&" ORDER BY "&orders&" id desc")
    else
     '显示主题或回复
  set rs=conn.execute("select top "&n&" username,topic,rootid,boardid,dateandtime,announceid,body,Expression from "&Dvbbs.NowUseBBS&" where (not boardid=444) "&board&searchdate&" ORDER BY "&orders&" AnnounceID desc")
end if
If Not RS.Eof then
  SQL=Rs.GetRows(-1)
  else
  response.write "暂未有新帖子！"
  response.end
    end if
    rs.close
set rs=nothing

For i=0 To Ubound(SQL,2)
  topic=SQL(1,i)
  if topic="" then
   topic=SQL(6,i)
  end if
  Topic=Stringhtml(topic)
  if len(topic)>Cint(tlen) then
   topic=left(topic,tlen)&"..."
  end if

  postname=SQL(0,i)
  POSTTIME=SQL(4,i)
  if action=1 and reply=1 then
   if SQL(8,i)<>"" then
   postinfo=split(SQL(8,i),"$")
   postname=postinfo(0)
   POSTTIME=postinfo(2)
   end if
  end if
  response.write "<li class=list>"
  if showpic=1 then
  response.write "<IMG SRC="""&picurl&SQL(7,i)&""" BORDER=0 >"
  else
  end if
  if bname=1 then
   set ars=conn.execute("select BoardType from Dv_board where boardid="&SQL(3,i))
    boardname=ars(0)
    ars.close
    response.write "[<a href="&bbsurl&"list.asp?boardid="&SQL(3,i)&" target=""_blank"">"&Dvbbs.htmlencode(boardname)&"</a>] "
  end if
  response.write "<a href="&bbsurl&"printpage.asp?boardid="&SQL(3,i)&"&ID="&SQL(2,i)&"&replyID="&SQL(5,i)&" target=""_blank"" title="&Topic&">"
  response.write ""&Topic&""
  response.write "</a>"
  select case cint(info)
  case 0
  case 1
  response.write "　(<a href="&bbsurl&"dispuser.asp?name="&postname&" target=_blank>"&postname&"</a>,<font color=green>"&formatdatetime(POSTTIME,0)&"</font>)"
  case 2
  response.write "　(<font color=green>"&POSTTIME&"</font>)"
  case 3
  response.write "　(<a href="&bbsurl&"dispuser.asp?name="&postname&" target=_blank>"&postname&"</a>)"
  case 4
  response.write "　(<a href="&bbsurl&"dispuser.asp?name="&postname&" target=_blank>"&postname&"</a>"
  if cint(action)=1 then response.write ",<font color=green>"&SQL(6,i)&"</font>"
  Response.Write ")"
  case 5
  if cint(action)=1 then
  response.write "(<font color=green>"&SQL(6,i)&"</font>)"
  end if
  case 6
  response.write "　(<a href="&bbsurl&"dispuser.asp?name="&postname&" target=_blank>"&postname&"</a>,<font color=green>"&formatdatetime(POSTTIME,1)&"</font>)"
  case 7
  response.write "　(<font color=green>"&formatdatetime(POSTTIME,1)&"</font>)"
  case else

  end select
  response.write "</li>"
  k=k+1
Next
Call CloseObject

Sub CloseObject()
  Set template = Nothing
  Set MyBoardOnline = Nothing
  Set Dvbbs = Nothing
  Set Conn = Nothing
End Sub

Function Stringhtml(str)
  Dim re
  Set re=new RegExp
  re.IgnoreCase =True
  re.Global=True
  're.Pattern="<(.*)>"
  'str=re.replace(str, "")
  re.Pattern="\[(.*)\]"
  str=re.replace(str, "")
  str = Replace(str, CHR(34), """")
  str = Replace(str, CHR(39), "\'")
  str = Replace(str, CHR(13), "")
  str = Replace(str, CHR(10), "")
  str = replace(str, ">", ">")
  str = replace(str, "<", "<")
  if str="" then str="..."
  Stringhtml=str
End Function
%>
</div>
</div>
</body>
</html>

效果见http://bbs.my-car.cn/newtopic

然后再去修改indexnew.asp，加上这个页面的索引就行了。

剩下的大家去挖掘吧~哈哈

webasp.net