Site icon @Poremsky.com

Create a directory page using asp

I use this code (saved in a .asp page) to create the directly listing of all HTM and ASP pages in a folder. I also used this on my websites (as an include in other pages) to display a directory of all pages in a specific folder.

It's configured to list the newest pages first, oldest pages last but if you know ASP, you can easily change it.

Select all, copy, and paste into Notepad. Change
CONST DIRECTORY = "/subfolder"
to point to the correct folder.

Save using the .asp extension and upload to your webserver.

<%

dim url
' Change the DIRECTORY to point to any virtual directory of your choice.
CONST DIRECTORY = "/subfolder" ' relative path in virtual directories

' Used by "sortBy"...
CONST FILE_CREATED = 0
sortBy = 0
reverse = true

path = Server.MapPath( DIRECTORY ) 

Set fso = CreateObject("Scripting.FileSystemObject")
Set theCurrentFolder = fso.GetFolder( path ) 
Set curFiles = theCurrentFolder.Files 

Dim theFiles( )
ReDim theFiles( 500 ) ' arbitrary size!
currentSlot = -1 ' start before first slot

For Each fileItem in curFiles
If (right(fileItem,3) = "htm"  or right(fileItem,3) = "asp") and right(fileItem,9) <> "index.asp"   then
    fcreate = fileItem.DateCreated
    url = fileitem.path
    currentSlot = currentSlot + 1
    If currentSlot > UBound( theFiles ) Then
        ReDim Preserve theFiles( currentSlot + 99 )
    End If
    ' note that what we put here is an array!
    theFiles(currentSlot) = Array(fcreate,url)
End If   
Next

fileCount = currentSlot ' actually, count is 1 more, since we start at 0
ReDim Preserve theFiles( currentSlot ) ' really not necessary...just neater!

If VarType( theFiles( 0 )( sortBy ) ) = 8 Then 
    If reverse Then kind = 1 Else kind = 2 ' sorting strings...
Else
    If reverse Then kind = 3 Else kind = 4 ' non-strings (numbers, dates)
End If

For i = fileCount TO 0 Step -1
    minmax = theFiles( 0 )( sortBy )
    minmaxSlot = 0
    For j = 1 To i
            mark = (theFiles( j )( sortBy ) < minmax)
        If mark Then 
            ' yep, so remember this one instead!
            minmax = theFiles( j )( sortBy )
            minmaxSlot = j
        End If
    Next
    ' is the last slot the min (or max), as it should be?
        temp = theFiles( minmaxSlot )
        theFiles( minmaxSlot ) = theFiles( i )
        theFiles( i ) = temp
Next
%>

<%

For i = 0 To fileCount
  
  Dim objXMLHTTP, xml, url1
  
Set xml = Server.CreateObject("Microsoft.XMLHTTP")
 url1 = theFiles(i)(j)
         
  xml.Open "GET", url1, False
  xml.Send

 strContent = xml.ResponseText

  strBody = strContent
  If Len(strBody) > 0 then
    title_start = InStr(LCase(strBody), "<title>") + 7
    title_end = InStr(LCase(strBody), "</title>")

  End If

  If Len(Title_start) < 1 then
    strTitle  = "No Title"
  Else
    strTitle = mid(strBody, title_start, title_end - title_start)

  End If

  
Response.Write("<li><a href=""" & MapURL (url1) & """>" & strTitle & "</a></li>" & vbCrLf)

     next
     
 
 Set xml = Nothing

%>

<%
   function MapURL(path)

     dim rootPath, url

     'Convert a physical file path to a URL for hypertext links.
     
     rootPath = Server.MapPath("/")
     url = Right(path, Len(path) - Len(rootPath))
     MapURL = Replace(url, "", "/")

   end function
   %>
Exit mobile version