鱼人码头ゅο°你说我说

<% page = Request.QueryString("page") action = Request.QueryString("action") action_e = Request.Form("action_e") set Conn=Server.CreateObject("ADODB.Connection") Conn.Open "driver={Microsoft Access Driver (*.mdb)};dbq=" & Server.MapPath("#bict2008data.asa") %> 鱼人码头ゅο°你说我说

<% ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '主程序 Select Case action_e Case "" Case "Add_New" Call Add_New_Execute() Case "reply" Call Reply_Execute() Case "admin" Call Admin_Login_Execute() Case "EditPWD" Call EditPWD_Execute() Case "Edit" Call Edit_Execute() End Select Call Main_Menu() Select Case action Case "UbbHelp" Call UbbHelp() Case "Admin_Login" Call Admin_Login() Case "Exit" Call Exit_Admin() Call View_Words() Case "" Call View_Words() Case "Add_New" Call Add_New() Case "reply" Call Reply() Case "View_Words" Call View_Words() Case "Delete" Call Delete() Call View_Words() Case "EditPWD" Call EditPWD() Case "Edit" Call Edit() End Select Call Copyrights() %>

<% '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '添加一条新留言 %> <% Sub Add_New() %>

添加留言
姓　名：	[ 必填]
电　邮：	[ 可选]
网　站：	[ 可选]
O I C Q：	[ 可选] [ 填写MSN帐号亦可]
留　言：

<% End Sub %> <% ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '管理员回复留言 %> <% Sub Reply() %>

回复留言
回　复：
">

<% End Sub %> <% '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' %> <% Sub Main_Menu() %>

我要留言　查看留言　 <% If Session("Admin")="Login" Then %> 退出管理　 <% Else %> 管理留言　 <% End If %> UBB帮助　 <% If Session("Admin")="Login" Then %> 修改密码 <% End If %>

<% End Sub ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '查看留言 Sub View_Words() If request.querystring("page")="" Then absPageNum = 1 else absPageNum=cint(request.querystring("page")) end if RecordPerPage = 5 Set rs = Server.CreateObject("ADODB.Recordset") rs.CursorType = adOpenStatic rs.CacheSize = RecordPerPage Sql="Select * From words Order By date Desc" rs.OPEN sql, Conn,1,1 rs.PageSize = RecordPerPage Tol = rs.PageCount If Not(rs.EOF) Then rs.AbsolutePage = absPageNum End If %> <% if rs.eof and rs.bof then response.write "

暂无内容

" else For absRecordNum = 1 to rs.PageSize%>

<%If Rs("reply")<>"" Then%> <%End If%>

姓　名：

<%=Rs("name")%>

]" href="mailto:<%=rs("email")%>">Email

]" href="<%=rs("web")%>" target="_blank">Web

]" href="javascript:;" onClick="MM_popupMsg('QQ号码：[ <%=rs("oicq")%> ]')">Oicq

留　言：

<%=Ubb(unHtml(Rs("words")))%>

<%=Left(Rs("date"),14)%>

回　复：

<%=Ubb(unHtml(Rs("reply")))%>

<%=Left(Rs("replydate"),14)%>

<% If Session("Admin") = "Login" Then %> ">【删除】 ">【回复】 ">【编辑】 <% End If %>

<% rs.movenext If rs.EOF Then Exit For End If Next end if %>

共有<%=TotalRecord%>条留言分页 <% num1=int((absPageNum-1)/10) abcd1=num1*10+11 abcd2=num1*10 if num1>0 then if tpe="" then%> [<<] <%else%> [<<] <%end if%> <%end if%> <% if rs.pagecount<=10 then fish=rs.pagecount else if rs.pagecount-num1*10>10 then fish=10 else fish=rs.pagecount-num1*10 end if end if for ppages=1 to fish ppages1=num1*10+ppages if ppages1=int(absPageNum) then %> [<%=ppages1%>] <% else if tpe="" then %> [<%=ppages1%>] <% elseif tpe<>"" then%> [<%=ppages1%>] <% end if end if next if num10 then %> <%if tpe="" then%> [>>] <%else%> [>>] <%end if end if %>

