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

作者：david

本文地址：http://blog.iyi.cn/user/david/archives/2005/03/261.html

今天对车米网的论坛作了优化，发现动网论坛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去掉就行了：

<head>

</head>

<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

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

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

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

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>

</body>

</html>

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

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

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