%
Dim asp_self
Dim objFSO, strCurrentFolder, objFolder, strRootFolder, strRootFolder2, strRootFolder3
Dim strRootFolder4
Dim objFSO2, objFolder2
Dim IconImagePath
IconImagePath = "../../includes-resources/images/site/"
'What is the maximum size of a file in bytes?
Const MaxSize = 1000000
'What is the root of the site?
' Need to work out where includes-resources is
strRootFolder4 = left(Request.Servervariables("PATH_INFO"),len(Request.Servervariables("PATH_INFO")) - len("browseimage.asp") )
'strRootFolder = request.ServerVariables("APPL_PHYSICAL_PATH") & "\includes-resources\"
'strRootFolder = request.ServerVariables("APPL_PHYSICAL_PATH")
'strRootFolder = request.ServerVariables("APPL_PHYSICAL_PATH") & "admin\images\email\"
strRootFolder2 = request.ServerVariables("APPL_PHYSICAL_PATH")
strRootFolder4 = replace(strRootFolder4, "/", "\")
strRootFolder4 = right(strRootFolder4, len(strRootFolder4) - 1)
strRootFolder3 = strRootFolder4 & "..\..\includes-resources\"
strRootFolder = request.ServerVariables("APPL_PHYSICAL_PATH") & strRootFolder4 & "..\..\includes-resources\"
'strRootFolder4 = replace(strRootFolder4, "/", "\")
'response.write(strRootFolder3)
'response.write(Request.Servervariables("PATH_INFO"))
'Response.End
'this script's name. It is better than hard coding :-)
asp_self = Request.Servervariables("PATH_INFO")
strCurrentFolder = ""
Dim arrValidFileTypes
'This guy determines what kind of file types are visible
'to the users
arrValidFileTypes = Array("html","htm","doc","pdf","xls","ppt","txt","jpg","gif")
Sub MainProcess()
'If a parameter dir is passed, use that.
If Request.QueryString("dir") <> "" Then
strCurrentFolder = Request.QueryString("dir")
End If
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strRootFolder & strCurrentFolder)
DisplayDirectory objFolder
'many thanks to Microsoft's memory management "features".
Set objFSO = Nothing
Set objFolder = Nothing
End Sub
''' The following is the main function here.
''' This guy shows the contents of a folder
''' and makes links to this script for showing the
''' contents of a sub folder
Sub DisplayDirectory(objFolder)
Dim objFile, objSubFolder
Set objFSO2 = Server.CreateObject("Scripting.FileSystemObject")
Set objFolder2 = objFSO2.GetFolder(strRootFolder)
' Only make a link to the parent folder if is not the root folder
'response.write(objFolder.path & "
" & objFolder2.path )
if len(objFolder.path) > len(objFolder2.path) then
'make link(s) to the parent(s)
'PrintHeaderLinks(objFolder.Path)
'Display a link to the parent directory
PrintHeaderLinks objFolder2.Path,objFolder.Path
end if
'Display every file in the folder, that matches the
'extension given in arrValidFileTypes
For Each objFile in objFolder.Files
If UBound(Filter(arrValidFileTypes,GetExtension(objFile.Name),True,vbTextCompare)) = 0 Then
' print an icon for the extension
Response.Write ""
''' make the link to copy it to some form field
PrintCopyLink strRootFolder3 & objFile.Path, objFile.Name
'''Two samples for spicying up things
'' You can keep a library of icons and using the file extension
'' show the relevant icon
'''Here is a sample to see if the file is a restricted one
If GetExtension(objFile.Name) = "exe" then
Response.Write " EXE?"
End if
'''Another sample to warn for large file size
If objFile.Size > MaxSize then
Response.Write " " & objFile.Size & ""
End If
Response.Write "
" & vbCrLf
End If
Next
'Now make links to see the sub folders
For Each objSubFolder in objFolder.SubFolders
'Response.Write " " & objSubFolder.Name & "
" & vbCrLf
'response.write(objSubFolder.Path)
Response.Write " " & objSubFolder.Name & "
" & vbCrLf
'response.write(CutRootFolder2(objFolder2.Path, objSubFolder.Path))
'''Iteration might be very time consuming for large directories
'''If you choose to, you can experiment by uncommenting the
'''line below. May be with a Javascript that can manipulate
'''tree?
'DisplayDirectory objSubFolder
Next
End Sub
'''Get the extension of a file. You might want to see objFile.Type too
Function GetExtension(strFileName)
GetExtension = LCase(Right(strFileName,(Len(strFileName)-InStrRev(strFileName,"."))))
End Function
'''Utility function. Returns the path minus root folder path
Function CutRootFolder(strSubFolder)
If Len(strSubFolder) > Len(strRootFolder) Then
CutRootFolder = Right(strSubFolder,(Len(strSubFolder)-Len(strRootFolder)))
Else
CutRootFolder = ""
End If
End Function
Function CutRootFolder2(strFolder, strSubFolder)
If Len(strSubFolder) > Len(strFolder) Then
CutRootFolder2 = Right(strSubFolder,(Len(strSubFolder)-Len(strFolder)))
Else
CutRootFolder2 = ""
End If
End Function
'''Utility function. Make a navigation bar to go to parent folders
Sub PrintHeaderLinks(strFolderRootPath, strFolderPath)
Dim arrFolders, i, prevFolder, x
arrFolders = split(strFolderPath,"\")
prevFolder = ""
If strFolderPath <> "" Then
Response.Write "" & strCurrentFolder & "
" & vbCrLf
For i = 0 To UBound(arrFolders)
if len(prevFolder & "\" & arrFolders(i)) > len(strFolderRootPath) then
Response.Write "
" & vbCrLf
For x = 0 To i
Response.Write " "
Next
If i = UBound(arrFolders) Then
Response.Write "" & arrFolders(i) & "
" & vbCrLf
Else
Response.Write "" & arrFolders(i) & "" & vbCrLf
End If
prevFolder = prevFolder & "\" & arrFolders(i)
end if
Next
End If
End Sub
%>