As promised days ago, I am posting my own Active Server Pages 3.0 script in doing a directory listing. Below code snippet not only perform directory listing, it also allows content (text) viewing.
Some configurations you can mess with
- Line 106 - 113: Specify file types to enable text content viewing
- Line 166: Specify the directory to start listing
<%@Language=VBScript%>
<%
' Copyright © Loh Hon Chun. All rights reserved.
' Experts-Exchange Profile: http://www9.brinkster.com/hongjun/ee/ee-profile.asp
' Email Loh Hon Chun at hongjun_wap [AT] yahoo [DOT] com to get permission
'**Start Encode**
Option Explicit
Response.Buffer = True
%>
<%
Response.Write "<html>"
Response.Write "<head>"
Response.Write "<title>"
Response.Write "Directory Listing: Copyright © Loh Hon Chun"
Response.Write "</title>"
Response.Write "<script language=""JavaScript"">" & vbCrlf
Response.Write "<!--" & vbCrlf
Response.Write "window.defaultStatus = 'Directory Listing: Copyright © Loh Hon Chun';" & vbCrlf
Response.Write "//-->" & vbCrlf
Response.Write "</script>" & vbCrlf
Response.Write "<style>"
Response.Write "a { color:#707070; text-decoration:none; }"
Response.Write "a:hover { color:#000000; text-decoration:none; }"
Response.Write "body {"
Response.Write " font-size:9pt;"
Response.Write " color: #2F4F4F;"
Response.Write " FONT-FAMILY: Arial;"
Response.Write " margin-top: 20px;"
Response.Write " margin-left: 50px;"
Response.Write "}"
Response.Write "h1 {"
Response.Write " font-weight: bold;"
Response.Write " font-size;14pt;"
Response.Write " font-family: Verdana;"
Response.Write " color: #BC8F8F;"
Response.Write "}"
Response.Write ".header {"
Response.Write " font-weight: bold;"
Response.Write " font-size:10pt;"
Response.Write " font-family: Verdana;"
Response.Write "}"
Response.Write ".contents {"
Response.Write " font-size:11pt;"
Response.Write " font-family: Verdana;"
Response.Write "}"
Response.Write "</style>"
Response.Write "<body>"
Response.Write "<h1>Directory Listing</h1>"
Response.Write ReadOutFile
Function ReadOutFile
Dim strFilePath
Dim fso, txtStream
Dim strContents
If Trim(Request.QueryString("f")) <> "" Then
strFilePath = Server.MapPath(Trim(Request.QueryString("f")))
' Display only if it is not the current running file
If Trim(Request.QueryString("f")) <> Right(Request.ServerVariables("PATH_INFO"), Len(Request.ServerVariables("PATH_INFO")) - InStrRev(Request.ServerVariables("PATH_INFO"), "/")) Then
Set fso = Server.CreateObject("Scripting.FileSystemObject")
If fso.FileExists(strFilePath) Then
Set txtStream = fso.OpenTextFile(strFilePath, 1)
strContents = Server.HTMLEncode(txtStream.ReadAll)
txtStream.Close
Set txtStream = Nothing
End If
Set fso = Nothing
ReadOutFile = "<font class=""contents"">Contents for: <b>" & Trim(Request.QueryString("f")) & "</b> [ <a href=""" & Request.ServerVariables("URL") & """>Close</a> ]</font>" & _
"<div style=""width:760px;height:300px;border-style:solid;border-width:1px;overflow:auto;"">" & _
"<pre>" & strContents & "</pre>" & _
"</div>" & _
""
End If
Else
ReadOutFile = ""
End If
End Function
Function ShowReadFileLink(strFilePath)
Dim str
Dim d
Dim strExt
strExt = UCase(Right(strFilePath, Len(strFilePath) - InStrRev(strFilePath, ".")))
Set d = Server.CreateObject("Scripting.Dictionary")
d.Add "TXT", "TXT"
d.Add "HTM", "HTM"
d.Add "HTML", "HTML"
d.Add "ASP", "ASP"
d.Add "INC", "INC"
d.Add "ASPX", "ASPX"
d.Add "JS", "JS"
d.Add "CSS", "CSS"
str = ""
' Do not show Read File for this current running file
If strFilePath <> Right(Request.ServerVariables("PATH_INFO"), Len(Request.ServerVariables("PATH_INFO")) - InStrRev(Request.ServerVariables("PATH_INFO"), "/")) Then
If d.Exists(strExt) Then
str = " [ <a href=""?f=" & Server.URLEncode(strFilePath) & """>Read</a> ]"
End If
End If
ShowReadFileLink = str
Set d = Nothing
End function
Function RecurseFolders(thisFolder)
Set objFolder = objFSO.GetFolder(thisFolder)
Dim strFilePath
If StrComp(objFolder, Server.MapPath("."), 1) = 0 Then
Response.Write "<font class=""header"">Current Directory</font>"
Else
Response.Write "<font class=""header"">" & Right(objFolder, Len(objFolder)-Len(Server.MapPath("."))) & "</font>"
End If
For Each objFile in objFolder.Files
If Mid(objFolder.Path, Len(folder) + 2, Len(objFolder.Path)) <> "" Then
strFilePath = Replace(Mid(objFolder.Path, Len(folder) + 2, Len(objFolder.Path)), "\", "/") & "/" & objFile.Name
Else
strFilePath = objFile.Name
End If
' Do not show Read File for this running file
If strFilePath <> Right(Request.ServerVariables("PATH_INFO"), Len(Request.ServerVariables("PATH_INFO")) - InStrRev(Request.ServerVariables("PATH_INFO"), "/")) Then
Response.Write " <a href=""./" & strFilePath & """>" & vbCrlf
Response.Write objFile.Name & ShowReadFileLink(strFilePath) & vbCrlf
Response.Write "</a>" & vbCrlf
End If
Next
Response.Write ""
If Not objFolder.Subfolders.Count = 0 Then
For Each objSFolder in objFolder.SubFolders
RecurseFolders(objSFolder)
Next
End If
End Function
Dim objFSO, objFolder, objFile, objSFolder
Dim folder
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
folder = Server.MapPath(".")
Call RecurseFolders(folder)
Response.Write "</body>"
Response.Write "</html>"
%>
Singapore 2010 Impression in a hilarious but meant no malicious intent