<%Rs.Close Set Rs = Nothing%> <% End Sub %> <% ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '管理员登陆接口 %> <% Sub Admin_Login() %>

管理登录
用户名：
密码：

<% End Sub%> <% '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' %> <% Sub Copyrights() %> <% End Sub %> <%Sub UbbHelp()%>

UBB功能帮助
	[img]	这里填写图片绝对地址 http://www.51buyflower/logo.gif	[/img]
	[url]	这里填写连接地址 http://www.51buyflower.com/	[/url]
	[swf]	这里填写SWF文件的地址 http://www.51buyflower.com/logo.swf	[/swf]
	[email]	这里填写电子信箱地址 xiaojie@51buyflower.com	[/email]
	[color=颜色]	这里填写要着色的文字	[/color]
	[size=大小]	这里填写要加大的文字	[/size]
	[font=字体]	这里填写要改变字体的文字	[/font]
	注：UBB代码中间不要有空格。

<%End Sub%>

<%Sub EditPWD()%>

修改密码
旧用户名：
新用户名：
确认新用户名：
旧密码：
新密码：
确认新密码：

<%End Sub%> <% Sub Edit() %> <% Set Rs = Server.CreateObject("ADODB.RecordSet") Sql="Select * From words Where id="&Request.QueryString("id") Rs.Open Sql,Conn,1,1 %>

编辑留言者留言
来客留言内容：	<%=Rs("words")%>
回复：	<%=Rs("reply")%>
"> 　　返回

<% End Sub %> <% ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '添加新留言到数据库 Sub Add_New_Execute() If Request.Form("name")="" Then Response.Write "
错误类型：姓名不能为空" Response.Write "
" Response.Write "
返回

" Response.End End If If Len(Request.Form("name"))>20 Then Response.Write "
错误类型：姓名不能太长" Response.Write "
" Response.Write "
返回

" Response.End End If If Request.Form("email")<>"" Then If instr(Request.Form("email"),"@")=0 or instr(Request.Form("email"),"@")=1 or instr(Request.Form("email"),"@")=len(email) then Response.Write "
错误类型：电子信箱格式填写不正确" Response.Write "
" Response.Write "
返回

" Response.End End If End If If Request.Form("words")="" Then Response.Write "
错误类型：留言不能为空" Response.Write "
" Response.Write "
返回

" Response.End End If Set Rs = Server.CreateObject("ADODB.RecordSet") Sql="Select * From words" Rs.Open Sql,Conn,2,3 Rs.AddNew Rs("name")=Server.HTMLEncode(Request.Form("name")) Rs("sex")=Server.HTMLEncode(Request.Form("sex")) Rs("head")=Server.HTMLEncode(Request.Form("head")) Rs("web")=Server.HTMLEncode(Request.Form("web")) Rs("email")=Server.HTMLEncode(Request.Form("email")) Rs("oicq")=Server.HTMLEncode(Request.Form("oicq")) Rs("words")=Server.HTMLEncode(Request.Form("words")) Rs("date")=Now() 'Rs("replydate")=Now() Rs.Update Rs.Close Set Rs = Nothing End Sub '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '验证管理员登陆 Sub Admin_Login_Execute() username = Server.HTMLEncode(Request.Form("username")) password = Server.HTMLEncode(Request.Form("password")) If username = "" OR password = "" Then Response.Write "
错误类型：用户名或者密码为空" Response.Write "
" Response.Write "
返回

" Response.End End If Set Rs = Server.CreateObject("ADODB.RecordSet") Sql="Select * From admin" Rs.Open Sql,Conn,1,1 If username = Rs("username") AND password = Rs("password") Then Session("Admin") = "Login" Else Response.Write "
错误类型：用户名或者密码不对，登陆失败" Response.Write "
" Response.Write "
返回

