<%@language=vbscript codepage=936 LCID=2052 %>
<%
option explicit
response.buffer=true
dim conn,connstr
dim master
dim i
dim objET
set objET=new clsExeTime
Set Conn=Server.CreateObject("ADODB.Connection")
'Connstr="DBQ="+server.mappath("public/ly.mdb")+";DefaultDir=;DRIVER={Microsoft Access Driver (*.mdb)};DriverId=25;FIL=MS Access;ImplicitCommitSync=Yes;MaxBufferSize=512;MaxScanRows=8;PageTimeout=5;SafeTransactions=0;Threads=3;UserCommitSync=Yes;"
'connstr="DBQ=" & server.mapPath("public/global.asa") & ";DRIVER={Microsoft Access Driver (*.mdb)};"
connstr ="Provider = Microsoft.Jet.OLEDB.4.0; Data Source ="& Server.MapPath("db/youseehao8.asa")
Conn.Open connstr
master=getMaster
dim theUser
set theUser=new users
sub connclose
conn.close
set conn=nothing
end sub
sub rsclose
rs.close
set rs=nothing
end sub
function encodestr(str)
str=trim(str)
str=replace(str,"<","<")
str=replace(str,">",">")
str=replace(str,"'","""")
str=replace(str,vbCrLf&vbCrlf,"
")
str=replace(str,vbCrLf," ")
str=Replace(str,"&#","&#")
encodestr=replace(str," "," ")
end function
function validEmail(email)
dim length, atIndex, dotIndex
length=len(email)
atIndex=instr(email,"@")
dotIndex=instrrev(email,".")
if length<6 then
validEmail=false
exit function
end if
if atIndex<0 or dotIndex<0 or length-dotIndex<2 or dotIndex-atIndex<3 then
validEmail=false
exit function
end if
validEmail=true
end function
function getMaster()
dim rs, sql,str,LF
LF=chr(10)
sql="select username from [user] where gbuserClass>0"
set rs=conn.execute(sql)
if not (rs.eof and rs.bof ) then
str=rs(0)
rs.movenext
do until rs.eof
str=str & LF & rs(0)
rs.movenext
loop
end if
getMaster=split(str,LF)
'response.write str
end function
function isMaster(name)
isMaster=false
for i=0 to ubound(master)
if master(i)=name then
isMaster=true
exit function
end if
next
end function
function isLikeMasterName(name)
isLikeMasterName=false
for i=0 to ubound(master)
if instr(name,master(i))>0 then
isLikeMasterName=true
exit function
end if
next
end function
class users
dim id, name,pass,reged,master,male,face,email,qq,url,icq,msn,admin
private sub class_initialize()
dim rs,sql
name=request.cookies("gbook")("username")
if name<>"" then
name=replace(vbunescape(name),"'","")
end if
pass=replace(request.cookies("gbook")("password"),"'","")
reged=false
master=false
admin=false
male=true
id=0
if name<>"" and pass<>"" then
sql="select top 1 userid, username,userpassword,useremail,sex,GBface,oicq,icq,msn,homepage,gbuserclass from [user] where username='"&name&"' "
set rs=conn.execute(sql)
if (not rs.eof) then
if pass=rs("userpassword") then
reged=true
id=rs("userid")
if rs("sex")="1" then
male=true
else
male=false
end if
face=rs("GBface")
email=rs("useremail")
qq=rs("oicq")
icq=rs("icq")
msn=rs("msn")
url=rs("homepage")
if rs("gbuserclass")>0 then
master=true
if rs("gbuserclass")=2 then
admin=true
else
admin=false
end if
else
master=false
admin=false
end if
end if
end if
rs.close
end if
end sub
end class
class clsExeTime
dim t1,t2
private sub class_initialize()
t1=timer
end sub
public function read()
t2=timer
read=formatnumber((t2-t1)*1000,2,-1)
end function
end class
%>
<%
dim skin,style,rcPerPage,pageLinkNum,mustReg,masterRe,imgUbb
dim sitetitle,homepage,masterEmail,esCode,timeDiff,killword,maxLength,showFace,postLimit
dim cookiePath
dim rcPerPage1,rcPerPage2,defaultSkin,defaultStyle
getConst()
function getskin()
dim skin
skin=request.cookies("gbookskin")
if skin="" or not isNumeric(skin) then
skin=defaultSkin '默认的界面风格=================
else
skin=int(skin)
end if
getskin=skin
end function
function getstyle()
dim style
style=request.cookies("style")
if style="" or not isNumeric(style) then
style=defaultStyle '默认的显示方式，1为留言本式，2为讨论区式=============
else
style=int(style)
end if
getstyle=style
end function
sub getConst()
dim rs,sql,lf
lf=chr(10)
sql="select top 1 pageLinkNum,mustReg,masterRe,imgUbb,rcPerPage1,rcPerPage2,defaultSkin,defaultStyle,esCode,title,homepage,masterEmail,timeDiff,killWord,maxLength,showFace,postLimit from GBconst"
set rs=conn.execute(sql)
pageLinkNum=rs(0) '每页连接显示数===============
mustReg=rs(1) '是否注册才可留言，是把false改为true
masterRe=rs(2) '是否只有版主可以回复，是把false改为true
imgUbb=rs(3) 'ubb帖图标签是否可用，不可用把true改为false
rcPerPage1=rs(4) '留言本式查看方式每页显示留言数============
rcPerPage2=rs(5) '讨论区式查看方式每页显示留言数============
defaultSkin=rs(6) '默认的界面风格=================
defaultStyle=rs(7) '默认的显示方式，1为留言本式，2为讨论区式=============
esCode=rs(8)
sitetitle=rs(9)
homepage=rs(10)
masterEmail=rs(11)
timeDiff=rs(12)
killWord=split(rs(13),",")
maxLength=rs(14)
showFace=rs(15)
postLimit=rs(16)
rs.close
set rs=nothing
skin=getskin()
style=getstyle()
execute vbunescape (esCode)
cookiePath=request.servervariables("path_info")
cookiePath=left(cookiePath,instrRev(cookiePath,"/"))
end sub
%>
<% for i=0 to ubound(master) %>
〖 <%=master(i)%> 〗
<% next %>
<%if style=1 then
response.write "讨论区方式查看"
else
response.write "留言本方式查看"
end if
%>
<%
dim exec, rs, x
rcPerPage=40 '排行前多少名用户
main()
sub main()
exec="select top "& rcPerPage &" * from [user] order by GBpostNum desc,userid"
Set RS = Server.CreateObject("ADODB.RecordSet")
rs.Open exec, Conn, 1, 1
%>
· 本 留 言 本 发 言 前 <%=rcPerPage%> 名 用 户 ·
<%
i=0
do while not rs.eof
response.write "
"& (i+1) &"."& rs("username") &" ["& rs("GBpostNum") &"]"
i=i+1
if i mod 4=0 then
response.write "
"
else
response.write ""
end if
rs.movenext
loop %>
<%if style=1 then
response.write "讨论区方式查看"
else
response.write "留言本方式查看"
end if
%>