<%@ Language=VBScript %> <%Option Explicit%> <% ' WebExplorer Lite - A powerful asp tool for managing remote files with an user-friendly web interface ' April 2004 - Version 2.13 ' Copyright © 2000-2004 GleamTech ' Copyright notice: ' WebExplorer Lite is a freeware with open source code. ' As long as you keep the copyright message, you can ' play with the code for your own purposes but you can ' not distribute the altered version. You can not sell ' WebExplorer Lite or use it for commercial purposes. ' Please contact me for commercial uses. ' Visit the web page for updates and support: ' http://www.gleamtech.com ' - WebExplorer Lite Main ------------------------------------ Const appName = "WebExplorer Lite" Const appVersion = "2.13" %><% Dim FSO, re Dim scriptName, wexId Dim wexMessage, wexRootPath, targetPath Dim encoding, codepage, charset InitApp() ' Actions in the popup windows Select Case Request.Form("command") Case "Edit" Editor() Case "View" Viewer() Case "FileDetails", "FolderDetails" Details() Case "Upload" Upload(false) End Select ' Actions in the main window Select Case Request.Form("command") Case "NewFile", "NewFolder" CreateItem() Case "DeleteFile", "DeleteFolder" DeleteItem() Case "RenameFile", "RenameFolder" RenameItem() Case "OpenFolder" targetPath = WexMapPath(Request.Form("folder") & Request.Form("parameter")) Case "LevelUp" targetPath = WexMapPath(FSO.GetParentFolderName(Request.Form("folder"))) Case "Logout" Logout() End Select List() DestroyApp() ' ------------------------------------------------------------ ' - WebExplorer Lite Functions ------------------------------- ' Initializes some variables, creates instances of some objects and ensures security Sub InitApp() scriptName = Request.ServerVariables("SCRIPT_NAME") wexId = appName & appVersion & "-" If Request.QueryString("precommand")="Download" Then Response.Buffer = false Else Response.Buffer = true If not Secure() Then If Request.Form("popup")="true" or Request.QueryString("popup")="true" Then PopupRelogin() Else Login() End If Set FSO = server.CreateObject ("Scripting.FileSystemObject") Set re = new regexp wexRootPath = RealizePath(wexRoot) encoding = -2 'System default encoding ' Commands with high priority ' These commands require to be performed before any Request.Form statement Select Case Request.QueryString("precommand") Case "ProcessUpload" Upload(true) Case "Download" Download() Case "Encoding" If Request.QueryString("value")<>"" Then encoding = Int(Request.QueryString("value")) If encoding=-1 Then 'Unicode encoding codepage = Session.CodePage Session.CodePage = 65001 Response.CharSet = "UTF-8" End If End Select targetPath = WexMapPath(Request.Form("folder")) End Sub ' Frees the objects and ends the application Sub DestroyApp() If encoding=-1 Then Session.CodePage = codepage Set FSO = Nothing Set re = Nothing Response.End End Sub ' Writes the html header Sub HtmlHeader(title) %> <%=title%> <%HtmlStyle%> <%HtmlJavaScript%> <% End Sub ' Writes the html footer Sub HtmlFooter() %> <% End Sub ' Writes the copyright message Sub HtmlCopyright() %>
Copyright © 2000-2004 GleamTech
<% End Sub ' Writes the stylesheet Sub HtmlStyle() %> <% End Sub ' Writes the javascript code Sub HtmlJavaScript() %> <% End Sub ' Writes file listing of the current folder Sub List() Dim objFolder, virtual, folder Dim item, arr Dim rowType Dim listed, FileAndPath, Show, GetExt, Desc HtmlHeader appName on error resume next Set objFolder = FSO.GetFolder(targetPath) If err.Number<>0 Then wexMessage = "Error opening folder !" virtual = VirtualPath(targetPath) folder = right(targetPath, len(targetPath)-len(wexRootPath)) %>
<% rowType = "darkRow" If len(targetPath) > len(wexRootPath) Then %> > <% rowType = "lightRow" End If listed = 0 If (objFolder.subfolders.Count + objFolder.files.Count) = 0 Then ' Do nothing when error occurs %> <% Else For each item in objFolder.subfolders If showHiddenItems or not item.Attributes and 2 Then listed = listed + 1 %> > <% If rowType = "darkRow" Then rowType = "lightRow" Else rowType = "darkRow" End If Next For each item in objFolder.files dim r If showHiddenItems or not item.Attributes and 2 Then getExt = FSO.GetExtensionName(objFolder.path & "\" & item.name) listed = listed + 1 desc="" if lcase(item.name)="aaaaa.aaa" or lcase(getExt)="desc" then set r=FSO.OpenTextFile(objFolder.path & "\" & item.name,1) Do until r.AtEndOfStream desc = desc & r.readline Loop r.close end if Show=false if lcase(getExt) = "jpg" or lcase(getext) = "gif" or lcase(getext) = "png" or lcase(getext) = "tif" or lcase(getext) = "bmp" then Show=true FileAndPath = objFolder.path & "\" & item.name FileAndPath=replace(FileAndPath,"\","/") %> > <% If rowType = "darkRow" Then rowType = "lightRow" Else rowType = "darkRow" End If Next End If %>
 <%=appName%> - " target="_blank" title="Browse the web root"><%=Request.ServerVariables("SERVER_NAME")%> v<%=appVersion%> - <%=Date()%> 
  <%=objFolder.Name%>
