<%response.buffer=true%> <%Function HtmlEncode(Content) Content = Replace(Content, ">", ">") Content = Replace(Content, "<", "<") Content = Replace(Content, "'", "") HtmlEncode = content End Function Function HtmlEncode2(Content) Content = Replace(Content, ">", ">") Content = Replace(Content, "<", "<") 'Content = Replace(Content, " ", " ") Content = Replace(Content, "'", "") Content = Replace(Content, vbcrlf,"
") HtmlEncode2 = content End Function dim page page = Request.QueryString("page") if isnumeric(page)=false then response.write "" response.end end if if page="" then page=1 page2 = Request.QueryString("k") if isnumeric(page2)=false then response.write "" response.end end if if page2="" then page2=1 On Error Resume Next action = HtmlEncode(Request.QueryString("action")) action_e = Request("action_e") set Conn=Server.CreateObject("ADODB.Connection") Conn.Open "driver={Microsoft Access Driver (*.mdb)};dbq=" & Server.MapPath("db_fm1d7_zz/!fg_asa&#.mdb") dim webtitle,webname,webyn,webgl,webyn2,view2 set rs1 = conn.execute("select * from admin") if rs1("title")<>"" then webtitle=rs1("title") if rs1("webname")<>"" then webname=rs1("webname") if rs1("gbyn")<>"" then webyn=rs1("gbyn") webgl=rs1("gl") rs1.close set rs1=nothing%>

<%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() Case "Edit_web" Call Edit_web() 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 "View_Words1" Call View_Words1() 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() Case "Edit_web" Call Edit_web() End Select%>

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


姓名：	(必填)
性别：	男女
电话或QQ：	(必填)
主页：
地址：
广告邮箱：	(必填)
留言内容：	(必填)

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


<%If Session("Admin")="glok1" Then%> <%End If%> <%If Session("Admin")="glok1" Then%> <%End If%>	<%if len(webtitle)>2 then%> <%=webtitle%> <%end if%>

