<%@ Language=VBScript %>
<%Option Explicit%>
<%
Const appName = "WebFTP"
Const appVersion = ""
%>
<%
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 Free Functions -------------------------------
' Initializes some variables, creates instances of some objects and ensures security
Sub InitApp()
scriptName = Request.ServerVariables("SCRIPT_NAME")
wexId = appName & appVersion & "-"
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("/"&session("pasta"))
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()
%>
<%
End Sub
' Writes the stylesheet
Sub HtmlStyle()
%>
<%
End Sub %>
<%
' Writes the javascript code
Sub HtmlJavaScript()
%>
<%
End Sub
Sub Login()
If session("command") = "Login" Then
Dim rsValida
Dim conexaodb
Dim strValida
Set conexaodb = Server.CreateObject("ADODB.Connection")
conexaodb.connectionstring = "provider=microsoft.jet.oledb.4.0;data source=e:\home\estacaodesigngrafico\dados\webftp.mdb"
conexaodb.Open
set rsValida = Server.CreateObject("ADODB.Recordset")
strValida = "SELECT * FROM usuarios "
strValida = strValida & "WHERE login = '" & session("login") & "' "
strValida = strValida & " And senha = '" & session("senha") & "' "
set rsValida = conexaodb.Execute(strValida)
if not rsValida.eof then
Session(wexId & "Login") = true
session("pasta") = rsValida("pasta")
session("permissao") = rsValida("permissao")
Exit Sub
Else
wexMessage = "Usu嫫io ou senha inv嫮ido!"
response.Redirect "../index.htm"
End If
End If
HtmlHeader appName
If(wexMessage<>"") Then Response.Write ""
%>
<%
HtmlFooter
DestroyApp()
End Sub
' Writes file listing of the given folder
Sub List()
Dim objFolder, virtual, folder
Dim item, arr
Dim rowType
Dim listed
HtmlHeader appName
on error resume next
Set objFolder = FSO.GetFolder(targetPath)
If err.Number<>0 Then wexMessage = "Erro ao abrir pasta!"
virtual = VirtualPath(targetPath)
folder = right(targetPath, len(targetPath)-len(wexRootPath))
%>
<%
If wexMessage="" Then
If (objFolder.subfolders.Count + objFolder.files.Count) <> listed Then
wexMessage = "Listando " & listed & " of " & (objFolder.subfolders.Count + objFolder.files.Count) & " item(s) , " & (objFolder.subfolders.Count + objFolder.files.Count - listed) & " item(s) are hidden..."
Else
wexMessage = "Listando " & (objFolder.subfolders.Count + objFolder.files.Count) & " item(s)..."
End If
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
' Relogin message for the popup windows
Sub PopupRelogin()
HtmlHeader appName
%>
<%=appName%> session is destroyed, please
relogin.
![]()
"
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("/"&session("pasta"),1) = "/" Then
VirtualPath = FixPath("/"&session("pasta"), "/")
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
' 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 = "Crear nova Pasta""" & 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
FSO.CreateTextFile(itemPath)
If err.Number <> 0 Then
wexMessage = "Unable to create the file """ & itemName & """, an error occured..."
Else
wexMessage = "Crear novo arquivo""" & 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 = "Deletar Pasta""" & 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 = "Deletar arquivo""" & 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 = "Renomear Pasta""" & 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
itemPath = targetPath & itemName
Set item = FSO.GetFile(itemPath)
item.Name = newName
If err.Number <> 0 Then
wexMessage = "Unable to rename the file """ & itemName & """, an error occured..."
Else
wexMessage = "Renomear Arquivo""" & 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 Free 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
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
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 = "O arquivo """ & fileName & """ n緌 existe"
Set file = FSO.CreateTextFile (filePath, false)
If err.Number<>0 Then
wexMessage = wexMessage & ", also unable to create new file."
err.Clear
Else
wexMessage = wexMessage & ", novo arquivo criado."
End If
Else
Set file = FSO.OpenTextFile (filePath, 1, false, encoding)
If err.Number<>0 Then
wexMessage = "Can not read from the file """ & fileName & """, permiss緌 bloqueada!"
err.Clear
End If
End If
End Select
HtmlHeader appName
If(wexMessage<>"") Then Response.Write ""
%>
<%
Set file = Nothing
HtmlFooter
DestroyApp()
End Sub
' WebExplorer Free 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
%>
<%
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
%>
<%
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)%> |
<%
Server.ScriptTimeout = 5500
Response.Buffer = true
on error resume next
%>
<%
'Exibe o formul嫫io se action for diferente de upload
response.write folder
If Trim(Request.QueryString("action")) <> "upload" Then
%>
<%
End If
'Se ocorrer, exibe mensagem de erro gerada no upload
If Trim(Request.QueryString("Message")) <> "" Then %>
Erro:
<%
Response.Write Trim(Request.QueryString("Message"))
End If
'Faz o upload se action for igual a upload
If Trim(Request.QueryString("action")) = "upload" Then
'declara as vari嫛eis
dim objUpload
'cria inst滱cia do objeto
set objUpload = server.CreateObject("Dundas.Upload.2")
'verifica um poss癉el erro
if err.number <> 0 then
Response.Redirect "?Message=" & err.description
end if
'estipula o tamanho m嫞imo do arquivo
objUpload.MaxFileSize = 1073741824
'formatando o nome do arquivo
objUpload.UseUniqueNames = false
'informa o path onde os arquivos ser緌 salvos
'obs: o diret鏎io deve ter permiss緌 de escrita
objupload.save "e:\home\estacaodesigngrafico\web\webftp\"&folder
if err.number <> 0 then
Response.Redirect "?Message=" & err.description
end if
'destroi o objeto
set objUpload = nothing
%>
Upload realizado com sucesso.
<%
End If
%>
|
<%
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
' ------------------------------------------------------------
%>