Search This Blog

Google Analytics

Monday, April 21, 2008

Directory Listing in ASP

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>"
%>

1 comment:

  1. I really find very easy to do directory listing along with content viewing in ASP. Good doing.

    ReplyDelete

Do provide your constructive comment. I appreciate that.

Popular Posts