<%If displayPath Then%>
  <%=objFolder.path%>
<%End If%> <%If virtual<>"" Then%> <%Else%> <%End If%>
<%=objFolder.subfolders.count%> subfolder(s)
<%=objFolder.files.count%> file(s)
Total Size: <%If err.Number<>0 or (not calculateTotalSize) Then Response.Write "N/A" Else Response.Write FormatSize(objFolder.size)%> Refresh file listing  Create new file  Create new folder  Upload to this folder  <%If wexPassword <> "" Then%> Log out from WebExplorer Lite <%End If%>
 Name  Size  Type  Modified  Actions
  ..    
No files or folders
 <%=GetIcon(item.Name, true)%> <%=item.Name%>  <%If calculateFolderSize Then Response.write FormatSize(item.Size)%> <%=item.Type%>  <%=item.DateLastModified%>   <%If virtual<>"" Then%> Browse Folder <%End If%> Rename Folder Delete Folder
 <%=GetIcon(item.Name, false)%>  <%if Show=true then %> <%End If%> <%=item.Name%> <%if desc<>"" then%>
<%=desc%> <%end if%>
 <%=FormatSize(item.Size)%> <%=item.Type%>  <%=item.DateLastModified%>   <%If virtual<>"" Then%> Browse File <%End If%> Rename File Delete File
 
<% If wexMessage="" Then If (objFolder.subfolders.Count + objFolder.files.Count) <> listed Then wexMessage = "Listed " & listed & " of " & (objFolder.subfolders.Count + objFolder.files.Count) & " item(s) , " & (objFolder.subfolders.Count + objFolder.files.Count - listed) & " item(s) are hidden..." Else wexMessage = "Listed " & (objFolder.subfolders.Count + objFolder.files.Count) & " item(s)..." End If Response.Write "" End If Set objFolder = Nothing HtmlCopyright HtmlFooter End Sub ' Writes the given error message Sub Error(title, message, popup) HtmlHeader appName %>
 An error occured
<%=title%>:
<%=message%>
<%If popup Then%> Close <%Else%> Back <%End If%>
<% HtmlFooter DestroyApp() End Sub ' WebExplorer Lite login screen Sub Login() If Request.Form("command") = "Login" Then If Request.Form("pwd") = wexPassword Then Session(wexId & "Login") = true Exit Sub Else wexMessage = "Wrong password!" End If End If HtmlHeader appName If(wexMessage<>"") Then Response.Write "" %>



 Login

Welcome to <%=appName%> v<%=appVersion%>

 Password



 
