<%@language="vbscript" %> <% option explicit %> <% Response.Buffer = True %> <% '# WebEdit Professional ASP Version: 5.0 - 01 May 2003 '# '# Copyright © 2001-2002 InterSpire - All Rights Reserved '# '# THIS COPYRIGHT INFORMATION MUST REMAIN INTACT '# AND MAY NOT BE MODIFIED IN ANY WAY '# '# When you purchased this script you agreed to accept the terms '# of this Agreement. This Agreement is a legal contract, which '# specifies the terms of the license and warranty limitation between '# you and 'InterSpire'. You should carefully read the following '# terms and conditions before installing or using this software. '# Unless you have a different license agreement obtained from '# 'WebEdPro.com' or 'InterSpire', installation or use of this '# software indicates your acceptance of the license and warranty '# limitation terms contained in this Agreement. '# If you do not agree to the terms of this Agreement, promptly delete '# and destroy all copies of the Software. '# '# Versions of the Software '# Only one licenced copy of WebEdit Pro may be used on one web site. '# '# License to Redistribute '# Distributing the software and/or documentation with other products '# (commercial or otherwise) by any means without prior written '# permission from 'WebEdPro.com' or 'InterSpire' is forbidden. '# All rights to the WebEdit Pro software and documentation not expressly '# granted under this Agreement are reserved to 'InterSpire'. '# '# Disclaimer of Warranty '# THIS SOFTWARE AND ACCOMPANYING DOCUMENTATION ARE PROVIDED "AS IS" '# AND WITHOUT WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR ANY '# OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED. BECAUSE OF THE '# VARIOUS HARDWARE AND SOFTWARE ENVIRONMENTS INTO WHICH WEBEDIT PRO '# MAY BE USED, NO WARRANTY OF FITNESS FOR A PARTICULAR PURPOSE IS '# OFFERED. THE USER MUST ASSUME THE ENTIRE RISK OF USING THIS '# PROGRAM. ANY LIABILITY OF 'INTERSPIRE' WILL BE LIMITED '# EXCLUSIVELY TO PRODUCT REPLACEMENT OR REFUND OF PURCHASE PRICE. '# IN NO CASE SHALL 'WEBEDPRO.COM' OR 'INTERSPIRE' BE LIABLE FOR '# ANY INCIDENTAL, SPECIAL OR CONSEQUENTIAL DAMAGES OR LOSS, INCLUDING, '# WITHOUT LIMITATION, LOST PROFITS OR THE INABILITY TO USE EQUIPMENT '# OR ACCESS DATA, WHETHER SUCH DAMAGES ARE BASED UPON A BREACH OF '# EXPRESS OR IMPLIED WARRANTIES, BREACH OF CONTRACT, NEGLIGENCE, '# STRICT TORT, OR ANY OTHER LEGAL THEORY. '# THIS IS TRUE EVEN IF 'WEBEDPRO.COM' OR 'INTERSPIRE' IS ADVISED '# OF THE POSSIBILITY OF SUCH DAMAGES. IN NO CASE WILL 'WEBEDPRO.COM' '# OR 'INTERSPIRE'S LIABILITY EXCEED THE AMOUNT OF THE LICENSE '# FEE ACTUALLY PAID BY LICENSEE TO 'WEBEDPRO.COM' OR 'INTERSPIRE'. '# '# Warning: This program is protected by copyright law. Unauthorized '# reproduction or distribution of this program, or any portion of it, '# may result in severe civil and criminal penalties, and will be '# prosecuted to the maximum extent possible under the law. '# '# Credits: '# Eddie Machaalani - Concept, Designer, Programmer '# Oleg Kokotovic - Logic Design '# Jonathan Snook - Additional Javascript Modules '# '# For more information about this script or other scripts see '# http://www.webedpro.com '# '# Thank you for purchasing our script. '# If you have any suggestions or ideas please direct them to '# info@webedpro.com '# %> <% Dim MyLogin Dim MyPassword Dim StartingDirectory Dim ImageDirectory Dim TemplateDirectory Dim maxfilesize Dim maximagesize Dim FileType Dim FileTypeInclude Dim ImageFileType Dim LinkType Dim DefaultFileExtension Dim bool_footer_error Dim URL Dim physical_path Dim DirectoryExcludes Dim TableBordersOnByDefault Dim RestrictedEditing Dim NonEditableFileType Dim fullPath Dim str_message Dim icon Dim AllowCreate Dim AllowCreateFolder Dim AllowCreateImageFolder Dim AllowDelete Dim AllowDeleteImage Dim AllowUpload Dim AllowUploadImage Dim AllowRename Dim AllowRenameImage Dim AllowCopy Dim AllowCopyImage Dim LicenseKey Dim InvoiceNumber Dim Email Dim OutputXHTML Dim SingleLineReturn Dim AbsolutePaths Dim ToDo Dim ScriptName Dim NewDir Dim CurrentDirectory Dim NewImageDirectory Dim CurrentImageDirectory Dim bool_from_image_dir Dim timeOut Session.Timeout = TimeOut Dim HTTPStr Dim ForceRestrictedEditing Dim SpellCheckLanguage Dim TemplateMode scriptName = request.servervariables("SCRIPT_NAME") URL = Request.ServerVariables("server_name") ' Added for SSL (https requests) if UCase(Request.ServerVariables("HTTPS")) = "ON" then HTTPStr = "https" else HTTPStr = "http" end if ' End addition fullPath = "$## 9x() *berb" ' physical_path = Request.ServerVariables("APPL_PHYSICAL_PATH") ' Get Action ToDo = request.querystring("ToDo") ' Cant do a normal request.form if we are posting a binary form (i.e. Uploading) if ToDo <> "UploadPage" Then ToDo = request.form("ToDo") If ToDo = "" then ToDo = request.querystring("ToDo") End If if ToDo = "Login" Then DoLogin() End if NewDir = request.form("newdir") if NewDir = "" then NewDir = request.querystring("newdir") End if NewImageDirectory = request.form("newimagedir") if NewImageDirectory = "" Then NewImageDirectory = request.querystring("newimagedir") End If bool_from_image_dir = request.form("FromImageDir") if bool_from_image_dir = "" Then bool_from_image_dir = request.querystring("FromImageDir") End if ' Added for forced templates ForceRestrictedEditing = request.form("forceRestrictedEditing") TemplateMode = request.form("templateMode") ' end addition else NewDir = request.querystring("newdir") NewImageDirectory = request.querystring("newimagedir") bool_from_image_dir = request.querystring("FromImageDir") End If If ToDo <> "ShowHelp" AND ToDo <> "FindReplace" AND ToDo <> "SpellCheck" AND ToDo <> "DoSpell" Then PrintPageHeader() End If StartingDirectory = session("startDir") ImageDirectory = session("ImageDir") DirectoryExcludes = session("ExcludeDirs") ' Which directory should we be working in? This is for normal files and directories if (NewDir <> "") Then ForceGoodPath NewDir, 0 CurrentDirectory = NewDir else CurrentDirectory = StartingDirectory End If if CurrentDirectory = "/" then CurrentDirectory = "" StartingDirectory = "" end if ' This concerns image files and subdirectories if (NewImageDirectory <> "") Then ForceGoodPath NewImageDirectory, 1 CurrentImageDirectory = NewImageDirectory else CurrentImageDirectory = ImageDirectory End if if CurrentImageDirectory = "/" then CurrentImageDirectory = "" ImageDirectory = "" end if Dim aaaaaaazbkx Dim aaaaaaaqrkl 'Check for authentication If session("auth") = true Then ' Examine the value of the ToDo argument and proceed to correct sub if ToDo = "Edit" Then EditPage() elseif ToDo = "Cancel" Then Cancel() elseif ToDo = "Rename" Then ShowRenamePage() elseif ToDo = "RenameFile" Then RenameFile() elseif ToDo = "Copy" Then ShowCopyPage() elseif ToDo = "CopyFile" Then CopyFile() elseif ToDo = "Create New File" Then ShowCreatePage() elseif ToDo = "CreateFile" Then CreateFile() elseif ToDo = "Create Folder" Then ShowCreateFolder() elseif ToDo = "NewFolder" Then CreateFolder() elseif ToDo = "Delete" Then DeletePage() elseif ToDo = "Upload File" Then ShowUploadPage() elseif ToDo = "UploadPage" Then UploadPage() elseif ToDo = "PrintDir" Then PrintDir() elseif ToDo = "SavePage" Then SavePage() elseif ToDo = "PrintImageDir" Then PrintImageDir() elseif ToDo = "InsertImage" Then PrintImageDir() elseif ToDo = "Upload Image" Then ShowUploadPage() elseif ToDo = "InsertTable" Then InsertTable() elseif ToDo = "ModifyTable" Then ModifyTable() elseif ToDo = "ModifyCell" Then ModifyCell() elseif ToDo = "ModifyImage" Then ModifyImage() elseif ToDo = "InsertForm" Then InsertForm() elseif ToDo = "ModifyForm" Then ModifyForm() elseif ToDo = "InsertTextField" Then InsertTextField() elseif ToDo = "ModifyTextField" Then ModifyTextField() elseif ToDo = "InsertTextArea" Then InsertTextArea() elseif ToDo = "ModifyTextArea" Then ModifyTextArea() elseif ToDo = "InsertHidden" Then InsertHidden() elseif ToDo = "ModifyHidden" Then ModifyHidden() elseif ToDo = "InsertButton" Then InsertButton() elseif ToDo = "ModifyButton" Then ModifyButton() elseif ToDo = "InsertCheckbox" Then InsertCheckbox() elseif ToDo = "ModifyCheckbox" Then ModifyCheckbox() elseif ToDo = "InsertRadio" Then InsertRadio() elseif ToDo = "ModifyRadio" Then ModifyRadio() elseif ToDo = "InsertChars" Then InsertChars() elseif ToDo = "PageProperties" Then PageProperties() elseif ToDo = "InsertLink" Then InsertLink() elseif ToDo = "InsertEmail" Then InsertEmail() elseif ToDo = "InsertAnchor" Then InsertAnchor() elseif ToDo = "ModifyAnchor" Then ModifyAnchor() elseif ToDo = "FindReplace" Then FindReplace() elseif ToDo = "SpellCheck" Then DisplayIncludes "spell_check.inc","Spell Check" elseif ToDo = "DoSpell" Then DisplayIncludes "do_spell.inc","Spell Check" elseif ToDo = "ShowHelp" Then ShowHelp() elseif ToDo = "Login" Then PrintDir() else Session.Abandon Pass() End if elseif ToDo = "Error" Then PrintError "Browser Error","5Hmedi WebEdit requires Microsoft Internet Explorer 5.5 or above
Please visit Microsoft to download the latest version of Internet Explorer
","" elseif ToDo = "PrintVersion" Then PrintVersion() elseif ToDo = "ShowHelp" Then ShowHelp() else Pass() End if ' Don't print the footer if editing a page... if ToDo <> "Edit" AND ToDo <> "ShowHelp" AND ToDo <> "SavePage" AND ToDo <> "FindReplace" AND ToDo <> "SpellCheck" AND ToDo <> "DoSpell" Then PrintFooter() End if '************************************************************* ' Start Subs '************************************************************* function fixSpace(text) fixSpace = Replace(text," ","%20") End function Sub DoLogin() Dim Username, Password, StartDir, ImageDir, loginError, ExcludeDirs, x Username = request.form("ezy_username") Password = request.form("ezy_password") aaaaaaazbkx = LicenseKey aaaaaaaqrkl = users.count if users.Exists(Username) Then if Password = users.Item(Username)(0) Then StartDir = users.Item(Username)(1) ImageDir = users.Item(Username)(2) x = Replace(users.Item(Username)(3)," ","") ExcludeDirs = split(x,",") PrintPageHedaer session("StartDir") = StartDir session("ImageDir") = ImageDir session("ExcludeDirs") = ExcludeDirs session("auth") = true else loginError = true End if else loginError = true End if if loginError Then PrintPageHeader PrintError "Login","Incorrect Login / Password combination
Please try again", "" End if End Sub Sub PrintPageHeader() response.write("" & Chr(10)) response.write("" & Chr(10) & Chr(10)) DisplayIncludes "pageheader.html","Page Header" End Sub sub PrintError(str_error_header, str_error_message, str_system_message) If (str_error_header = "") Then str_error_header = "Error" End if If (str_error_message = "") Then str_error_message = "A system error has occured. Could not continue." End if %> <% if (str_error_header = "Browser Error") Then ' Do Nothing else %>
<%=str_error_header%>
   
 
<%=str_error_message%> <%=str_system_message%>
   
  <% End If %>