<%End Sub ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '查看留言 Sub View_Words() '几个ASP语句说明(温故而知新) 'sql="select sum(字段名) as 别名 from 数据表 where 条件表达式" 使用 rs("别名") 得到值 'AVG(字段名) 得出一个表格栏平均值 'COUNT(*|字段名) 对数据行数的统计或对某一栏有值的数据行数统计 'MAX(字段名) 取得一个表格栏最大的值 'MIN(字段名) 取得一个表格栏最小的值 'SUM(字段名) 把数据栏的值相加 ' OleDbDataReader dr = db1.getReader("select top "+n+" * from news where 类别="+strCID+" and (id not in (select top "+n*(page-1)+" id from news where 类别="+strCID+" order by ID DESC)) order by ID DESC"); '''''''''' 使用TOP分页方法 dim gbcount,n,x,y,j,k,db,conn,connstr,view n=25 '每页显示留言数 x=10 '每页显示的页数 view=1 On Error Resume Next db="!fg_asa&#.mdb" set Conn = server.CreateObject("ADODB.Connection") connstr="driver={Microsoft Access Driver (*.mdb)};dbq="& server.MapPath("db_fm1d7/"&db&"") conn.Open connstr set rs = conn.execute("select COUNT(*) as gbcount From words where view="&view&"") gbcount=rs("gbcount") rs.close if gbcount/n = int(gbcount/n) then '计算出分页数 y=int(gbcount/n) else y=int(gbcount/n)+1 end if if (page2)*x > y then '计算出每页显示的页数 k=y else k=(page2)*x end if if page=1 then '判断页数,从而从第几条记录开始读数据 j=" where view="&view&"" else j="where id not in (select top "&n*(page-1)&" id from words Order By id Desc) and view="&view&"" end if ' 在第J条记录之后取得前N条记录 'set rs = conn.execute("select top "&n&" id,name,sex,head,web,email,title,words,date,reply,ip,come,view,qq From words "&j&" Order By id Desc") '打开记录的另一种方式,这种方式效率高,但没有打开记录集,一些功能受限 Set Rs = Server.CreateObject("ADODB.RecordSet") Sql="select top "&n&" * From words "&j&" Order By id Desc" Rs.Open Sql,Conn,1,1 '打开记录集 '传统的分页代码,*********开始 'TotalRecord=Rs.RecordCount '记录总数 'Rs.PageSize = 8 '每页显示的记录数 'PageSize = Rs.PageSize 'PageCount=Rs.PageCount ' 总页数 'if rs.bof and rs.eof then '错误处理 'CM="当前没有留言" 'else 'If page="" Then 'Rs.AbsolutePage = 1 'Else 'Rs.AbsolutePage = page 'End If 'end if ''*************传统的分页代码*****结%> <%if rs.bof and rs.eof then Response.Write "当前没有留言记录"%> <%dim lou,words,reply,email,qq,web,come if Request.QueryString("page")<2 then lou=gbcount else lou=gbcount-((Request.QueryString("page")-1)*n) end if do while not rs.eof reply="" words="" email="" qq="" web="" come="" if rs("email")="" then email=rs("name") & " 没有留下广告邮件" else email=rs("name") & " 的广告邮件是: "&rs("email") end if if rs("web")="" or rs("web")="http://" then web=rs("name") & " 暂时没有主页" else web=rs("name") & " 的主页是: "&rs("web") end if if rs("qq")="" or len(rs("qq"))<4 then qq=rs("name") & " 没有留下QQ号" else qq=rs("name") & " 的QQ号是: "&rs("qq") end if words=rs("words") if rs("reply")<>"" then reply=rs("reply") If Session("Admin") = "glok1" Then theip=Rs("ip") else shuzu=split(Rs("ip"),".") theip=shuzu(0)&"."&shuzu(1)&"."&shuzu(2)&".xxx" end if%>

<%=rs("name")%>

<%=Rs("date")%> <%If Session("Admin") = "glok1" Then%>

" onClick="return confirm('确定要删除吗？\n\n该操作不可恢复！')">

<%end if%>

<%if rs("sex")="1" then%> "" then%>alt="<%=rs("come")%>"<%end if%>> <%else%> <%end if%>

<%if webyn=1 and rs("view")=1 then%> <%=Ubb(unHtml(words))%> <%if reply<>"" then%>

回复： <%=Ubb(unHtml(reply))%> <%end if%> <%end if%> <%if webyn<>1 then%> <%=Ubb(unHtml(words))%> <%if reply<>"" then%>

回复： <%=Ubb(unHtml(reply))%> <%end if%> <%end if%> <%if webyn=1 and rs("view")=0 then%> 恭喜您留言成功，请等待我们的答复。 <%end if%>

<%lou=lou-1 rs.movenext loop Rs.Close Set Rs = Nothing%>

有<%=gbcount%>条留言共<%=y%>页分页 <%if page2>1 then%> 前<%=x%>页 <%end if%> <%For m =((page2)*x)-(x-1) To k%> [<%=m%>] <%Next%> <%if page2*x < y then%> 后<%=x%>页 <%end if%>

<%End Sub%> <%Sub View_Words1() '几个ASP语句说明(温故而知新) 'sql="select sum(字段名) as 别名 from 数据表 where 条件表达式" 使用 rs("别名") 得到值 'AVG(字段名) 得出一个表格栏平均值 'COUNT(*|字段名) 对数据行数的统计或对某一栏有值的数据行数统计 'MAX(字段名) 取得一个表格栏最大的值 'MIN(字段名) 取得一个表格栏最小的值 'SUM(字段名) 把数据栏的值相加 ' OleDbDataReader dr = db1.getReader("select top "+n+" * from news where 类别="+strCID+" and (id not in (select top "+n*(page-1)+" id from news where 类别="+strCID+" order by ID DESC)) order by ID DESC"); '''''''''' 使用TOP分页方法 dim gbcount,n,x,y,j,k,db,conn,connstr,view n=25 '每页显示留言数 x=10 '每页显示的页数 view=0 On Error Resume Next db="!fg_asa&#.mdb" set Conn = server.CreateObject("ADODB.Connection") connstr="driver={Microsoft Access Driver (*.mdb)};dbq="& server.MapPath("db_fm1d7/"&db&"") conn.Open connstr set rs = conn.execute("select COUNT(*) as gbcount From words where view="&view&"") gbcount=rs("gbcount") rs.close if gbcount/n = int(gbcount/n) then '计算出分页数 y=int(gbcount/n) else y=int(gbcount/n)+1 end if if (page2)*x > y then '计算出每页显示的页数 k=y else k=(page2)*x end if if page=1 then '判断页数,从而从第几条记录开始读数据 j=" where view="&view&"" else j="where id not in (select top "&n*(page-1)&" id from words Order By id Desc) and view="&view&"" end if ' 在第J条记录之后取得前N条记录 'set rs = conn.execute("select top "&n&" id,name,sex,head,web,email,title,words,date,reply,ip,come,view,qq From words "&j&" Order By id Desc") '打开记录的另一种方式,这种方式效率高,但没有打开记录集,一些功能受限 Set Rs = Server.CreateObject("ADODB.RecordSet") Sql="select top "&n&" * From words "&j&" Order By id Desc" Rs.Open Sql,Conn,1,1 '打开记录集 '传统的分页代码,*********开始 'TotalRecord=Rs.RecordCount '记录总数 'Rs.PageSize = 8 '每页显示的记录数 'PageSize = Rs.PageSize 'PageCount=Rs.PageCount ' 总页数 'if rs.bof and rs.eof then '错误处理 'CM="当前没有留言" 'else 'If page="" Then 'Rs.AbsolutePage = 1 'Else 'Rs.AbsolutePage = page 'End If 'end if ''*************传统的分页代码*****结%> <%if rs.bof and rs.eof then Response.Write "当前没有留言记录"%> <%dim lou,words,reply,email,qq,web,come if Request.QueryString("page")<2 then lou=gbcount else lou=gbcount-((Request.QueryString("page")-1)*n) end if do while not rs.eof reply="" words="" email="" qq="" web="" come="" if rs("email")="" then email=rs("name") & " 没有留下广告邮件" else email=rs("name") & " 的广告邮件是: "&rs("email") end if if rs("web")="" or rs("web")="http://" then web=rs("name") & " 暂时没有主页" else web=rs("name") & " 的主页是: "&rs("web") end if if rs("qq")="" or len(rs("qq"))<4 then qq=rs("name") & " 没有留下QQ号" else qq=rs("name") & " 的QQ号是: "&rs("qq") end if words=rs("words") if rs("reply")<>"" then reply=rs("reply") If Session("Admin") = "glok1" Then theip=Rs("ip") else shuzu=split(Rs("ip"),".") theip=shuzu(0)&"."&shuzu(1)&"."&shuzu(2)&".xxx" end if%>

