>
<%
'主程序
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 "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()
case "manageusr"
call manageusr()
End Select
%>
HELP
<% If Session("Admin")="Login" Then %>
退出管理
<% Else %>
管理留言
<% End If %>
<% If Session("Admin")="Login" and session("flag")<1 Then %>
基本設置
<%end if%>
<% If Session("Admin")="Login" and session("flag")<1 Then %>
用戶管理
<%end if%>
<%if session("admin")="Login" then%>
修改密碼
<% End If %>
<% End Sub
'''''''''''''''''''''''
'查看留言
Sub View_Words()
dim gbcount,y,j,k
set rs = conn.execute("select COUNT(*) as gbcount From words")
gbcount=rs("gbcount")
rs.close
if gbcount/n = int(gbcount/n) then '計算出分頁數
y=int(gbcount/n)
else
y=int(gbcount/n)+1
end if
page2= int(page/x)
if page/x>page2 then page2=page2+1
k=page2*x
if k>y then k=y
'打開留言字段'
if page=1 then
sql="select top "&n&" id,name,sex,head,web,email,title,words,date,reply,ip,come,view,qq From words Order By id Desc"
else
sql="select id,name,sex,head,web,email,title,words,date,reply,ip,come,view,qq From words Order By id Desc"
end if
if Page >100 then
rs.Open sql,Conn,1
else
Set Rs=Conn.Execute(sql)
end if
if Page>1 then RS.Move n*page-n
%>
有<%=gbcount %>則留言 <%=page %>/<%=y %>頁 分頁
<<
<% if page2>1 then %>
<
<% end if %>
<% For m =page2*x-(x-1) To k %>
[<%=m%>]
<%
Next
%>
<% if page2*x < y then %>
>
<% end if %>
>>
<% if len(webtitle)>2 then %>
<% 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
i=0
do while not rs.eof and i
<% if webyn=0 and rs("view")=0 and session("admin")="" then %><% else%>
留言者:<%=rs("name")%>
發表於:<%=year(Rs("date"))%>年<%=month(Rs("date"))%>月<%=day(Rs("date"))%>日
<% if len(trim(rs("web")))>8 then %>
<% end if %>
<% if len(trim(rs("email")))>6 then %>
EMAIL:<%=rs("email")%>
<% end if %>
<% if len(trim(Rs("come")))>1 then %>
來自:<%=rs("come")%>
<% end if %>
<% If Session("Admin") = "Login" and session("flag")<1 Then %> ">">
<% end if %>
<% if webyn=0 and rs("view")=0 and session("admin")="" then%>
留言需要經過審批才能查看
<%elseif webyn=1 then%>
<%=Ubb(unHtml(words))%>
<% if len(trim(reply))>1 then%>
站長回復
<%=Ubb(unHtml(reply))%>
<%end if %>
<%elseif session("admin")<>"" then%>
<%=Ubb(unHtml(words))%>
<% if len(trim(reply))>1 then%>
站長回復
<%=Ubb(unHtml(reply))%>
<%end if %>
<%end if %>
<% end if%>
<%
lou=lou-1
rs.movenext
loop
Rs.Close
Set Rs = Nothing
%>
有<%=gbcount %>則留言 <%=page %>/<%=y %>頁 分頁
<<
<% if page2>1 then %>
<
<% end if %>
<% For m =page2*x-(x-1) To k %>
[<%=m%>]
<%
Next
%>
<% if page2*x < y then %>
>
<% end if %>
>>
<% End Sub %>
<%
'''''''''管理員登陸接口
%>
<% Sub Admin_Login()
dim num1
dim rndnum
Randomize
Do While Len(rndnum)<4
num1=CStr(Chr((57-48)*rnd+48))
rndnum=rndnum&num1
loop
session("jd100_rn")=rndnum
%>
<% End Sub%>
<%
'''''''''''
%>
<%Sub UbbHelp()%>
功能幫助
[img]
這裡填寫圖片的絕對地址如 http://www.y-hui.com.tw/aaa.jpg
[/img]
[url]
這裡填寫連接地址 http://www.y-hui.com.tw/
[/url]
[swf]
這裡填寫SWF文件的地址 http://www.y-hui.com.tw/yanshi.swf
[/swf]
[email]
這裡填寫電子信箱地址 yihui.com@gmail.com
[/email]
[color=顏色]
這裡填寫要著色的文字
[/color]
[size=大小]
這裡填寫要加大的文字
[/size]
[font=字體]
這裡填寫要改變字體的文字
[/font]
<%End Sub%>
<%Sub EditPWD()%>
<%
If Session("Admin")="" Then
Response.Write "連接超時,請重新登錄"
Response.End
end if
%>
<%End Sub%>
<% Sub Edit() %>
<%
Sql="Select * From words Where id="&Request.QueryString("id")
set rs=conn.execute(sql)
view2=""
if rs("view")=1 then
view2="checked"
end if
%>
<%
rs.close
set rs=nothing
End Sub %>
<% Sub Edit_web() %>
<%
if Request.Form("submit")="修改" then
Set Rs = Server.CreateObject("ADODB.RecordSet")
Sql="Select * From admin"
Rs.Open Sql,Conn,2,3
rs("title")=Request.Form("webtitle")
rs("gl")=Request.Form("webggg")
rs("gbyn")=cint(Request.Form("webyn"))
rs("webname")=Request.Form("webname")
rs.update
rs.close
set rs=nothing
response.redirect indexfilename &"?action=Edit_web"
response.end
end if
webyn2=""
if webyn=1 then
webyn2="checked"
end if
%>
<% End Sub %>
<%Sub manageusr()%>
後台管理員設置
管理員
密 碼
權 限
操 作
<%set rs=server.CreateObject("adodb.recordset")
rs.Open "select * from admin order by flag asc",conn,1,1
do while not rs.EOF%>
<%rs.movenext
loop
rs.close
set rs=nothing
%>
添加管理員
管理員
密 碼
權 限
操 作
<%End Sub%>
<% if jd100_fla=1 then
if Request("action")="View_Words" or Request("action")="" then %>
<% End if
end if
%>
<% sub ubb_jd100()%>
字體大小
顏色：
<% end sub %><%
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'添加新留言到數據庫
Sub Add_New_Execute()
'不良詞語過濾
If trim(Request.Form("name"))="" Then
Response.Write("")
Response.End
End If
If Len(Request.Form("name"))>20 Then
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.End
End If
End If
If trim(Request.Form("words"))="" Then
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("words")=Server.HTMLEncode(Request.Form("words"))
Rs("qq")=Server.HTMLEncode(Request.Form("qq"))
Rs("head")=Server.HTMLEncode(Request.Form("Img"))
Rs("date")=Now()
Rs("ip")=request.servervariables("remote_addr")
Rs("come")=Server.HTMLEncode(Request.Form("come"))
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 trim(Server.HTMLEncode(Request.Form("jd100rz")))<>session("jd100_rn") then
Response.Write("")
Response.End
end if
session("jd100_rn")=""
If username = "" OR password = "" Then
Response.Write("")
Response.End
End If
Set Rs = Server.CreateObject("ADODB.RecordSet")
Sql="Select * From admin where username='"&username&"' and password='"&password&"'"
Rs.Open Sql,Conn,1,1
If not rs.eof Then
Session("Admin") = "Login"
Else
Response.Write("")
End If
Rs.Close
Set Rs = Nothing
End Sub
Sub EditPWD_Execute()
If Session("Admin")="" Then
Response.Write "連接超時,請重新登錄"
Response.End
end if
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 indexfilename
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'刪除數據
Sub Delete()
If Session("Admin")="" Then
Response.Write "連接超時,請重新登錄"
Response.End
end if
'刪除數據
Conn.Execute("Delete * From words Where id="&Request.QueryString("id"))
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'回復留言添加到數據庫
Sub Reply_Execute()
If Session("Admin")="" Then
Response.Write "連接超時,請重新登錄"
Response.End
end if
Set Rs = Server.CreateObject("ADODB.RecordSet")
Sql="Select reply From words Where id="&Request.Form("id")
Rs.Open Sql,Conn,2,3
Rs("reply") = Server.HTMLEncode(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
Set Rs = Server.CreateObject("ADODB.RecordSet")
Sql="Select * From words Where id="&Request.Form("id")
Rs.Open Sql,Conn,2,3
if cint(Request.Form("replyedit"))=1 then
Rs("words") = Server.HTMLEncode(Request.Form("reply"))
end if
Rs("reply") = Server.HTMLEncode(Request.Form("words"))
if cint(Request.Form("view"))=1 then
Rs("view")=1
else
Rs("view")=0
end if
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)," ")
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]","
億輝工程有限公司留言板
字體大小
顏色：
![](emot/emotface/em"&i&".gif)
",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]","
EMAIL:<%=rs("email")%>
<% end if %>
<% if len(trim(Rs("come")))>1 then %>
來自:<%=rs("come")%>
<% end if %>
<% If Session("Admin") = "Login" and session("flag")<1 Then %> 