<% if (bool_footer_error = false) Then ' if the error is happening while trying to print the footer, don't try to print the footer again ' or we'll just end up looping indefinately PrintFooter() End if ' exit the script after printing the error message Response.End End Sub sub PrintFooter() DisplayIncludes "pagefooter.html","Page Footer" End sub sub Pass() if (request.form("ezy_password") <> "") OR (request.form("ezy_username") <> "") Then PrintError "Login","Incorrect Login / Password combination
Please try again", "" End if ' print login stuff Const ForReading = 1, ForWriting = 2, ForAppending = 8 dim fso, f, ts, fileContent, includeFile set fso = server.CreateObject("Scripting.FileSystemObject") includeFile = Server.mapPath("webedit_includes/login.inc") if (fso.FileExists(includeFile)=true) Then set f = fso.GetFile(includeFile) set ts = f.OpenAsTextStream(ForReading, -2) Do While not ts.AtEndOfStream fileContent = fileContent & ts.ReadLine & vbCrLf Loop fileContent = replace(fileContent,"$URL",URL) fileContent = replace(fileContent,"$SCRIPTNAME",ScriptName) response.write(fileContent) else PrintError "Template", "Cannot open Login Template: webedit_includes/login.inc", "File not Found" End if End Sub sub PrintJSCommon() Const ForReading = 1, ForWriting = 2, ForAppending = 8 dim fso, f, ts, fileContent, includeFile set fso = server.CreateObject("Scripting.FileSystemObject") includeFile = Server.mapPath("webedit_includes/jscommon.inc") if (fso.FileExists(includeFile)=true) Then set f = fso.GetFile(includeFile) set ts = f.OpenAsTextStream(ForReading, -2) Do While not ts.AtEndOfStream fileContent = fileContent & ts.ReadLine & vbCrLf Loop ' added for SSL fileContent = replace(fileContent,"$HTTP",HTTPStr) ' End addition fileContent = replace(fileContent,"$URL",URL) fileContent = replace(fileContent,"$SCRIPTNAME",ScriptName) fileContent = replace(fileContent,"$NEWDIR",NewDir) fileContent = replace(fileContent,"$NEWIMAGEDIR",NewImageDirectory) fileContent = replace(fileContent,"$CurrentImageDirectory",CurrentImageDirectory) response.write(fileContent) else PrintError "Javascript Functions", "Cannot open Javascript Functions include file: webedit_includes/jscommon.inc", "" End if end sub sub PrintDir() ' Print the contents of the directory ' First, load the javascript functions if CurrentDirectory = "" then CurrentDirectory = "/" StartingDirectory = "/" end if PrintJSCommon() Dim objFilename, objFSO, objFolder, objFiles, objSubfolders, i Set objFSO = Server.CreateObject("Scripting.FileSystemObject") If (objFSO.FolderExists(server.mappath(CurrentDirectory))=true) Then Set objFolder = objFSO.GetFolder(server.mappath(CurrentDirectory)) else PrintError "Print Directory", "Cannot open directory for reading: " & CurrentDirectory, "Directory Not Found" End if Set objFiles = objFolder.Files Set objSubfolders = objFolder.SubFolders %>
File Manager
  Files - View, Edit, Rename, Copy, Delete, Upload or Create New