<%=rs("name")%>

<%=Rs("date")%> <%If Session("Admin") = "glok1" Then%>

" onClick="return confirm('确定要删除吗？\n\n该操作不可恢复！')">

<%end if%>

<%if rs("sex")="1" then%> "" then%>alt="<%=rs("come")%>"<%end if%>> <%else%> <%end if%>

<%if webyn=1 and rs("view")=1 then%> <%=Ubb(unHtml(words))%> <%if reply<>"" then%>

回复： <%=Ubb(unHtml(reply))%> <%end if%> <%end if%> <%if webyn<>1 then%> <%=Ubb(unHtml(words))%> <%if reply<>"" then%>

回复： <%=Ubb(unHtml(reply))%> <%end if%> <%end if%> <%if webyn=1 and rs("view")=0 then%> 恭喜您留言成功，请等待我们的答复。 <%end if%>

<%lou=lou-1 rs.movenext loop Rs.Close Set Rs = Nothing%>

有<%=gbcount%>条留言共<%=y%>页分页 <%if page2>1 then%> 前<%=x%>页 <%end if%> <%For m =((page2)*x)-(x-1) To k%> [<%=m%>] <%Next%> <%if page2*x < y then%> 后<%=x%>页 <%end if%>

<%End Sub%> <%''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '管理员登陆接口%> <%Sub Admin_Login()%> <% if Session("Admin") = "glok1" then response.redirect"gbook.asp" end if %>

