<% dim page,action,action_e action = Request.QueryString("action") action_e = Request("action_e") hx_Inf = split(hx_In,"|") If Request.Form<>"" Then For Each hx_Post In Request.Form For hx_Xh=0 To Ubound(hx_Inf) If Instr(LCase(Request.Form(hx_Post)),hx_Inf(hx_Xh))<>0 Then Response.Write "" Response.End End If Next Next End If Select Case action_e Case "" Case "Add_New" Call Add_New_Execute() Response.write "" Response.End Case "Edit" if session("adminlogin")<>sessionvar then Response.write "" Response.End else Call Edit_Execute() Response.write "" Response.End end if End Select Sub Main_Menu() Response.Write " ·在线留言 ·查看留言 " End Sub '================================================= '过程名：content_book '作用：显示留言相关操作内容 '参数：无 'Web: # '================================================= sub content_book() Select Case action Case "" Call Add_New() Case "Add_New" Call Add_New() Case "Edit" Call Edit() Case "View_Words" Call View_Words() Case "Delete" if session("adminlogin")<>sessionvar then Response.write "" Response.End else Call Delete() Response.write "" end if End Select End Sub '================================================= '过程名：Add_New_Execute '作用：留言发表 '参数：无 'Web: # '================================================= Sub Add_New_Execute() server_v1=Cstr(Request.ServerVariables("HTTP_REFERER")) server_v2=Cstr(Request.ServerVariables("SERVER_NAME")) if mid(server_v1,8,len(server_v2))<>server_v2 then Response.Write("") response.end end if If Request.Form("zt")="" Then Response.Write "" Response.End End If If Len(Request.Form("zt"))>200 Then Response.Write "" Response.End End If If Request.Form("name")="" Then Response.Write "" Response.End End If If Len(Request.Form("name"))>12 Then Response.Write "" Response.End End If If Request.Form("qq")="" Then Response.Write "" Response.End End If If Request.Form("words")="" Then Response.Write "" Response.End End If If Request.Form("words")<>"" Then If Len(Request.Form("words"))<4 or Len(Request.Form("words"))>500 then Response.Write "" Response.End End If End If checkInfo=Cstr(request.Form("VerifyCode")) CodeInfo=Cstr(Session("GetCode")) if checkInfo<>CodeInfo then Response.Write "" response.End() elseif checkInfo="" then Response.Write "" response.End() else Set Rs = Server.CreateObject("ADODB.RecordSet") Sql="Select * From words" Rs.Open Sql,Conn,2,3 Rs.AddNew if Request.Form("name")=webceo then Rs("name")=noceo elseif Request.Form("name")=ceopass then Rs("name")=webceo else Rs("name")=CheckStr(Jencode(Request.Form("name"))) End If Rs("zt")=CheckStr(Request.Form("zt")) Rs("sex")=CheckStr(Request.Form("sex")) Rs("qq")=CheckStr(Request.Form("qq")) Rs("email")=CheckStr(Request.Form("email")) Rs("admin")=2 Rs("title")=CheckStr(Request.Form("title")) Rs("words")=CheckStr(Jencode(Request.Form("words"))) Rs("web")=CheckStr(Request.Form("web")) Rs("date")=Now() Rs("ip")=request.servervariables("remote_addr") Rs.Update Rs.Close Session("GetCode")="" Set Rs = Nothing end if End Sub '================================================= '过程名：Edit_Execute '作用：留言编辑 '参数：无 'Web: # '================================================= Sub Edit_Execute() Set Rs = Server.CreateObject("ADODB.RecordSet") Sql="Select * From words Where id="&int(Request.Form("id")) Rs.Open Sql,Conn,2,3 Rs("zt") = CheckStr(Request.Form("zt")) Rs("words") = CheckStr(Request.Form("words")) Rs("reply") = CheckStr(Request.Form("reply")) Rs("admin") = CheckStr(Request.Form("admin")) Rs("redate") = Now() Rs.Update Rs.Close Set Rs=Nothing End Sub '================================================= '过程名：Delete '作用：留言删除 '参数：无 'Web: # '================================================= Sub Delete() Conn.Execute("Delete * From words Where id="&int(Request.QueryString("id"))) End Sub '================================================= '过程名：Add_New '作用：留言发表处理表单 '参数：无 'Web: # '================================================= Sub Add_New() Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf 'Response.Write "" & vbCrLf 'Response.Write "" & vbCrLf 'Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf 'if bookpass<>"yes" then 'Response.Write "" & vbCrLf 'Response.Write "" & vbCrLf 'Response.Write "" & vbCrLf 'Response.Write "" & vbCrLf 'End If Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "

谢谢你的留言,我们公司会尽快回复你的!
您的姓名：	*
您的性别：	先生女士
联系电话：	*
电子邮箱：
通讯地址：
留言主题：
类型选择：	留言建议" & vbCrLf 'Response.Write "" & vbCrLf 'Response.Write " 报错合作" & vbCrLf 'Response.Write "" & vbCrLf 'Response.Write "其它
详细内容： 0≤255	" & vbCrLf Response.Write "" & vbCrLf Response.Write "
是否隐藏：	" & vbCrLf 'Response.Write " 否是
认证码：	" & vbCrLf Response.Write "
	" Response.Write " " & vbCrLf Response.Write "

