<% Dvbbs.LoadTemplates("") Dvbbs.ErrType = 1 '转到不显示顶部和导航的错误显示页 Dvbbs.Head() If Not (Dvbbs.master Or Dvbbs.GroupSetting(70)="1") Then Dvbbs.AddErrcode(28) Dvbbs.ShowErr() End If Dim action Dim G_CurrentFolder,G_Msg G_CurrentFolder = "Plus_popwan/DefaultInput/post/" action = Request("action") info() Select Case action Case "add" : add() Case "edit" : edit() Case "save" : save() Case "del" : del() Case "demo" : demo() Case Else Call main() End Select Dvbbs.ActiveOnline() Dvbbs.Footer() Dvbbs.PageEnd() Sub info() %>
导航:添加模板 | 模板列表

<% End Sub Sub add() %>
新建模板
文件名 *格式:英文+数字+下划线 如:abc_123
主题标题
主题内容
 
<% End Sub Sub edit() Dim f_name,Content f_name = Replace(Request("f_name"),".html","") If IsSafeParam(f_name,"^[a-zA-Z0-9_]+$") Then Content = Dvbbs.ReadTextFile(G_CurrentFolder&f_name&".html") Response.Write "
"&Content&"
" & vbNewLine %>
编辑模板:<%=f_name%>
文件名 *格式:英文+数字+下划线 如:abc_123
主题标题
主题内容
 
<% Else G_Msg = "传递过来的参数不规范。无法读取模板文件。" Response.Redirect "showerr.asp?ErrCodes=
  • "& G_Msg &"&action=NoHeadErr" Exit Sub End If End Sub Sub save() Dim demo,demo_head,demo_content,demo_foot demo_head = "" & vbNewLine demo_head = demo_head & "" & vbNewLine demo_head = demo_head & "" & vbNewLine demo_head = demo_head & "" & vbNewLine demo_head = demo_head & "demo" & vbNewLine demo_head = demo_head & "" & vbNewLine demo_head = demo_head & "" & vbNewLine demo_head = demo_head & "" & vbNewLine demo_head = demo_head & "" & vbNewLine demo_head = demo_head & "
    " & vbNewLine demo_content = demo_content & "
    "& Request("topic") &"
    " & vbNewLine demo_content = demo_content & "
    "& Dvbbs.TextEnCode(Request("body")) &"
    " & vbNewLine demo_foot = "
    " & vbNewLine demo_foot = demo_foot & "" & vbNewLine demo_foot = demo_foot & "" demo = demo_head & demo_content & demo_foot savetofile demo End Sub Sub savetofile(content) Dim sLabelName, sLabelOldName, act act = Request("act") sLabelName=Replace(request("f_name"),".html","") sLabelOldName=Replace(request("f_oldname"),".html","") G_Msg="" If IsSafeParam(sLabelName,"^[a-zA-Z0-9_]+$") Then If act="add" Then If FileIsExist(G_CurrentFolder&sLabelName&".html") Then G_Msg="该模板名已存在,请修改模板名后重新提交。" Else If sLabelOldName<>"" And sLabelOldName<>sLabelName Then If FileIsExist(G_CurrentFolder&sLabelName&".html") Then G_Msg="您试图修改模板名,但是该模板名已存在,请修改后重新提交。" Else If Not FileReName(G_CurrentFolder&sLabelOldName&".html", sLabelName&".html") Then G_Msg="您试图修改模板名,但是没有成功。可能是权限不够。" End If End If End If End If If ""=G_Msg Then On Error Resume Next Dvbbs.WriteToFile G_CurrentFolder&sLabelName&".html", Content If Err Then Err.Description Response.End Err.Clear G_Msg="模板保存失败。可能您的文件夹(Plus_popwan/DefaultInput/post)及其子目录没有写入和修改权限。" Else G_Msg="恭喜,模板保存成功!" End If Dvbbs.Dvbbs_suc(G_Msg) Else Response.Redirect "showerr.asp?ErrCodes=
  • "& G_Msg &"&action=NoHeadErr" Exit Sub End If Else G_Msg="模板名不规范。模板名只能由字母、数字和下划线组成。请修改后重新提交。" Response.Redirect "showerr.asp?ErrCodes=
  • "& G_Msg &"&action=NoHeadErr" Exit Sub End If End Sub Sub main() ListLabelFolder(G_CurrentFolder) End Sub Sub ListLabelFolder(sLabelPath) Dim Fso, Folder, File, G_i Set Fso = CreateFSO() sLabelPath = Server.MapPath(sLabelPath) Set Folder = Fso.GetFolder(sLabelPath) %> <% For Each File In Folder.Files G_i = G_i + 1 response.write "" & vbNewLine Response.Write "" & vbNewLine Next Set File = Nothing Set Fso = Nothing If 0=G_i Then response.write "" End If %>
    模板列表
    " & File.name & "填写 | 编辑 | 删除
    暂未添加!
    <% End Sub '删除文件 Sub del() Dim Fso, sLabelName, sRealPath sLabelName=Replace(request("f_name"),".html","") If IsSafeParam(sLabelName,"^[a-zA-Z0-9_]+$") Then On Error Resume Next sRealPath=Server.MapPath(G_CurrentFolder&sLabelName&".html") Set Fso=CreateFSO() If Fso.FileExists(sRealPath) Then Fso.DeleteFile sRealPath,True If Err Then Err.Clear G_Msg="在删除文件时发生错误,可能是没有足够的权限。请到空间上手动删除此文件。" Else G_Msg="成功删除文件:"&sLabelName&"" End If Else G_Msg="文件没有找到。可能已经被删除,或者没有足够的权限。" End If Set Fso=Nothing Else G_Msg = "传递过来的路径因为安全原因被禁止。请到空间上手动删除该文件。" Response.Redirect "showerr.asp?ErrCodes=
  • "& G_Msg &"&action=NoHeadErr" Exit Sub End If Dvbbs.Dvbbs_suc(G_Msg) End Sub Function CreateFSO() On Error Resume Next Set CreateFSO = Dvbbs.iCreateObject("Scripting.FileSystemObject") If Err Then Err.Clear response.write "您的空间不支持FSO,或者FSO对象名由于安全原因被更改过,请与空间商联系!" response.End End If End Function Function FileIsExist(Path) Dim Fso:FileIsExist=False On Error Resume Next Set Fso=CreateFSO() If Fso.FileExists(Server.MapPath(Path)) Then FileIsExist=True Set Fso=Nothing End Function Function FileReName(Path,NewName) Dim Fso,File FileReName=False On Error Resume Next Set Fso=CreateFSO() Set File=Fso.GetFile(Server.MapPath(Path)) File.name=NewName Set File=Nothing Set Fso=Nothing FileReName=True End Function Function IsSafeParam(Path,Param) Dim re IsSafeParam=False Set re=new RegExp re.IgnoreCase =True re.Global=True re.Pattern=Param IsSafeParam=re.Test(Path) Set Re=Nothing End Function %>