" Response.End End If Rs.Close Set Rs = Nothing End Sub Sub EditPWD_Execute() oldusername=Server.HTMLEncode(Request.Form("oldusername")) username = Server.HTMLEncode(Request.Form("username")) username_c = Server.HTMLEncode(Request.Form("username_c")) oldpwd = Server.HTMLEncode(Request.Form("oldpwd")) newpwd = Server.HTMLEncode(Request.Form("newpwd")) newpwd_c = Server.HTMLEncode(Request.Form("newpwd_c")) If username = "" OR username_c="" Then Response.Write "新旧用户名均不能为空" Response.End End If If oldpwd = "" OR newpwd = "" OR newpwd_c="" Then Response.Write "新旧密码均不能为空" Response.End End If If username<>username_c Then Response.Write "新填写的两个新用户名不一致，请重新填写" Response.End End If If newpwd<>newpwd_c Then Response.Write "新填写的两个密码不一致，请重新填写" Response.End End If Set Rs = Server.CreateObject("ADODB.RecordSet") Sql="Select * From admin" Rs.Open Sql,Conn,2,3 If Rs("password")=oldpwd And Rs("username")=oldusername Then Rs("username")=username Rs("password")=newpwd Rs.Update Else Response.Write "你的旧密码填写不对或者旧用户名不对，修改不成功" Response.End End If Rs.Close Set Rs = Nothing End Sub Sub Exit_Admin() Session.Abandon response.redirect"index.asp" End Sub ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '删除数据 Sub Delete() '删除数据 Conn.Execute("Delete * From words Where id="&Request.QueryString("id")) End Sub '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '回复留言添加到数据库 Sub Reply_Execute() Set Rs = Server.CreateObject("ADODB.RecordSet") Sql="Select reply ,replydate From words Where id="&Request.Form("id") Rs.Open Sql,Conn,2,3 Rs("reply") = Server.HTMLEncode(Request.Form("reply")) Rs("replydate")=Now() Rs.Update Rs.Close Set Rs=Nothing End Sub Sub Edit_Execute() Set Rs = Server.CreateObject("ADODB.RecordSet") Sql="Select * From words Where id="&Request.Form("id") Rs.Open Sql,Conn,2,3 Rs("words") = Server.HTMLEncode(Request.Form("words")) Rs("reply") = Server.HTMLEncode(Request.Form("reply")) Rs("replydate")=Now() Rs.Update Rs.Close Set Rs=Nothing End Sub Conn.Close Set Conn = Nothing %> <% function unHtml(content) unHtml=content if content <> "" then unHtml=replace(unHtml,"&","&") unHtml=replace(unHtml,"<","<") unHtml=replace(unHtml,">",">") unHtml=replace(unHtml,chr(34),""") unHtml=replace(unHtml,chr(13),"
") unHtml=replace(unHtml,chr(32)," ") 'unHtml=ubb(unHtml) end if end function function ubb(content) ubb=content nowtime=now() UBB=Convert(ubb,"code") UBB=Convert(ubb,"html") UBB=Convert(ubb,"url") UBB=Convert(ubb,"color") UBB=Convert(ubb,"font") UBB=Convert(ubb,"size") UBB=Convert(ubb,"quote") UBB=Convert(ubb,"email") UBB=Convert(ubb,"img") UBB=Convert(ubb,"swf") UBB=AutoURL(ubb) ubb=replace(ubb,"[b]","",1,-1,1) ubb=replace(ubb,"[/b]","",1,-1,1) ubb=replace(ubb,"[i]","",1,-1,1) ubb=replace(ubb,"[/i]","",1,-1,1) ubb=replace(ubb,"[u]","",1,-1,1) ubb=replace(ubb,"[/u]","",1,-1,1) ubb=replace(ubb,"[blue]","",1,-1,1) ubb=replace(ubb,"[/blue]","",1,-1,1) ubb=replace(ubb,"[red]","",1,-1,1) ubb=replace(ubb,"[/red]","",1,-1,1) for i=1 to 28 ubb=replace(ubb,"{:em"&i&"}","

",1,6,1) ubb=replace(ubb,"{:em"&i&"}","",1,-1,1) next ubb=replace(ubb,"["&chr(176),"[",1,-1,1) ubb=replace(ubb,chr(176)&"]","]",1,-1,1) ubb=replace(ubb,"/"&chr(176),"/",1,-1,1) ' ubb=replace(ubb,"{;em","{:em",1,-1,1) end function function Convert(ubb,CovT) cText=ubb startubb=1 do while Covt="url" or Covt="color" or Covt="font" or Covt="size" startubb=instr(startubb,cText,"["&CovT&"=",1) if startubb=0 then exit do endubb=instr(startubb,cText,"]",1) if endubb=0 then exit do Lcovt=Covt startubb=startubb+len(lCovT)+2 text=mid(cText,startubb,endubb-startubb) codetext=replace(text,"[","["&chr(176),1,-1,1) codetext=replace(codetext,"]",chr(176)&"]",1,-1,1) 'codetext=replace(codetext,"{:em","{;em",1,-1,1) codetext=replace(codetext,"/","/"&chr(176),1,-1,1) select case CovT case "color" cText=replace(cText,"[color="&text&"]","",1,1,1) cText=replace(cText,"[/color]","",1,1,1) case "font" cText=replace(cText,"[font="&text&"]","",1,1,1) cText=replace(cText,"[/font]","",1,1,1) case "size" if IsNumeric(text) then if text>6 then text=6 if text<1 then text=1 cText=replace(cText,"[size="&text&"]","",1,1,1) cText=replace(cText,"[/size]","",1,1,1) end if case "url" cText=replace(cText,"[url="&text&"]","",1,1,1) cText=replace(cText,"[/url]","",1,1,1) case "email" cText=replace(cText,"["&CovT&"="&text&"]","",1,1,1) cText=replace(cText,"[/"&CovT&"]","",1,1,1) end select loop startubb=1 do startubb=instr(startubb,cText,"["&CovT&"]",1) if startubb=0 then exit do endubb=instr(startubb,cText,"[/"&CovT&"]",1) if endubb=0 then exit do Lcovt=Covt startubb=startubb+len(lCovT)+2 text=mid(cText,startubb,endubb-startubb) codetext=replace(text,"[","["&chr(176),1,-1,1) codetext=replace(codetext,"]",chr(176)&"]",1,-1,1) 'codetext=replace(codetext,"{:em","{;em",1,-1,1) codetext=replace(codetext,"/","/"&chr(176),1,-1,1) select case CovT case "url" cText=replace(cText,"["&CovT&"]"&text,""&codetext,1,1,1) cText=replace(cText,""&codetext&"[/"&CovT&"]",""&codetext&"",1,1,1) case "email" cText=replace(cText,"["&CovT&"]","",1,1,1) cText=replace(cText,"[/"&CovT&"]","",1,1,1) case "html" codetext=replace(codetext,"
",chr(13),1,-1,1) codetext=replace(codetext," ",chr(32),1,-1,1) Randomize rid="temp"&Int(100000 * Rnd) cText=replace(cText,"[html]"&text,"代码片断如下： ",1,1,1) case "img" cText=replace(cText,"[img]"&text,""&chr(34)&" target=_blank> ::点击图片在新窗口中打开::

",1,1,1) case "code" cText=replace(cText,"[code]"&text,"以下内容为程序代码

"&codetext,1,1,1) cText=replace(cText,"以下内容为程序代码

"&codetext&"[/code]","以下内容为程序代码

"&codetext&"

",1,1,1) case "quote" atext=replace(text,"[img]","",1,-1,1) atext=replace(atext,"[/img]","",1,-1,1) atext=replace(atext,"[swf]","",1,-1,1) atext=replace(atext,"[/swf]","",1,-1,1) atext=replace(atext,"[html]","",1,-1,1) atext=replace(atext,"[/html]","",1,-1,1) ' atext=replace(atext,"{:em","{;em",1,-1,1) atext=SplitWords(atext,350) atext=replace(atext,chr(32)," ",1,-1,1) cText=replace(cText,"[quote]"&text,"

"&atext,1,1,1) cText=replace(cText,"
"&atext&"[/quote]","
"&atext&"
",1,1,1) case "swf" cText=replace(cText,"[swf]"&text,"影片地址:
"&text&"