top.asp

微型论坛完整版

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%
Option explicit
Response.Buffer=True

'###简要设置### 

'调用方法:将<script language="javascript" src="top.asp?tit=30&top=5"></script>复制到首页合适地方

'#1,留言本主文件名
const weburl="index.asp"

'#2,是否显示发表者' 1 显示 0 不显示
const view_user=1 

'#3,是否显示更多' 1 显示 0 不显示
const view_more=1 

'#4,是否显示时间' 1 显示 0 不显示
const view_date=1 

'字体大小,12是标准的大小
const font_size="12px" 

dim tds
tds=1
if view_user=1 then tds=tds+1
if view_date=1 then tds=tds+1
dim db%>
<!--#include file="CONN.ASP"-->
<%
sub connurl(DBName)
    On Error Resume Next
    set conn=Server.CreateObject("ADODB.Connection")
dim DBHost,DBstr
if instr(DBName,",")>0 then DBHost="sql"
Select Case (DBHost) 
	Case "sql"
	DBstr=split(DBName,",")
    conn.Open "provider=sqloledb;uid=" & DBstr(2) & ";pwd=" & DBstr(3) & ";server=" & DBstr(1) & ";database="& DBstr(0)
	Case Else
    conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBName
End Select

    If Err Then
           err.Clear
           Set conn = Nothing
           Response.Write "数据库连接出错，请检查连接字串。"
           Response.End
     End If
end sub
dim conn,rs
call connurl(db)
call toplist()

'######## 首页调用 ########
'
Sub toplist()
dim jd_nm,jd_top,jd_name,tm,tn,p,forumid
forumid=request.QueryString("forumid")

jd_nm=request.QueryString("tit")
if jd_nm="" then jd_nm=30 

jd_top=request.QueryString("top") 
if jd_top="" then jd_top=10

jd_nm=int(jd_nm)
jd_top=int(jd_top)
if jd_top>100 then jd_top=100
dim url1,url2,url
url1=request.servervariables("server_name")
url2=request.servervariables("url")
url="http://"&url1&url2
url=replace(url,"top.asp",weburl)

tn=conn.Execute("select jd_repn from admin",0,1)(0)
if forumid="" then
Set rs=conn.Execute("select top "&jd_top&" a.id,a.jd_title,a.jd_rdate,a.jd_name,a.jd_reid,a.jd_forumid,a.jd_rep from topics a,forum b where a.jd_forumid=b.id and (b.jd_cls in (0,1,2,3,4,10)) and a.jd_cls<3 order by jd_rdate desc",0,1)
else
forumid=clng(forumid)
Set rs=conn.Execute("select top "&jd_top&" a.id,a.jd_title,a.jd_rdate,a.jd_name,a.jd_reid,a.jd_forumid,a.jd_rep from topics a,forum b where a.jd_forumid=b.id and (b.jd_cls in (0,1,2,3,4,10)) and a.jd_cls<3 and a.jd_forumid="&forumid&" order by jd_rdate desc",0,1)
end if
%>
document.write("<table width='99%' border='0' align='left' cellpadding='0' cellspacing='0' style='font-size: <%=font_size%>;'>")
<% do while not rs.eof 
tm=rs(6)
p=1
if tm>tn then
p=int(tm/tn)
if tm/tn>p then p=p+1
end if

jd_name=""
jd_name=rs(3)
if len(rs(4))>1 then jd_name=rs(4)
%>     
document.write("<tr><td><font face=webdings color='#FF6600'>4</font>&nbsp;<a href='<%=url%>?page=<%=p%>&action=view_topics&id=<%=rs(0)%>&forumid=<%=rs(5)%>' target='_blank'><%=LeftTrue(rs(1),jd_nm)%></a></td>")
<%if view_user=1 then%>
document.write("<td><%=jd_name%></td>")
<%end if
if view_date=1 then
%>
document.write("<td><font color='#999999'>(<%=month(rs(2))&"/"&day(rs(2))%>)</font></td></tr>")
<%end if%>
document.write("<tr><td height='1' colspan='<%=tds%>' bgcolor='#E4F2FA'></td></tr>") 
<%
rs.movenext
loop 
rs.close
set rs=nothing
conn.close
set conn=nothing
if view_more=1 then
%>
document.write("<tr><td colspan='<%=tds%>' align='right'><a href='<%=url%>' target='_blank'> >>更多</a></td></tr>")
<%
end if
%>
document.write("</table>")
<%
response.end
End Sub
Function LeftTrue(str,n)
dim i
  If Len(str) <= (n/2) Then
   LeftTrue = str
  Else
   Dim TStr, l, t, c
   l = Len(str) : TStr="" : t=0
   For i = 1 To l
    c = Asc(Mid(str,i,1))
    If c < 0 Then c = c + 65536
    If c > 255 Then
     t = t + 2
    Else
     t = t + 1
    End If
    If t > n Then Exit For
    TStr = TStr & (Mid(str,i,1))
    Next
   LeftTrue = TStr
  End If
End Function
%>