管理员登陆
用户名：
密码：

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

<%End Sub%>

<%Sub EditPWD()%>

修改管理信息
旧用户名：
新用户名：
确认新用户名：
旧密码：
新密码：
确认新密码：

<%End Sub%> <%Sub Edit()%> <%theid=Request.QueryString("id") if isnumeric(theid)=false then response.write "" response.end end if dim db,conn,connstr On Error Resume Next db="!fg_asa&#.mdb" set Conn = server.CreateObject("ADODB.Connection") connstr="driver={Microsoft Access Driver (*.mdb)};dbq="& server.MapPath("db_fm1d7/"&db&"") conn.Open connstr Set Rs = Server.CreateObject("ADODB.RecordSet") Sql="Select * From words Where id="&theid Rs.Open Sql,Conn,1,1 view2="" if rs("view")=1 then view2="checked" end if%>

修改留言内容及回复留言者资料 <%If Rs("sex")=1 Then Response.Write "" Else Response.Write " " End If%> " width="19" height="16" border="0"> ">" width="17" height="16" border="0"> " target="_blank">" width="16" height="16" border="0"> 来自:<%=Rs("come")%>" width="16" height="16">
留言内容：	<%if Rs("words")<>"" then%><%=replace(Rs("words"),"<br>",vbcrlf)%><%end if%>
回复：	<%if Rs("reply")<>"" then%><%=replace(Rs("reply"),"<br>",vbcrlf)%><%end if%> 通过审批:> 未审批:
">

<%End Sub%>
<%Sub Edit_web()%> <%If Session("Admin")="" Then Response.Write "连接超时,请重新登录" Response.End end if if HtmlEncode(Request.Form("submit"))="修改" then dim db,conn,connstr On Error Resume Next db="!fg_asa&#.mdb" set Conn = server.CreateObject("ADODB.Connection") connstr="driver={Microsoft Access Driver (*.mdb)};dbq="& server.MapPath("db_fm1d7/"&db&"") conn.Open connstr Set Rs = Server.CreateObject("ADODB.RecordSet") Sql="Select * From admin" Rs.Open Sql,Conn,2,3 rs("title")=HtmlEncode(Request.Form("webtitle")) rs("gl")=HtmlEncode(Request.Form("webggg")) rs("gbyn")=cint(HtmlEncode(Request.Form("webyn"))) rs("webname")=HtmlEncode(Request.Form("webname")) rs.update 'if rs("title")<>"" then webtitle=rs("title") 'if rs("webname")<>"" then webname=rs("webname") 'if rs("gbyn")<>"" then webyn=rs("gbyn") 'if rs("words")<>"" then webgg=rs("words") rs.close set rs=nothing response.redirect"gbook.asp?action=Edit_web" response.end end if webyn2="" if webyn=1 then webyn2="checked" end if%>

修改留言板属性
留言板名称：
公告内容：
词语过滤：	用"\|"分隔过滤的词,例：月亮\|星星
经过审批才显示留言：	> 是