" & vbCrLf End Sub '================================================= '过程名：Edit '作用：留言编辑处理表单 '参数：无 'Web: # '================================================= Sub Edit() if session("adminlogin")<>sessionvar then Response.write "" end if Set Rs = Server.CreateObject("ADODB.RecordSet") Sql="Select * From words Where id="&int(Request.QueryString("id")) Rs.Open Sql,Conn,1,1 Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write " " & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write " " & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write " " & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "

编辑、回复来客信息

留言主题：

来客、会员内容

管理员回复内容

是否隐藏：" & vbCrLf Response.Write " 否" & vbCrLf Response.Write " 是" Response.Write " 待审核" Response.Write " * 选择隐藏后,此信息只有管理员可以看到。

" & vbCrLf Response.Write "" & vbCrLf Response.Write "

" & vbCrLf End Sub '================================================= '过程名：View_Words '作用：显示带分页功能留言列表 '参数：无 'Web: # '================================================= Sub View_Words() Dim CurPage,Url_Add Url_Add="?action=View_Words&" If Request.QueryString("Page")<>"" Then Curpage=Request.QueryString("Page") If IsInteger(Curpage)=False Then Curpage=1 Else Curpage=1 End If if request("keyword")<>"" then if instr(request("keyword"),"'")>0 then Response.Write "" response.end end if end if Set Rs = Server.CreateObject("ADODB.RecordSet") if request("keyword")<>"" and (request("select")="words" or request("select")="name" or request("select")="reply") then sql="select * from words where "&request("select")&" like '%"&Jencode(checkspace(request("keyword")))&"%'order by id DESC" Url_Add=Url_Add&"select="&request("select")&"&keyword="&Server.URLEncode(request("keyword"))&"&" else Sql="Select * From words where admin<>2 Order By id Desc" end if Rs.Open Sql,Conn,1,1 Response.Write "" & vbCrLf if not rs.eof then Dim Hx_Nums,MultiPages,i Hxperpage=4 Rs.PageSize=Hxperpage Rs.AbsolutePage=CurPage Hx_Nums=Rs.RecordCount MultiPages="" Do Until Rs.EOF OR i=Hxperpage NO=Hx_Nums-i-(Hxperpage*Curpage)+Hxperpage Response.Write "" Response.Write "" Response.Write "" Response.Write "" i=i+1 rs.movenext loop else if rs.eof and rs.bof then Response.Write "" end if end if if Hx_Nums>Hxperpage then Response.Write(MultiPages) end if Response.Write "

"&MultiPage(Hx_Nums,Hxperpage,CurPage,Url_Add)&"

" Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "" & vbCrLf Response.Write "

"&Rs("name")&"

" & vbCrLf if Rs("sex")="1" then Response.Write "

" & vbCrLf elseif Rs("sex")="2" then Response.Write "

" & vbCrLf End If Response.Write "

" & vbCrLf Response.Write "

" 'Response.Write "" 'Response.Write "" 'Response.Write "" 'Response.Write "

"&Rs("zt")&" "&Rs("date")&"

" 'If session("adminlogin")=sessionvar Then 'Response.Write "

" 'End if 'Response.Write "

" Response.Write "

" Response.Write "" Response.Write "" If Rs("reply")<>"" Then Response.Write "" Response.Write "" End If Response.Write "

" If Rs("admin")="0" Then Response.Write "

"&Ubb(unHtml(Rs("words")))&"" elseif session("adminlogin")=sessionvar Then Response.Write "─────≡ 以下为管理员可见内容 ≡─────" elseIf Rs("admin")="1" Then Response.Write "─────≡ 秘密信息！管理员可见 ≡─────" else Response.Write "─────≡ 待审核信息 ≡─────" End If Response.Write "

站长回复："&Ubb(unHtml(Rs("reply")))&"("&year(rs("redate"))&"-"&month(rs("redate"))&"-"&day(rs("redate"))&")

" if request("keyword")<>"" then Response.Write "没有找到包含["&request("keyword")&"]的信息！" else Response.Write "没有任何信息！" end if Response.Write "

" & vbCrLf rs.close set rs=nothing end sub '================================================= '过程名：search_book '作用：显示留言搜索表单 '参数：无 'Web: # '================================================= sub search_book() Response.Write "" & vbCrLf end sub %> <% '================================================= '过程名：unHtml,ubb,isInteger,Convert,AutoURL '作用：留言UBB处理 '参数：无 'Web: # '================================================= function unHtml(content) unHtml=content if content <> "" then unHtml=replace(unHtml,"<","<") unHtml=replace(unHtml,">",">") unHtml=replace(unHtml,chr(34),""") unHtml=replace(unHtml,chr(13),"
") unHtml=replace(unHtml,chr(32)," ") 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) 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,"/","/"&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,"/","/"&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=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&"