<% HtmlFooter DestroyApp() End Sub ' Relogin message for the popup windows Sub PopupRelogin() HtmlHeader appName %>
<%=appName%> session is destroyed, please relogin.
<% HtmlFooter DestroyApp() End Sub ' Checks if there is a valid login Function Secure() If wexPassword = "" Then Secure = true Else If Session(wexId & "Login") Then Secure = true Else Secure = false End If End Function ' Logs out from WebExplorer Lite Sub Logout() Session.Abandon() Login End Sub ' Returns the icon of the file Function GetIcon(fileName, isFolder) Dim ext If isFolder Then GetIcon = "" Else ext = FSO.GetExtensionName(fileName) re.IgnoreCase = true re.Pattern = "^" & ext & ",|," & ext & ",|," & ext & "$" If re.test(editableExtensions) Then GetIcon = "" ElseIf re.test(viewableExtensions) Then GetIcon = "" Else GetIcon = "" End If End If End Function ' Formats given size in bytes,KB,MB and GB Function FormatSize(givenSize) If (givenSize < 1024) Then FormatSize = givenSize & " B" ElseIf (givenSize < 1024*1024) Then FormatSize = FormatNumber(givenSize/1024,2) & " KB" ElseIf (givenSize < 1024*1024*1024) Then FormatSize = FormatNumber(givenSize/(1024*1024),2) & " MB" Else FormatSize = FormatNumber(givenSize/(1024*1024*1024),2) & " GB" End If End Function ' Adds given type of the slash to the end of the path if required Function FixPath(path, slash) If Right(path, 1) <> slash Then FixPath = path & slash Else FixPath = path End If End Function ' Converts the given path to physical path Function RealizePath(path) Dim fpath fpath = replace(path,"/","\") If left(fpath,1) = "\" Then 'Virtual path on error resume next RealizePath = server.MapPath(fpath) If err.Number<>0 Then RealizePath = fpath 'Possibly network path Else 'Physical Path RealizePath = fpath End If RealizePath = FixPath(RealizePath, "\") End Function ' Converts the given path to virtual path Function VirtualPath(path) Dim webRoot, fpath webRoot = FixPath(server.MapPath("/"),"\") fpath = FixPath(path,"\") VirtualPath = "" If left(wexRoot,1) = "/" Then VirtualPath = FixPath(wexRoot, "/") VirtualPath = VirtualPath & right(fpath, len(fpath) - len(wexRootPath)) VirtualPath = replace(VirtualPath, "\", "/") VirtualPath = FixPath(VirtualPath,"/") ElseIf left(lcase(fpath), len(webRoot)) = lcase(webRoot) Then VirtualPath = "/" & right(fpath, len(fpath) - len(webRoot)) VirtualPath = replace(VirtualPath, "\", "/") VirtualPath = FixPath(VirtualPath,"/") End If End Function 'Maps the given path according to the root path Function WexMapPath(path) If SecurePath(path) Then WexMapPath = FixPath(wexRootPath & path, "\") Else Error "Security Error", "Relative path syntax is forbidden for security reasons.", false End Function ' Checks against relative path syntax (. or .. injection) Function SecurePath(path) Dim fpath fpath = replace(path,"/","\") If fpath="." Then fpath=".\" re.IgnoreCase = false re.Pattern = "^\.\.$|^\.\.\\|\\\.\.\\|\\\.\.$" re.Pattern = re.Pattern & "|^\.\\|\\\.\\|\\\.$" If re.Test(fpath) Then SecurePath=false Else SecurePath=true End Function ' Makes sure that given file name does not contain path info Function SecureFileName(name) SecureFileName = replace(name,"/","?") SecureFileName = replace(SecureFileName,"\","?") End Function ' Checks if the extension of the given file name is allowed Function CheckExtension(fileName) Dim allow Dim re, match, extension If monitoredExtensions<>"" Then Set re = new regexp re.IgnoreCase = true re.Global = false re.Pattern = "\.(\w+)$" Set match = re.Execute(fileName) If match.Count<>0 Then extension = match(0).SubMatches(0) re.Pattern = "^" & extension & ",|," & extension & ",|," & extension & "$" & "|^" & extension & "$" If re.test(monitoredExtensions) Then allow = false Else allow = true Else allow = true End If Set re = Nothing If denyMonitored Then CheckExtension = allow Else CheckExtension = (not allow) End If Else CheckExtension = true End If End Function ' Creates a folder or a file Function CreateItem() Dim itemType, itemName, itemPath itemType = Request.Form("command") itemName = SecureFileName(Request.Form("parameter")) itemPath = targetPath & itemName on error resume next Select Case itemType Case "NewFolder" If FSO.FolderExists(itemPath) = false and FSO.FileExists(itemPath) = false Then FSO.CreateFolder(itemPath) If err.Number <> 0 Then wexMessage = "Unable to create the folder """ & itemName & """, an error occured..." Else wexMessage = "Created the folder """ & itemName & """..." End If Else wexMessage = "Unable to create the folder """ & itemName & """, there exists a file or a folder with the same name..." End If Case "NewFile" If FSO.FolderExists(itemPath) = false and FSO.FileExists(itemPath) = false Then If CheckExtension(itemName) Then FSO.CreateTextFile(itemPath) Else err.Raise 1 End If If err.Number <> 0 Then wexMessage = "Unable to create the file """ & itemName & """, an error occured..." Else wexMessage = "Created the file """ & itemName & """..." End If Else wexMessage = "Unable to create the file """ & itemName & """, there exists a file or a folder with the same name..." End IF End Select End Function ' Deletes a folder or a file Function DeleteItem() Dim itemType, itemName, itemPath itemType = Request.Form("command") itemName = SecureFileName(Request.Form("parameter")) itemPath = targetPath & itemName on error resume next Select Case itemType Case "DeleteFolder" FSO.DeleteFolder itemPath, true If err.Number <> 0 Then wexMessage = "Unable to delete the folder """ & itemName & """, an error occured..." Else wexMessage = "Deleted the folder """ & itemName & """..." End If Case "DeleteFile" FSO.DeleteFile itemPath, true If err.Number <> 0 Then wexMessage = "Unable to delete the file """ & itemName & """, an error occured..." Else wexMessage = "Deleted the file """ & itemName & """..." End If End Select End Function ' Renames a folder or a file Function RenameItem() Dim item, itemType, itemName, itemPath Dim param, newName itemType = Request.Form("command") param = split(Request.Form("parameter"), "|") itemName = SecureFileName(param(0)) newName = SecureFileName(param(1)) itemPath = targetPath & newName on error resume next Select Case itemType Case "RenameFolder" If FSO.FolderExists(itemPath) = false and FSO.FileExists(itemPath) = false Then itemPath = targetPath & itemName Set item = FSO.GetFolder(itemPath) item.Name = newName If err.Number <> 0 Then wexMessage = "Unable to rename the folder """ & itemName & """, an error occured..." Else wexMessage = "Renamed the folder """ & itemName & """ to """ & newName & """..." End If Else wexMessage = "Unable to rename the folder """ & itemName & """, there exists a file or a folder with the new name """ & newName & """..." End If Case "RenameFile" If FSO.FolderExists(itemPath) = false and FSO.FileExists(itemPath) = false Then If CheckExtension(newName) Then itemPath = targetPath & itemName Set item = FSO.GetFile(itemPath) item.Name = newName Else err.Raise 1 End If If err.Number <> 0 Then wexMessage = "Unable to rename the file """ & itemName & """, an error occured..." Else wexMessage = "Renamed the file """ & itemName & """ to """ & newName & """..." End If Else wexMessage = "Unable to rename the file """ & itemName & """, there exists a file or a folder with the new name """ & newName & """..." End If End Select Set item = Nothing End Function ' WebExplorer Lite Editor Sub Editor() Dim fileName, filePath, file on error resume next Select Case Request.Form("subcommand") Case "Save", "SaveAs" fileName = SecureFileName(Request.Form("parameter")) filePath = targetPath & fileName If CheckExtension(fileName) Then Set file = FSO.OpenTextFile (filePath, 2, true, encoding) If (err.Number<>0) Then wexMessage = "Can not write to the file """ & fileName & """, permission denied!" err.Clear Else file.write Request.Form("content") End If Set file = Nothing Else wexMessage = "Can not write to the file """ & fileName & """, extension not allowed!" End If Set file = FSO.OpenTextFile (filePath, 1, false, encoding) Case Else fileName = SecureFileName(Request.Form("parameter")) filePath = targetPath & fileName If not FSO.FileExists(filePath) Then wexMessage = "The file """ & fileName & """ does not exist" Set file = FSO.CreateTextFile (filePath, false) If err.Number<>0 Then wexMessage = wexMessage & ", also unable to create new file." err.Clear Else wexMessage = wexMessage & ", created new file." End If Else Set file = FSO.OpenTextFile (filePath, 1, false, encoding) If err.Number<>0 Then wexMessage = "Can not read from the file """ & fileName & """, permission denied!" err.Clear End If End If End Select HtmlHeader appName If(wexMessage<>"") Then Response.Write "" %>
 Editing - <%=fileName%> Encoding:
Save | Save As | Reload | Info | Close
<% Set file = Nothing Set file = FSO.GetFile (filePath) %> ">
<% Set file = Nothing HtmlFooter DestroyApp() End Sub ' WebExplorer Lite Viewer Sub Viewer() Dim filePath, file filePath = targetPath & Request.Form("parameter") If not FSO.FileExists(filePath) Then Error "Viewer Error", "File not found. Please refresh the listing to see if the file actually exists.", true on error resume next Set file = FSO.GetFile(filePath) HtmlHeader appName %>
 Viewing - <%=file.Name%>
Reload | Info | Close
">
<% Set file = Nothing HtmlFooter DestroyApp() End Sub ' File/Folder Details Sub Details() Dim fileName, filePath, file on error resume next fileName = Request.Form("parameter") filePath = targetPath & fileName HtmlHeader appName %>
 Details - <%=fileName%>
<% If Request.Form("command") = "FileDetails" Then Set file = FSO.GetFile (filePath) Else Set file = FSO.GetFolder (filePath) End If %>
Size:<%=FormatSize(file.Size)%>
Type:<%=file.Type%>
Created:<%=file.DateCreated%>
Last Accessed:<%=file.DateLastAccessed%>
Last Modified:<%=file.DateLastModified%>
<% Set file = Nothing %>
Close
"> ">
<% HtmlFooter DestroyApp() End Sub ' Uploads a file Sub Upload(process) Dim fileTransfer, result on error resume next Set fileTransfer = New pluginFileTransfer If err.number<>0 Then Error "File Transfer Plugin Error", "Plugin cannot be initialized. Please make sure that the components required by the plugin is installed on the server.", true If process Then targetPath = WexMapPath(Request.QueryString("folder")) HtmlHeader appName %>
 Upload - <%=FSO.GetBaseName(targetPath)%>
<% ' Actual upload process If process Then fileTransfer.path = targetPath result = fileTransfer.Upload() Select Case result Case 0 Response.Write fileTransfer.uploadedFileName & " is uploaded
" Response.Write FormatSize(fileTransfer.uploadedFileSize) & " (" & fileTransfer.uploadedFileSize & " bytes) written
" Response.Write "Content type: " & fileTransfer.contentType Response.Write "" Case 1 Response.Write "No file sent" Case 2 Response.Write "Path not found" Case 3 Response.Write fileTransfer.uploadedFileName & " can not be written" Case 4 Response.Write "Extension not allowed" End Select %>
">
<% Else %>
&popup=true">
<% End If %>
Upload | Close
<% Set fileTransfer = Nothing HtmlFooter DestroyApp() End Sub ' Downloads a file Sub Download() Dim fileTransfer, result on error resume next Set fileTransfer = New pluginFileTransfer If err.number<>0 Then Error "File Transfer Plugin Error", "Plugin cannot be initialized. Please make sure that the components required by the plugin is installed on the server.", false fileTransfer.path = WexMapPath(Request.QueryString("folder")) result = fileTransfer.Download(Request.QueryString("file")) Select Case result Case 0 'Success Case 1 Error "Download Error", "File not found. Please refresh the listing to see if the file actually exists.", false Case 2 Error "Download Error", "File cannot be read. Please make sure that you have read permission on the file.", false End Select Set fileTransfer = Nothing DestroyApp() End Sub ' ------------------------------------------------------------ %>