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="www.wangye8.com/&bbsurl&"list.asp?boardid="&SQL(3,i)&" target=""_blank"">"&Dvbbs.htmlencode(boardname)&"</a>] " end if response.write "<a href="http://www.wangye8.com//&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="http://www.wangye8.com//&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="http://www.wangye8.com//&bbsurl&"dispuser.asp?name="&postname&" target=_blank>"&postname&"</a>)" case 4 response.write "(<a href="http://www.wangye8.com//&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="http://www.wangye8.com//&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>
减小字体
增大字体