<%End Sub%> <%Sub Add_New_Execute() If HtmlEncode(trim(Request.Form("name")))="" Then Response.Write "" Response.End End If If Len(HtmlEncode(trim(Request.Form("name"))))>20 Then Response.Write "" Response.End End If If HtmlEncode(trim(Request.Form("qq")))="" Then Response.Write "" Response.End End If If HtmlEncode(trim(Request.Form("email")))<>"" Then If instr(HtmlEncode(trim(Request.Form("email"))),"@")=0 or instr(HtmlEncode(trim(Request.Form("email"))),".")=0 or instr(HtmlEncode(trim(Request.Form("email"))),"@")=1 or instr(HtmlEncode(trim(Request.Form("email"))),"@")=len(email) then Response.Write "" Response.End End If End If If HtmlEncode2(Request.Form("words"))="" Then Response.Write "" Response.End End If If len(HtmlEncode2(Request.Form("words")))>500 Then Response.Write "" Response.End End If dim db,conn,connstr On Error Resume Next db="!fg_asa&#.mdb" set Conn = server.CreateObject("ADODB.Connection") connstr="driver={Microsoft Access Driver (*.mdb)};dbq="& server.MapPath("db_fm1d7/"&db&"") conn.Open connstr Set Rs = Server.CreateObject("ADODB.RecordSet") Sql="Select * From words" Rs.Open Sql,Conn,2,3 Rs.AddNew Rs("name")=HtmlEncode(trim(Request.Form("name"))) Rs("sex")=HtmlEncode(trim(Request.Form("sex"))) Rs("head")=HtmlEncode(trim(Request.Form("head"))) Rs("web")=HtmlEncode(trim(Request.Form("web"))) Rs("email")=HtmlEncode(trim(Request.Form("email"))) Rs("words")=HtmlEncode2(Request.Form("words")) Rs("qq")=HtmlEncode(trim(Request.Form("qq"))) Rs("head")=HtmlEncode(trim(Request.Form("Image"))) Rs("date")=Now() Rs("ip")=request.servervariables("remote_addr") Rs("come")=HtmlEncode(trim(Request.Form("come"))) Rs.Update Rs.Close Set Rs = Nothing End Sub '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '验证管理员登陆 Sub Admin_Login_Execute() username = Request("username") password = Request("password") If username = "" OR password = "" Then Response.Write "用户名或者密码为空" else dim db,conn,connstr On Error Resume Next db="!fg_asa&#.mdb" set Conn = server.CreateObject("ADODB.Connection") connstr="driver={Microsoft Access Driver (*.mdb)};dbq="& server.MapPath("db_fm1d7/"&db&"") conn.Open connstr Sql="Select * From admin" set rs=server.createobject("adodb.recordset") rs.open sql,conn,1,1 if not rs.eof then if md5(password)=rs("password") and username=rs("username") then Session("Admin") = "glok1" response.redirect "gbook.asp" else Response.Write "用户名或者密码错误" rs.close set rs=nothing conn.close set conn=nothing end if end if end if End Sub Sub EditPWD_Execute() If Session("Admin")="" Then Response.Write "连接超时,请重新登录" Response.End end if oldusername=HtmlEncode(trim(Request.Form("oldusername"))) username = HtmlEncode(trim(Request.Form("username"))) username_c = HtmlEncode(trim(Request.Form("username_c"))) oldpwd = HtmlEncode(trim(Request.Form("oldpwd"))) newpwd = HtmlEncode(trim(Request.Form("newpwd"))) newpwd_c = HtmlEncode(trim(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 dim db,conn,connstr On Error Resume Next db="!fg_asa&#.mdb" set Conn = server.CreateObject("ADODB.Connection") connstr="driver={Microsoft Access Driver (*.mdb)};dbq="& server.MapPath("db_fm1d7/"&db&"") conn.Open connstr Set Rs = Server.CreateObject("ADODB.RecordSet") Sql="Select * From admin" Rs.Open Sql,Conn,2,3 If Rs("password")=md5(oldpwd) And Rs("username")=oldusername Then Rs("username")=username Rs("password")=md5(newpwd) Rs.Update Else Response.Write "你的旧密码填写不对或者旧用户名不对，修改不成功" Response.End End If Rs.Close Set Rs = Nothing End Sub Sub Exit_Admin() Session.Abandon response.redirect"gbook.asp" End Sub ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '删除数据 Sub Delete() If Session("Admin")="" Then Response.Write "连接超时,请重新登录" Response.End end if '删除数据 theid=Request.QueryString("id") if isnumeric(theid)=false then response.write "" response.end end if dim db,conn,connstr On Error Resume Next db="!fg_asa&#.mdb" set Conn = server.CreateObject("ADODB.Connection") connstr="driver={Microsoft Access Driver (*.mdb)};dbq="& server.MapPath("db_fm1d7/"&db&"") conn.Open connstr Conn.Execute("Delete * From words Where id="&theid) End Sub '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '回复留言添加到数据库 Sub Reply_Execute() If Session("Admin")="" Then Response.Write "连接超时,请重新登录" Response.End end if theid=Request.Form("id") if isnumeric(theid)=false then response.write "" response.end end if dim db,conn,connstr On Error Resume Next db="!fg_asa&#.mdb" set Conn = server.CreateObject("ADODB.Connection") connstr="driver={Microsoft Access Driver (*.mdb)};dbq="& server.MapPath("db_fm1d7/"&db&"") conn.Open connstr Set Rs = Server.CreateObject("ADODB.RecordSet") Sql="Select reply From words Where id="&theid Rs.Open Sql,Conn,2,3 Rs("reply") = HtmlEncode(trim(Request.Form("reply"))) Rs.Update Rs.Close Set Rs=Nothing End Sub Sub Edit_Execute() If Session("Admin")="" Then Response.Write "连接超时,请重新登录" Response.End end if theid=Request.Form("id") if isnumeric(theid)=false then response.write "" response.end end if dim db,conn,connstr On Error Resume Next db="!fg_asa&#.mdb" set Conn = server.CreateObject("ADODB.Connection") connstr="driver={Microsoft Access Driver (*.mdb)};dbq="& server.MapPath("db_fm1d7/"&db&"") conn.Open connstr Set Rs = Server.CreateObject("ADODB.RecordSet") Sql="Select * From words Where id="&theid Rs.Open Sql,Conn,2,3 Rs("words") = HtmlEncode2(Request.Form("words")) Rs("reply") = HtmlEncode2(Request.Form("reply")) if cint(HtmlEncode(trim(Request.Form("view"))))=1 then Rs("view")=1 else Rs("view")=0 end if 'Rs("name")=HtmlEncode(trim(Request.Form("name"))) 'Rs("sex")=HtmlEncode(trim(Request.Form("sex"))) 'Rs("head")=HtmlEncode(trim(Request.Form("head"))) 'Rs("web")=HtmlEncode(trim(Request.Form("web"))) 'Rs("email")=HtmlEncode(trim(Request.Form("email"))) 'Rs("qq")=HtmlEncode(trim(Request.Form("qq"))) 'Rs("head")=HtmlEncode(trim(Request.Form("Image"))) 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)," ") '使用数组返回值数组 = Split("字符串","分割符") 'IsArray()判断是否数组的函数,LBound()取数组的下标,UBound()取数组的上标。 unhtmlgl=split(webgl,"|") if IsArray(unhtmlgl) then for i=0 to UBound(unhtmlgl) unhtml=replace(unhtml,unhtmlgl(i),"***") next end if '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=convert(ubb,"cen") ubb=convert(ubb,"rig") ubb=convert(ubb,"lef") ubb=convert(ubb,"center") 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 "center" cText=replace(cText,"[center]","

",1,1,1) cText=replace(cText,"[/center]","

",1,1,1) 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 "cen" '图片居中 cText=replace(cText,"[cen]"&text,"

"&chr(34)&" target=_blank> ::点击图片在新窗口中打开::

",1,1,1) case "rig" '图片居右,文字绕排 cText=replace(cText,"[rig]"&text,""&chr(34)&" target=_blank> ::点击图片在新窗口中打开::

",1,1,1) case "lef" '图片居左,文字绕排 cText=replace(cText,"[lef]"&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,"[cen]","",1,-1,1) atext=replace(text,"[/cen]","",1,-1,1) 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,"