<%@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 %> <% function times(t) if not isdate(t) then exit function dim thour, tminute, tday, nowday, dnt, dayshow, pshow thour=hour(t) tminute=minute(t) tday=datevalue(t) nowday=datevalue(now) dnt=datediff("d",tday,nowday) if dnt>2 then dayshow=year(t) if (month(t)<10) then dayshow=dayshow&"-0"&month(t) else dayshow=dayshow&"-"&month(t) end if if (day(t)<10) then dayshow=dayshow&"-0"&day(t) else dayshow=dayshow&"-"&day(t) end if times=dayshow exit function elseif dnt=0 then dayshow="今天 " elseif dnt=1 then dayshow="昨天 " elseif dnt=2 then dayshow="前天 " end if 'if thour>=7 and thour<11 then ' pshow="上午" 'elseif thour>=11 and thour<14 then ' pshow="中午" 'elseif thour>=14 and thour<18 then ' pshow="下午" 'elseif thour>=18 then ' pshow="晚上" 'elseif thour>=0 and thour<7 then ' pshow="清晨" 'else ' pshow="难说" 'end if times=dayshow&pshow&thour&":"&tminute end function %> <% function UBBCode(strContent) dim re,i strContent=encodestr(strContent) strContent=funkillWord(strContent) UbbCode=strContent if (instr(strContent,"[")=0 or instr(strContent,"]")=0) and instr(strContent,"http://")=0 then exit function end if Set re=new RegExp re.IgnoreCase =true re.Global=True '过滤script事件 if instr(1,strContent,"on",1)>0 then re.Pattern="on(\w+)=" strContent=re.Replace(strContent,"on_$1=") end if strContent=Replace(strContent,"file:","file :") strContent=Replace(strContent,"files:","files :") strContent=Replace(strContent,"script:","script :") strContent=Replace(strContent,"js:","js :") if instr(1,strContent,"[IMG]",1)>0 then re.Pattern="(\[IMG\])(.[^\[]*)(\[\/IMG\])" if imgUbb then strContent=re.Replace(strContent,"按此在新窗口浏览图片500)this.width=500""> ") else strContent=re.Replace(strContent,"$2 ") end if end if if instr( request.servervariables("url"),"show")>0 then if instr(1,strContent,"[/dir]",1)>0 then re.Pattern="\[DIR=*([0-9]*),*([0-9]*)\](.[^\[]*)\[\/DIR]" strContent=re.Replace(strContent,"") end if if instr(1,strContent,"[/qt]",1)>0 then re.Pattern="\[QT=*([0-9]*),*([0-9]*)\](.[^\[]*)\[\/QT]" strContent=re.Replace(strContent,"") end if if instr(1,strContent,"[/mp]",1)>0 then re.Pattern="\[MP=*([0-9]*),*([0-9]*)\](.[^\[]*)\[\/MP]" strContent=re.Replace(strContent,"") end if if instr(1,strContent,"[/rm]",1)>0 then re.Pattern="\[RM=*([0-9]*),*([0-9]*)\](.[^\[]*)\[\/RM]" strContent=re.Replace(strContent,"
") end if else if instr(1,strContent,"[/dir]",1)>0 then re.Pattern="\[DIR=*([0-9]*),*([0-9]*)\](.[^\[]*)\[\/DIR]" strContent=re.Replace(strContent,"$3") end if if instr(1,strContent,"[/qt]",1)>0 then re.Pattern="\[QT=*([0-9]*),*([0-9]*)\](.[^\[]*)\[\/QT]" strContent=re.Replace(strContent,"$3") end if if instr(1,strContent,"[/mp]",1)>0 then re.Pattern="\[MP=*([0-9]*),*([0-9]*)\](.[^\[]*)\[\/MP]" strContent=re.Replace(strContent,"$3") end if if instr(1,strContent,"[/rm]",1)>0 then re.Pattern="\[RM=*([0-9]*),*([0-9]*)\](.[^\[]*)\[\/RM]" strContent=re.Replace(strContent,"$3") end if end if if instr(1,strContent,"[flash]",1)>0 then re.Pattern="(\[FLASH\])(.[^\[]*)(\[\/FLASH\])" strContent= re.Replace(strContent,"$2") end if if instr(1,strContent,"ftp://",1)>0 then re.Pattern = "^(ftp://[A-Za-z0-9\./=\?%\-&_~`@':+!]+)" strContent = re.Replace(strContent,"$1") re.Pattern = "(ftp://[A-Za-z0-9\./=\?%\-&_~`@':+!]+)$" strContent = re.Replace(strContent,"$1") re.Pattern = "([^>=""])(ftp://[A-Za-z0-9\.\/=\?%\-&_~`@':+!]+)" strContent = re.Replace(strContent,"$1$2") end if if instr(1,strContent,"rtsp://",1)>0 then re.Pattern = "^(rtsp://[A-Za-z0-9\./=\?%\-&_~`@':+!]+)" strContent = re.Replace(strContent,"$1") re.Pattern = "(rtsp://[A-Za-z0-9\./=\?%\-&_~`@':+!]+)$" strContent = re.Replace(strContent,"$1") re.Pattern = "([^>=""])(rtsp://[A-Za-z0-9\.\/=\?%\-&_~`@':+!]+)" strContent = re.Replace(strContent,"$1$2") end if if instr(1,strContent,"mms://",1)>0 then re.Pattern = "^(mms://[A-Za-z0-9\./=\?%\-&_~`@':+!]+)" strContent = re.Replace(strContent,"$1") re.Pattern = "(mms://[A-Za-z0-9\./=\?%\-&_~`@':+!]+)$" strContent = re.Replace(strContent,"$1") re.Pattern = "([^>=""])(mms://[A-Za-z0-9\.\/=\?%\-&_~`@':+!]+)" strContent = re.Replace(strContent,"$1$2") end if 're.Pattern="(\[HTML\])(.+?)(\[\/HTML\])" 'strContent=re.Replace(strContent,"
以下内容为程序代码:
$2
") if instr(1,strContent,"[/color]",1)>0 then re.Pattern="(\[color=(.[^\[]*)\])(.[^\[]*)(\[\/color\])" strContent=re.Replace(strContent,"$3") end if if instr(1,strContent,"[/face]",1)>0 then re.Pattern="(\[face=(.[^\[]*)\])(.[^\[]*)(\[\/face\])" strContent=re.Replace(strContent,"$3") end if if instr(1,strContent,"[/align]",1)>0 then re.Pattern="(\[align=(.[^\[]*)\])(.[^\[]*)(\[\/align\])" strContent=re.Replace(strContent,"

$3
") end if if instr(1,strContent,"[/quote]",1)>0 then re.Pattern="(\[QUOTE\])(.[^\[]*)(\[\/QUOTE\])" strContent=re.Replace(strContent,"
$2

") end if if instr(1,strContent,"[/fly]",1)>0 then re.Pattern="(\[fly\])(.[^\[]*)(\[\/fly\])" strContent=re.Replace(strContent,"$2") end if if instr(1,strContent,"[/move]",1)>0 then re.Pattern="(\[move\])(.[^\[]*)(\[\/move\])" strContent=re.Replace(strContent,"$2") end if if instr(1,strContent,"[/glow]",1)>0 then re.Pattern="\[GLOW=*([0-9]*),*(#*[a-z0-9]*),*([0-9]*)\](.[^\[]*)\[\/GLOW]" strContent=re.Replace(strContent,"$4
") end if if instr(1,strContent,"[/shadow]",1)>0 then re.Pattern="\[SHADOW=*([0-9]*),*(#*[a-z0-9]*),*([0-9]*)\](.[^\[]*)\[\/SHADOW]" strContent=re.Replace(strContent,"$4
") end if if instr(1,strContent,"[/i]",1)>0 then re.Pattern="(\[i\])(.[^\[]*)(\[\/i\])" strContent=re.Replace(strContent,"$2") end if if instr(1,strContent,"[/u]",1)>0 then re.Pattern="(\[u\])(.[^\[]*)(\[\/u\])" strContent=re.Replace(strContent,"$2") end if if instr(1,strContent,"[/b]",1)>0 then re.Pattern="(\[b\])(.[^\[]*)(\[\/b\])" strContent=re.Replace(strContent,"$2") end if if instr(1,strContent,"[/size]",1)>0 then re.Pattern="(\[size=1\])(.[^\[]*)(\[\/size\])" strContent=re.Replace(strContent,"$2") re.Pattern="(\[size=2\])(.[^\[]*)(\[\/size\])" strContent=re.Replace(strContent,"$2") re.Pattern="(\[size=3\])(.[^\[]*)(\[\/size\])" strContent=re.Replace(strContent,"$2") re.Pattern="(\[size=4\])(.[^\[]*)(\[\/size\])" strContent=re.Replace(strContent,"$2") end if if instr(1,strContent,"[/center]",1)>0 then re.Pattern="(\[center\])(.[^\[]*)(\[\/center\])" strContent=re.Replace(strContent,"
$2
") end if if instr(1,strContent,"[/list]",1)>0 then strContent = doCode(strContent, "[list]", "[/list]", "") strContent = doCode(strContent, "[list=1]", "[/list]", "
    ", "
") strContent = doCode(strContent, "[list=a]", "[/list]", "
    ", "
") end if if instr(1,strContent,"[/*]",1)>0 then strContent = doCode(strContent, "[*]", "[/*]", "
  • ", "
    • ") end if if instr(1,strContent,"[/code]",1)>0 then strContent = doCode(strContent, "[code]", "[/code]", "
    ", "
    ") end if set re=Nothing UBBCode=strContent end function function doCode(fString, fOTag, fCTag, fROTag, fRCTag) dim fOTagPos, fCTagPos fOTagPos = Instr(1, fString, fOTag, 1) fCTagPos = Instr(1, fString, fCTag, 1) while (fCTagPos > 0 and fOTagPos > 0) fString = replace(fString, fOTag, fROTag, 1, 1, 1) fString = replace(fString, fCTag, fRCTag, 1,1, 1) fOTagPos = Instr(1, fString, fOTag, 1) fCTagPos = Instr(1, fString, fCTag, 1) wend doCode = fString end function function funKillword(str) for i=0 to ubound(killword) str=replace(str,killword(i),"***") next funKillword=str end function %> <% function userEmail(email) if email<>"" then response.write(" ") else response.write(" ") end if end function function userQQ(qq) if qq<>"" then response.write(" ") else response.write(" ") end if end function function userIcq(icq) if (icq<>"") then response.write(" ") else response.write(" ") end if end function function userMsn(msn) if (msn<>"") then response.write(" ") else response.write(" ") end if end function function userUrl(url) if (url<>"" and url<>"http://") then response.write("") else response.write("") end if end function function userIp(ip,add) if (ip<>"") then response.write("ＩＰ:"+ip) else response.write("<img src=images/ip.gif align=absmiddle alt="") then response.write(" 来源:"+add+"'> ") else response.write(" 来源:☆未知☆'> ") end if end function function userNameFace(name,face,male,reged,ismaster) 'if show then response.write("") response.write("
    ") response.write(") if (male=1) then response.write(
    "+name) if (reged=1) then if (ismaster) then response.write("") else response.write("") end if else response.write("") end if response.write("
    ") response.write("") 'end if end function function userNameNoFace(name,reged,ismaster) 'if (not show) then response.write("  ( "+name) if (reged=1) then if (ismaster) then response.write(" ") else response.write(" ") end if else response.write(" ") end if response.write(" )") 'end if end function function userName(name,reged,ismaster) response.write(name) if (reged=1) then if (ismaster) then response.write(" ") else response.write(" ") end if else response.write(" ") end if end function %> <% function getPageCount( pageCount, RecordCount, rcPerPage) pageCount=RecordCount/rcPerPage pageCount=int(pageCount) if (RecordCount mod rcPerPage)>0 then PageCount=PageCount +1 end if if pageCount<1 then pageCount=1 end if getPageCount=pageCount end function function getPage(page,pageCount) if page="" or not isNumeric(page) then page=1 else page=int(page) end if if page>pageCount then page=pageCount end if getPage=page end function %> <% function pageList() dim p,i if page<1 then page=1 end if if pagecount<1 then pagecount=1 end if pageList="" pageList=pageList & "" pageList=pageList & "
    共有记录 "& RecordCount &" 个，共 "& pageCount &" 页 " if page=1 then pageList=pageList & " 留言首页" else pageList=pageList & " 第一页" end if if page=1 then pageList=pageList & " 前一页" else pageList=pageList & " 前一页" end if if pagecount-page=0 then pageList=pageList & " 下一页" else pageList=pageList & " 下一页" end if pageList=pageList & "" 'pagecount=2 p=int(page/pageLinkNum) if page mod pageLinkNum>0 then p=p+1 end if p=(p-1)*pageLinkNum+1 'response.write p 'response.end i=p+(pageLinkNum-1) if i> pagecount then i=pagecount end if if p>pageLinkNum then pageList=pageList & "[<<]" end if do while p<=i if p=page then pageList=pageList & "["&p&"]" else pageList=pageList & "["&p&"]" end if p=p+1 loop p=p-1 if p< pagecount then pageList=pageList & "[>>]" end if pageList=pageList & "
    " end function %> <% dim exec, exec1, rs, page, recordcount dim rs1, pagecount, strpageList dim topNum,maxid, minid, sqlCol dim arr rem strpagelist是分页显示的字符串 set rs=server.createobject("adodb.recordset") exec="select top 1 topicNum-privateNum from GBconst" rs.open exec,conn,1,1 RecordCount=rs(0) rs.close page=encodestr(Request.querystring("page")) pageCount=getPageCount(pagecount,recordCount,rcPerPage) page=getPage(page,pageCount) %> <%=sitetitle%>
     
     
    关于我们
    整形美容
    医学美容
    激光美容
    光子美容
    整形专家
    		 医院地址
     
    >> 发新留言   <% if not theUser.reged then %> 首页:登陆:注册:精华:排行 <% elseif not theUser.master then %> 首页:修改:悄悄话:精华:排行:退出 <% elseif not theUser.admin then %> 首页:修改:悄悄话:精华:排行:退出 <% else %> 首页:修改:悄悄话:精华:排行:管理:退出 <% end if %> 版主 
    <%if style=1 then response.write "讨论区方式查看" else response.write "留言本方式查看" end if %>  
    <% strPageList=pageList() response.write (strPageList) if style=1 then sqlCol=" a.id, a.title, a.nei, a.t, a.rt, a.name, a.url, a.email, a.qq, a.pic, a.yd, a.hf, a.jh, a.bl, a.retime, a.istop, a.ip, a.male, a.face, a.comefrom, a.islock, a.icq, a.msn, a.reid, b.name as re_name, b.title as re_title, b.pic as re_pic, b.bl as re_bl, b.nei as re_nei from ly as a left outer join ly as b on a.reid=b.id and a.id<>b.id " else sqlCol=" a.id, a.title, a.t, a.name, a.pic, a.yd, a.hf, a.jh, a.bl, a.retime, a.istop, a.islock, b.name as re_name, b.bl as re_bl from ly as a left outer join ly as b on a.reid=b.id and a.id<>b.id " end if exec="select reid from ly where rt=0 and isprivate=0 order by istop desc, reid desc" set rs=server.createobject("adodb.recordset") rs.open exec,conn,1,1 if rs.eof then rs.close exec="select * from ly where id=0" elseif page<=1 then rs.move rcPerPage-1 if (rs.eof) then rs.moveprevious minid=rs(0) rs.close exec="select "& sqlCol &" where a.rt=0 and a.isprivate=0 and (a.reid>="& minid &" or a.istop=1) order by a.istop desc,a.reid desc" else rs.absolutepage=page maxid=rs(0) rs.move rcPerPage-1 if (rs.eof) then rs.moveprevious minid=rs(0) rs.close exec="select "& sqlCol &" where a.reid<="& maxid &" and a.reid>="& minid &" and a.istop=0 order by a.reid desc" end if if style=1 then %> [an error occurred while processing this directive]
    网站首页 | 诊所简介 | 联系我们 | 专家介绍 | 美容项目 | 无痛人流