Directories - Change into, Rename, Delete or Create directories
 
  My Files and Folders
  Current Working Directory: <%=CurrentDirectory%>
  <% if CurrentDirectory = "/" then CurrentDirectory = "" StartingDirectory = "" end if if (CurrentDirectory <> StartingDirectory) Then Dim previousDir previousDir = left(CurrentDirectory,inStrRev(CurrentDirectory,"/")-1) %> <% End if Dim DontShow Dim excluded_dir Dim x Dim viewLink, editLink, deleteLink, renameLink, copyLink ' Display SubFolders here For Each objSubFolders in objFolder.subFolders DontShow = false For Each excluded_dir in DirectoryExcludes if (objSubFolders.name = excluded_dir) Then DontShow = true end if next if DontShow = false Then if AllowDelete = 1 Then deleteLink = "Delete" else deleteLink = " " End if if AllowRename = 1 Then renameLink = "Rename" else renameLink = " " End if %> <% end if next Dim display ' Added for v5.0, delete temp files if they exist in printdir For Each objFiles in objFolder.Files if InStr(objFiles.name, "wep_temp_") > 0 Then objFso.DeleteFile(Server.MapPath(CurrentDirectory & "\" & objFiles.name)) End if next ' End addition ' Display Files here For Each objFiles in objFolder.Files display = false For Each x in NonEditableFileType if (objFSO.GetExtensionName(objFiles.name) = x) Then editLink = "Edit" viewLink = "View" display = true End if Next For Each i in FileType if (objFSO.GetExtensionName(objFiles.name) = i) Then editLink = "Edit" viewLink = "View" display = true End if next if display Then if AllowDelete = 1 Then deleteLink = "Delete" else deleteLink = " " End if if AllowRename = 1 Then renameLink = "Rename" else renameLink = " " End if if AllowCopy = 1 Then copyLink = "Copy" else copyLink = " " End if %> <% End if next %>
  File Name File Size (bytes) Last Modified Action
[ ?newdir=<%=fixSpace(PreviousDir)%>&ToDo=PrintDir class=bodylink title="Move Up to Parent Directory">Up One Level ]
?newdir=<%=fixSpace(CurrentDirectory)%>/<%=fixSpace(objSubFolders.name)%>&ToDo=PrintDir class=bodylink title="Change into: '<%=objSubfolders.name%>'"><%=objSubfolders.name%> <%=objSubfolders.size%> <%=objSubFolders.datelastmodified%>     <%=renameLink%> Copy <%=deleteLink%>
<%=objFiles.name%> <%=objFiles.size%> <%=objFiles.datelastmodified%> <%=viewLink%> <%=editLink%> <%=renameLink%> <%=copyLink%> <%=deleteLink%>
  <% if AllowUpload = 1 Then %> <% end if %> <% if AllowCreate = 1 Then %> <% end if %> <% if AllowCreateFolder = 1 Then %> <% end if %>
<% End sub sub InsertLink() ' Print the contents of the directory ' First, load the javascript functions if CurrentDirectory = "" then CurrentDirectory = "/" StartingDirectory = "/" end if PrintJSCommon() Dim objFilename, objFSO, objFolder, objFiles, objSubfolders, i Set objFSO = Server.CreateObject("Scripting.FileSystemObject") If (objFSO.FolderExists(server.mappath(CurrentDirectory))=true) Then Set objFolder = objFSO.GetFolder(server.mappath(CurrentDirectory)) else PrintError "Print Directory", "Cannot open directory for reading: " & CurrentDirectory, "Directory Not Found" End if Set objFiles = objFolder.Files Set objSubfolders = objFolder.SubFolders %>
Link Manager
  Enter the required information and click "Insert Link" to insert a link into your webpage.
Alternatively, locate the file from the file manager below and select "Get Link Location". Click "Insert Link" to insert the link.
Click the "Cancel" Button to close this window.
   
 
  Link Information
 
URL:
Target Window:
Anchor:
 
 


 
  My Files and Folders
  Current Working Directory: <%=CurrentDirectory%>
  <% if CurrentDirectory = "/" then CurrentDirectory = "" StartingDirectory = "" end if if (CurrentDirectory <> StartingDirectory) Then Dim previousDir previousDir = left(CurrentDirectory,inStrRev(CurrentDirectory,"/")-1) %> <% End if Dim DontShow Dim excluded_dir Dim x Dim viewLink Dim editLink ' Display SubFolders here For Each objSubFolders in objFolder.subFolders DontShow = false For Each excluded_dir in DirectoryExcludes if (objSubFolders.name = excluded_dir) Then DontShow = true end if next if DontShow = false Then %> <% end if next Dim display, addLink ' Display Files here For Each objFiles in objFolder.Files display = false For Each i in LinkType if (objFSO.GetExtensionName(objFiles.name) = i) Then addLink = "Get Link Location" viewLink = "View" display = true End if next if display Then %> <% End if next %>
  File Name Action
[ ?newdir=<%=fixSpace(PreviousDir)%>&ToDo=InsertLink class=bodylink title="Move Up to Parent Directory">Up One Level ]
?newdir=<%=fixSpace(CurrentDirectory)%>/<%=fixSpace(objSubFolders.name)%>&ToDo=InsertLink class=bodylink title="Change into: '<%=objSubfolders.name%>'"><%=objSubfolders.name%>    
<%=objFiles.name%> <%=viewLink%> <%=addLink%>
 
<% End sub sub DeletePage() ' now go and actually delete the file/folder ' once again, assume the worst... Dim str_file_to_delete Dim isFolder, validFolder, validImage validFolder = 0 validImage = 0 icon = "error.gif" str_file_to_delete = request.querystring("filename") isFolder = request.querystring("isFolder") ' Check to see if this is a valid filename and no invalid characters if (bool_from_image_dir = "1") Then validImage = "1" End if if (isFolder = "1") Then validFolder = "1" End if ForceGoodInput str_file_to_delete,validFolder,validImage if (str_file_to_delete = "") Then ' has the user let us know what file / folder they want to delete? str_message = "Please select a file or folder to delete" else Dim toDelete if (bool_from_image_dir = "1") Then toDelete = Server.MapPath(CurrentImageDirectory & "\" & str_file_to_delete) else toDelete = Server.MapPath(CurrentDirectory & "\" & str_file_to_delete) End if Dim fso if (isFolder = 1) Then Set fso = CreateObject("Scripting.FileSystemObject") if (fso.FolderExists(toDelete)) Then fso.DeleteFolder(toDelete) str_message = str_file_to_delete & " Deleted Successfully" icon = "info.gif" else PrintError "Delete Directory", "Could not delete directory: "& CurrentDirectory & "/" & str_file_to_delete,"Directory not found" End if else Set fso = CreateObject("Scripting.FileSystemObject") if (fso.FileExists(toDelete)) Then fso.DeleteFile(toDelete) str_message = str_file_to_delete & " Deleted Successfully" icon = "info.gif" else PrintError "Delete File", "Could not delete file: "& CurrentDirectory & "/" & str_file_to_delete,"File not found" end if End if End if PrintInfoMessage "Delete" if (bool_from_image_dir) Then ' called from PrintImageDir? %> <% else %> <% End if %> <% End sub sub ShowRenamePage() Dim str_file_to_rename, isFolder str_file_to_rename = request.querystring("filename") if (str_file_to_rename = "") Then printError "Rename","Please select a file to rename.","" End if isFolder = request.querystring("isFolder") Const ForReading = 1, ForWriting = 2, ForAppending = 8 dim fso, f, ts, fileContent, includeFile set fso = server.CreateObject("Scripting.FileSystemObject") includeFile = Server.mapPath("webedit_includes/rename_page.inc") if (fso.FileExists(includeFile)=true) Then set f = fso.GetFile(includeFile) set ts = f.OpenAsTextStream(ForReading, -2) Do While not ts.AtEndOfStream fileContent = fileContent & ts.ReadLine & vbCrLf Loop fileContent = replace(fileContent,"$SCRIPTNAME",ScriptName) fileContent = replace(fileContent,"$NEWDIR",NewDir) fileContent = replace(fileContent,"$NEWIMAGEDIR",NewImageDirectory) fileContent = replace(fileContent,"$isFolder",isFolder) if (bool_from_image_dir = "1") Then fileContent = replace(fileContent,"","") End if fileContent = replace(fileContent,"$str_file_to_rename",str_file_to_rename) response.write(fileContent) else PrintError "Rename Template", "Cannot open Rename include file: webedit_includes/rename_page.inc", "" End if End Sub sub RenameFile () ' rename file/directory ' assume the worst Dim success, str_file_to_rename, str_new_file_name, isFolder success = 0 icon = "error.gif" str_file_to_rename = request.form("FileName") str_new_file_name = request.form("newfilename") isFolder = request.form("isFolder") if (str_new_file_name = "") Then str_message = "Please enter a new name." else Dim validImage, validFolder validImage = 0 validFolder = 0 if (bool_from_image_dir = "1") Then validImage = 1 end if if (isFolder = "1") Then validFolder = 1 end if ForceGoodInput str_file_to_rename,validFolder,validImage ForceGoodInput str_new_file_name,validFolder,validImage Dim fso, newFileName, oldFileName if (bool_from_image_dir = "1") Then oldFileName = Server.MapPath(CurrentImageDirectory & "\" & str_file_to_rename) newFileName = Server.MapPath(CurrentImageDirectory & "\" & str_new_file_name) else oldFileName = Server.MapPath(CurrentDirectory & "\" & str_file_to_rename) newFileName = Server.MapPath(CurrentDirectory & "\" & str_new_file_name) End if if (isFolder <> "1") Then Set fso = CreateObject("Scripting.FileSystemObject") If (fso.FileExists(newFileName) OR fso.FolderExists(newFileName)) Then str_message = "A file or folder with that name already exists." else fso.MoveFile oldFileName, newFileName success = 1 str_message = str_file_to_rename & " renamed to " & str_new_file_name & " Successfully." icon = "info.gif" End if Else Set fso = CreateObject("Scripting.FileSystemObject") If (fso.FolderExists(newFileName) OR fso.FileExists(newFileName)) Then str_message = "A file or folder with that name already exists." else fso.MoveFolder oldFileName, newFileName success = 1 str_message = str_file_to_rename & " renamed to " & str_new_file_name & " Successfully." icon = "info.gif" End if End If End if PrintInfoMessage "Rename" %> <% if (bool_from_image_dir <> "") Then %> <% else %> <% End if if (success = 1) Then %> <% else %> <% End if %> <% End Sub sub ShowCopyPage() Dim str_file_to_copy, isFolder str_file_to_copy = request.querystring("filename") if (str_file_to_copy = "") Then printError "Copy","Please select a file to copy.","" End if isFolder = request.querystring("isFolder") Const ForReading = 1, ForWriting = 2, ForAppending = 8 dim fso, f, ts, fileContent, includeFile set fso = server.CreateObject("Scripting.FileSystemObject") includeFile = Server.mapPath("webedit_includes/copy_page.inc") if (fso.FileExists(includeFile)=true) Then set f = fso.GetFile(includeFile) set ts = f.OpenAsTextStream(ForReading, -2) Do While not ts.AtEndOfStream fileContent = fileContent & ts.ReadLine & vbCrLf Loop fileContent = replace(fileContent,"$SCRIPTNAME",ScriptName) fileContent = replace(fileContent,"$NEWDIR",NewDir) fileContent = replace(fileContent,"$NEWIMAGEDIR",NewImageDirectory) fileContent = replace(fileContent,"$isFolder",isFolder) if (bool_from_image_dir = "1") Then fileContent = replace(fileContent,"","") End if fileContent = replace(fileContent,"$str_file_to_copy",str_file_to_copy) response.write(fileContent) else PrintError "Copy Template", "Cannot open Copy include file: webedit_includes/copy_page.inc", "" End if End Sub sub CopyFile () ' rename file/directory ' assume the worst Dim success, str_file_to_copy, str_new_file_name, isFolder success = 0 icon = "error.gif" str_file_to_copy = request.form("FileName") str_new_file_name = request.form("newfilename") isFolder = request.form("isFolder") if (str_new_file_name = "") Then str_message = "Please enter a file name." else Dim validImage, validFolder validImage = 0 validFolder = 0 if (bool_from_image_dir = "1") Then validImage = 1 end if if (isFolder = "1") Then validFolder = 1 end if ForceGoodInput str_file_to_copy,validFolder,validImage ForceGoodInput str_new_file_name,validFolder,validImage Dim fso, newFileName, oldFileName if (bool_from_image_dir = "1") Then oldFileName = Server.MapPath(CurrentImageDirectory & "\" & str_file_to_copy) newFileName = Server.MapPath(CurrentImageDirectory & "\" & str_new_file_name) else oldFileName = Server.MapPath(CurrentDirectory & "\" & str_file_to_copy) newFileName = Server.MapPath(CurrentDirectory & "\" & str_new_file_name) End if if (isFolder <> "1") Then Set fso = CreateObject("Scripting.FileSystemObject") If (fso.FileExists(newFileName) OR fso.FolderExists(newFileName)) Then str_message = "A file or folder with that name already exists." else fso.CopyFile oldFileName, newFileName success = 1 str_message = str_file_to_copy & " copied to " & str_new_file_name & " Successfully." icon = "info.gif" End if Else Set fso = CreateObject("Scripting.FileSystemObject") If (fso.FolderExists(newFileName) OR fso.FileExists(newFileName)) Then str_message = "A file or folder with that name already exists." else fso.CopyFolder oldFileName, newFileName success = 1 str_message = str_file_to_copy & " copied to " & str_new_file_name & " Successfully." icon = "info.gif" End if End If End if PrintInfoMessage "Copy" %> <% if (bool_from_image_dir <> "") Then %> <% else %> <% End if if (success = 1) Then %> <% else %> <% End if %> <% End Sub sub ShowCreateFolder () ' print the Create Folder page... Const ForReading = 1, ForWriting = 2, ForAppending = 8 dim fso, f, ts, fileContent, includeFile set fso = server.CreateObject("Scripting.FileSystemObject") includeFile = Server.mapPath("webedit_includes/create_folder.inc") if (fso.FileExists(includeFile)=true) Then set f = fso.GetFile(includeFile) set ts = f.OpenAsTextStream(ForReading, -2) Do While not ts.AtEndOfStream fileContent = fileContent & ts.ReadLine & vbCrLf Loop if (bool_from_image_dir = "1") Then fileContent = replace(fileContent,"newdir","newimagedir") fileContent = replace(fileContent,"$NEWDIR",newimagedirectory) fileContent = replace(fileContent,"","") else fileContent = replace(fileContent,"$NEWDIR",NewDir) End if response.write(fileContent) else PrintError "Create Folder Template", "Cannot open Create Folder include file: webedit_includes/create_folder.inc", "" End if End Sub sub CreateFolder () ' now go and actually create the folder required.. ' always assume the worst: dim success, str_new_folder_name, newFolderName, fso, f icon = "error.gif" success = 0 str_new_folder_name = request.form("newfoldername") if (str_new_folder_name = "") Then ' if we dont have the name for the new folder, ask the user str_message = "Please enter a name for the new folder." else if (bool_from_image_dir = "1") Then ForceGoodInput str_new_folder_name,1,1 newFolderName = Server.MapPath(CurrentImageDirectory & "\" & str_new_folder_name) else ForceGoodInput str_new_folder_name,1,0 newFolderName = Server.MapPath(CurrentDirectory & "\" & str_new_folder_name) End if set fso = server.CreateObject("Scripting.FileSystemObject") If (fso.FileExists(newFolderName) OR fso.FolderExists(newFolderName)) Then ' does a folder with that name already exist in the location? str_message = "A file or folder with that name already exists." else ' okay, we have all we need... now let us try to make the new folder ' or print an error message if we cannot Set f = fso.CreateFolder(newFolderName) 'mkdir $str_new_folder_name, 0755 || &PrintError ("Create Folder", "Cannot create folder $str_new_folder_name
\n", $!); ' now that all is good, keep going str_message = "Directory " & str_new_folder_name & " Created Successfully." success = 1 icon = "info.gif" end if End if PrintInfoMessage "Create Folder" if (bool_from_image_dir = "1") Then %> <% else %> <% End if if (success = 1) Then %> <% else %> <% End if %> <% End sub sub ShowCreatePage() %>
Create New Page
  Enter a name for the new page. Click 'OK' to create the file. Click 'Cancel' to return to the previous screen. Click 'Preview' to preview the template you have chosen.
   
 
  Create New file
 
Select Template: Preview:
Save New File as:
 
<% End Sub sub PrintTemplateDropdown() Dim objFilename, objFSO, objFolder, objFiles, objSubfolders, i Set objFSO = Server.CreateObject("Scripting.FileSystemObject") if objFSO.FolderExists(server.mappath(TemplateDirectory)) Then Set objFolder = objFSO.GetFolder(server.mappath(TemplateDirectory)) Set objFiles = objFolder.Files For Each objFiles in objFolder.Files For Each i in FileType if (objFSO.GetExtensionName(objFiles.name) = i) Then %> <% End if next next else PrintError "Template","Cannot open template directory: " & TemplateDirectory,"" End if End Sub sub CreateFile() ' create new file ' assume the worst Dim success, str_new_file_name, str_template_file, newFileName, templateFileName, fso, f, ts, fileContent, re success = 0 icon = "error.gif" str_new_file_name = request.form("newfilename") str_template_file = request.form("templateName") if (str_new_file_name = "") Then str_message = "Please enter a name for the new file" else if (str_template_file = "") Then str_message = "Please choose a template from which to create your file" end if templateFileName = Server.MapPath(TemplateDirectory & "\" & str_template_file) str_new_file_name = str_new_file_name & DefaultFileExtension ForceGoodInput str_new_file_name,0,0 newFileName = Server.MapPath(CurrentDirectory & "\" & str_new_file_name) Set fso = CreateObject("Scripting.FileSystemObject") If (fso.FileExists(newFileName) OR fso.FolderExists(newFileName)) Then str_message = "A file or folder with that name already exists." else ' Added for v5.0: images in templates set f = fso.GetFile(templateFileName) set ts = f.OpenAsTextStream(1, -2) Do While not ts.AtEndOfStream fileContent = fileContent & ts.ReadLine & vbCrLf Loop Set re = New RegExp re.Pattern = "_template_files" re.IgnoreCase = True re.Global = True ' re.Multiline = True fileContent = re.Replace(fileContent, TemplateDirectory & "/" & "_template_files") set f = fso.OpenTextFile(newFileName, 2, true) f.write(fileContent) f.close ' End addition str_message = str_new_file_name & " Created Successfully." success = 1 icon = "info.gif" End if End if PrintInfoMessage "Create New Page" %> <% if (success = 1) Then %> <% else %> <% end if %> <% End Sub sub ShowUploadPage() ' print the upload file page Const ForReading = 1, ForWriting = 2, ForAppending = 8 dim fso, f, ts, fileContent, includeFile set fso = server.CreateObject("Scripting.FileSystemObject") includeFile = Server.mapPath("webedit_includes/upload_page.inc") if (fso.FileExists(includeFile)=true) Then set f = fso.GetFile(includeFile) set ts = f.OpenAsTextStream(ForReading, -2) Do While not ts.AtEndOfStream fileContent = fileContent & ts.ReadLine & vbCrLf Loop fileContent = replace(fileContent, "$SCRIPTNAME", ScriptName) fileContent = replace(fileContent, "$NEWDIR", newdir) fileContent = replace(fileContent, "$NEWIMAGEDIR", newimagedirectory) if (bool_from_image_dir = 1) Then fileContent = replace(fileContent, "$$DONOTDELETE$$", "") else fileContent = replace(fileContent, "$$DONOTDELETE$$", "") End if response.write(fileContent) else PrintError "Template", "Cannot open Upload Page file: webedit_includes/upload_page.inc", "File not Found" End if End sub sub UploadPage() Response.Buffer = True Dim success, toDofilesize, validImage Dim ImageFileSize ImageFileSize = Request.TotalBytes if (bool_from_image_dir = "1") Then toDofilesize = maximagesize else toDofilesize = maxfilesize End if if ((ImageFileSize > toDofilesize) OR (ImageFileSize < 630)) Then str_message = "Please select a file to upload. (No Greater than " & maxfilesize & "bytes)" icon = "error.gif" else ' load object Dim load Set load = new Loader ' calling initialize method load.initialize ' File name Dim fileName fileName = LCase(load.getFileName("sourcefile")) ' File binary data Dim fileData fileData = load.getFileData("sourcefile") ' File path Dim filePath filePath = load.getFilePath("sourcefile") ' File path complete Dim filePathComplete filePathComplete = load.getFilePathComplete("sourcefile") ' File size Dim fileSize fileSize = load.getFileSize("sourcefile") ' File size translated Dim fileSizeTranslated fileSizeTranslated = load.getFileSizeTranslated("sourcefile") ' Content Type Dim contentType contentType = load.getContentType("sourcefile") ' No. of Form elements Dim countElements countElements = load.Count ' Value of text input field "name" Dim nameInput ' nameInput = load.getValue("name") nameInput = filename bool_from_image_dir = load.getValue("FromImageDir") ' Path where file will be uploaded Dim pathToFile if (CurrentDirectory = "") Then CurrentDirectory = "/" end if if (CurrentImageDirectory = "") Then CurrentImageDirectory = "/" end if if (bool_from_image_dir = "1") Then ForceGoodInput fileName,0,1 pathToFile = Server.mapPath(CurrentImageDirectory) & "\" & fileName else ForceGoodInput fileName,0,0 pathToFile = Server.mapPath(CurrentDirectory) & "\" & fileName end if Dim fso Dim msgExists set fso = server.CreateObject("Scripting.FileSystemObject") if (fso.FileExists(pathToFile)=true) OR (fso.FolderExists(pathToFile)=true)Then msgExists = "Could not upload file. A file or folder with that name already exists" else ' Uploading file data Dim fileUploaded fileUploaded = load.saveToFile ("sourcefile", pathToFile) end if ' destroying load object Set load = Nothing If (fileUploaded = True) Then icon = "info.gif" str_message = fileName & " uploaded successfully." success = 1 else icon = "error.gif" if msgExists = "" Then str_message = fileName & " could not be uploaded." else str_message = msgExists end if success = 0 End If End if PrintInfoMessage "Upload File / Image" If (bool_from_image_dir = "1") then %> <% else %> <% End if If (success = 1) Then %> <% else %> <% End if %> <% End Sub sub EditPage() Dim str_file_name, str_temp_file_name, tempFile str_file_name = request.querystring("FileName") ' added for temp file str_temp_file_name = "wep_temp_" & str_file_name ' end addition if (str_file_name = "") then PrintError "Edit File", "Please select a File to modify", "" end if Const ForReading = 1, ForWriting = 2, ForAppending = 8 dim fso, f, ts, fileContent, includeFile set fso = server.CreateObject("Scripting.FileSystemObject") ForceGoodInput str_file_name,0,0 includeFile = Server.mapPath(CurrentDirectory & "/" & str_file_name) ' added for temp file tempFile = Server.mapPath(CurrentDirectory & "/" & str_temp_file_name) ' End addition if (fso.FileExists(includeFile)=false) Then PrintError "Edit", "Cannot open file to edit:: " & CurrentDirectory & "/" & str_file_name, "File not Found" ' added for temp file else createTemp tempFile, includeFile ' end addition End if ' Added for XHTML support if OutputXHTML = "1" then %> <% end if ' End addition ' Added to get path to script for Anchor and Hidden images Dim pathToImages pathToImages = left(scriptName, InStrRev(scriptName,"/")-1) & "/webedit_images" ' End addition ' Added for DW Templates and Forced Templates Dim EditDefault if ForceRestrictedEditing = "1" Then EditDefault = 1 else EditDefault = RestrictedEditing End if ' End Addition %> <% ' Print toolbar set fso = server.CreateObject("Scripting.FileSystemObject") includeFile = Server.mapPath("webedit_includes/toolbar.inc") filecontent = "" if (fso.FileExists(includeFile)=true) Then set f = fso.GetFile(includeFile) set ts = f.OpenAsTextStream(ForReading, -2) Do While not ts.AtEndOfStream fileContent = fileContent & ts.ReadLine & vbCrLf Loop fileContent = replace(fileContent,"$STR_FILE_NAME",str_file_name) fileContent = replace(fileContent,"$NEWDIR",newdir) fileContent = replace(fileContent,"$URL",URL) fileContent = replace(fileContent,"$SCRIPTNAME",ScriptName) fileContent = replace(fileContent,"$STR_INC_FILE_EXT",FileTypeInclude) ' Added for Forced Restricted Editing / DW templates fileContent = replace(fileContent,"$FORCE_RESTRICTED_EDITING",ForceRestrictedEditing) fileContent = replace(fileContent,"$TEMPLATE_MODE",TemplateMode) ' End addition response.write(fileContent) else PrintError "Template", "Cannot open Toolbar file:: webedit_includes/toolbar.inc", "File not Found" End if Randomize() %> <% End sub ' Added for temp file sub createTemp(newFile, originalFile) Const ForReading = 1, ForWriting = 2, ForAppending = 8 dim fso, f, ts, fileContent, re, re2 set fso = server.CreateObject("Scripting.FileSystemObject") if (fso.FileExists(originalFile)=true) Then set f = fso.GetFile(originalFile) set ts = f.OpenAsTextStream(ForReading, -2) Do While not ts.AtEndOfStream fileContent = fileContent & ts.ReadLine & vbCrLf Loop Set re = New RegExp Set re2 = New RegExp re.Pattern = "<\!--\s+#BeginEditable" re2.Pattern = "<\!--\s+InstanceBeginEditable" re.IgnoreCase = True re2.IgnoreCase = True re.Global = True re2.Global = True ' re.Multiline = True ' re2.Multiline = True If re.Test(fileContent) Then ForceRestrictedEditing = "1" ' Old style DW templates TemplateMode = "1" fileContent = convertComments(fileContent) elseif re2.Test(fileContent) Then ForceRestrictedEditing = "1" ' New style DW MX templates TemplateMode = "2" fileContent = convertComments(fileContent) End if fileContent = convertScripts(fileContent) set f = fso.OpenTextFile(newFile, ForWriting, true) f.write(fileContent) f.close End if End Sub function convertComments(fileContent) dim re, oMatches, intResult ' Convert HTML Comment Tags to Editable Divs Set re = New RegExp re.IgnoreCase = True re.Global = True ' re.Multiline = True ' there seems to be no way to do what we need in a single replace, ' so lets extract BODY part (if present) first re.Pattern = "]*>[\d\D]*<\/body>" Set oMatches = re.Execute(fileContent) if TemplateMode = "1" Then re.Pattern = "<\!--\s+#BeginEditable\s+""(.+)""\s+-->([\s\S]*?)<\!--\s+#EndEditable\s+-->" else re.Pattern = "<\!--\s+InstanceBeginEditable\s+name=""(.+)""\s+-->([\s\S]*?)<\!--\s+InstanceEndEditable\s+-->" End if If oMatches.Count > 0 Then intResult = re.Replace( oMatches.item(0).Value, "
$2
" ) re.Pattern = "(]*>)([\d\D]*)<\/body>" fileContent = re.Replace( fileContent, intResult ) Else fileContent = re.Replace(fileContent, "
$2
") End If convertComments = fileContent ' End Conversion End function function revertComments(fileContent) dim re ' Convert HTML Comment Tags to Editable Divs Set re = New RegExp re.Pattern = "((?:(?:]*>[\d\D]*?)|[\d\D]+?)*?)" re.IgnoreCase = True re.Global = True ' re.Multiline = True if TemplateMode = "1" Then fileContent = re.Replace(fileContent, "$2") else fileContent = re.Replace(fileContent, "$2") End if revertComments = fileContent ' End Conversion End function function convertScripts(fileContent) dim re Set re = New RegExp re.IgnoreCase = True re.Global = True re.Pattern = "<(script[^>]*?)language\s*?=\s*?(?!wep_no_script)([^>\s'""]+)([^>]*?)>" fileContent = re.Replace( fileContent, "<$1language=""wep_no_script_$2""$3>" ) re.Pattern = "<(script[^>]*?)language\s*?=\s*?(['""])(?!wep_no_script)(\S+)\2([^>]*?)>" fileContent = re.Replace( fileContent, "<$1language=""wep_no_script_$3""$4>" ) re.Pattern = "