Does your knowledge of the FileSystem Object need some refreshing?
Here is a handy little example of how to use what and where.
It could also serve some administration functions as well.
In fact, I find it very useful. My office has very tight security rules, one
of which is that all FTP ports are shut off. Which means that if I am at
work, I can't get anything off my home PC, unless it is inside of an IIS
virtual directory. Well, not anymore! I just connect to my home web
server, pull up the folder list page, and I have instant
access to any file on my home computer.
It will allow you to choose the drive to search, and then it will build a listbox of all the folder paths on that drive.
Choose the Folder Path and it will build a listbox of all the files in that folder.
Choose a File and, if it is a text file type, will display the contents in the browser, if it is a binary file, it will prompt you to save the file to your hard drive.
This can come in handy for server maintenance, since it will allow you to view and download Files/Folders that are not web enabled (outside a virtual directory).
To handle the download, I have a small DLL that will read the binary data of the file and send it back as a binary stream via the ASP Response.BinaryWrite Function.
You can still use this example without the DLL; you will just lose the Save to Disk Method. The Compiled DLL is also included, so you can just register it on your server if you don't want to make it yourself.
Create a new ActiveX DLL project in Visual Basic 5.0 or later.
Rename the project FileSave.
Rename the class module BinRead.
Cut and paste the following code into the General Declarations section of the class module:
Function readBinFile(ByVal bfilename As String) As Variant
Dim fl As Long
Dim FileNum As Long
Dim binbyte() As Byte
Dim binfilestr As String
On Error GoTo errHandler
FileNum = FreeFile
Open bfilename For Binary Access Read As #FileNum
fl = FileLen(bfilename)
ReDim binbyte(fl)
Get #FileNum, , binbyte
Close #FileNum
readBinFile = binbyte
Exit Function
errHandler:
Exit Function
End Function
Save the project.
On the File menu click Make FileSave.dll.
All set, then let's start coding.
First we want to set up at least some level of security, I recommend using NT permissions on this file, but
let's at least setup some simple asp based authentication. The following code will redirect to ASP 101 if the client has
not supplied the correct username in the query string (www.mysite.com/newFolders.asp?user=me)
<%
Session("user") = Request.QueryString("user")
IF Session("user") <> "me" Then
Response.Redirect("http://www.asp101.com/")
End IF
%>
Now let's start building our file access methods. We are going to wrap them in a class, so that we may reuse expensive
objects using a custom property.
Class clsIterate
Private m_oFS
Public Property Let oFS(objOFS) 'Property to Hold oFS Pointer
m_oFS = objOFS
End Property
Public Property Get oFS()
Set oFS = Server.CreateObject("Scripting.FileSystemObject")
End Property
Let's add some time saving routines for cleaning up objects and using Response.Write
Function Echo(str)
Echo = Response.Write(str & vbCrLf)
End Function
Function EchoB(str)
EchoB = Response.Write(str & "<BR>" & vbCrLf)
End Function
Sub Cleanup(obj)
If isObject(obj) Then
Set obj = Nothing
End IF
End Sub
Next we need to set up our routine to build the drives list box.
Since I don't know what drives you may have; or how many, we will loop thru all the drives on the computer, checking to see if they are available, if so, we will add it to our listbox.
Sub BuildDriveList(strDrive)
Set oDrives = oFS.Drives
EchoB("<B>Select Drive</B>")
Echo("<SELECT NAME=frmDrives>")
For Each DrivePath in oDrives
If DrivePath.isReady Then
IF strDrive = DrivePath.DriveLetter Then
strSelected = " SELECTED"
Else
strSelected = Null
End IF
Echo("<OPTION VALUE=" & Chr(34) & DrivePath.DriveLetter _
& Chr(34) & strSelected & ">" & DrivePath.DriveLetter _
& "</OPTION>")
End IF
Next
EchoB("</SELECT>")
Cleanup oDrives
End Sub
Now that we have a listbox containing all the available drives, we need a routine that will iterate all the directories
on that drive. Word of warning in advance, the more folders on the drive, the longer this routine will take to complete when run. This Sub will take 2 parameters, the parent Folder (in our case, a drive object) of the directory to start at and the current path (if any), to bookmark our place in the listbox.
Sub BuildFolderList(objParentFolder, strCurrentPath)
Dim objFolder, objSubFolder, objFile
'Create a subfolder Object for the current Parent Folder
Set objSubFolder = objParentFolder.SubFolders
'Some WILL Throw Permission Denied Errors -Just Skip Em
On Error Resume Next
'Loop thru each Folder in the Parent's Subfolders
For Each objFolder In objSubFolder
'Insert SELECTED into the Option list to save our place.
IF strCurrentPath = objFolder.Path Then
strSelected = " SELECTED"
Else
strSelected = Null
End IF
Echo("<OPTION STYLE=" & Chr(34) & "font-size: 10px" & Chr(34) _
& " VALUE=" & Chr(34) & objFolder.Path & Chr(34) _
& strSelected & ">" & objFolder.Path & "</OPTION>")
'Recursive Call To Iterate Entire Drive
BuildFolderList objFolder, strCurrentPath
Next
Cleanup objSubFolder
Cleanup objParentFolder
End Sub
Let's do the same thing as above, but for a FileList this time.
Sub BuildFileList(strFolder)
'We Know it Exists so Just Get it
Set oFolder = oFS.getFolder(strFolder)
EchoB("<B>Select File</B>")
Echo("<SELECT NAME=frmFiles>")
For Each FileName in oFolder.Files
Echo("<OPTION STYLE=" & Chr(34) & "font-size: 10px" _
& Chr(34) & " VALUE=" & Chr(34) & FileName.Path _
& Chr(34) & ">" & FileName.Path & "</OPTION>")
Next
EchoB("</SELECT>")
Cleanup oFolder
End Sub
Next is a simple Select case statement to determine if we are viewing a text based file type or not.
Feel free to add your own here, as I am sure I missed a few.
Function FileType(strFile)
strExt = lcase(Right(strFile, 4))
Select Case strExt
Case ".txt"
FileType = "Text"
Case ".inf"
FileType = "Text"
Case ".asp"
FileType = "Text"
Case ".htm"
FileType = "Text"
Case ".vbs"
FileType = "Text"
Case ".log"
FileType = "Text"
Case ".vbp"
FileType = "Text"
Case ".cls"
FileType = "Text"
Case ".dsw"
FileType = "Text"
Case ".inc"
FileType = "Text"
Case ".dsp"
FileType = "Text"
Case ".ini"
FileType = "Text"
Case Else
FileType = "Binary"
End Select
End Function
Here comes my favorite part! This next function will add the appropriate headers for a binary file, as well as the correct file size (so the download progress bar works correctly), and force a 'Save File' dialogue box in Internet Explorer by setting the Content-Disposition to attachment and writing the file as a binary stream (Passed back from our fileSave.dll). For more information on forcing downloads and using Content-Disposition see RFC 2183.
Sub AddHeaders(strFilePath)
strFileType = lcase(Right(strFile, 4))
Set oFile = oFS.GetFile(strFilePath)
Select Case strFileType
Case ".asf"
ContentType = "video/x-ms-asf"
Case ".avi"
ContentType = "video/avi"
Case ".doc"
ContentType = "application/msword"
Case ".zip"
ContentType = "application/zip"
Case ".xls"
ContentType = "application/vnd.ms-excel"
Case ".gif"
ContentType = "image/gif"
Case ".jpg", "jpeg"
ContentType = "image/jpeg"
Case ".wav"
ContentType = "audio/wav"
Case ".mp3"
ContentType = "audio/mpeg3"
Case ".mpg", "mpeg"
ContentType = "video/mpeg"
Case ".rtf"
ContentType = "application/rtf"
Case Else
'Handle All Other NON-Text Files
ContentType = "application/octet-stream"
End Select
'********************************************************
' NOTE: PRE IE 5.5 SP1 has a Bug that will display known
' file types in the Browser Thus ignoring the attachment
' disposition. The Simple object I am using alleviates
' this problem on Pre IE 5.5 Browsers
'********************************************************
'Clear Response Collection So BinaryWrite Can Complete
Response.Clear
Response.AddHeader "Content-Disposition", _
"attachment; filename=" & oFile.name
'Specify size so that the browser's progress bar works properly
Response.AddHeader "Content-Length", oFile.size
Response.ContentType = ContentType
'Read Binary Bytes
Set oSave = Server.CreateObject("FileSave.binRead")
'Get Binary data from the DLL
vntStream = oSave.readBinFile(strFilePath)
'Force Save Dialogue in Browser
Response.BinaryWrite(vntStream)
Cleanup strFile
cleanup oFile
End Sub
End Class
All that's left to do now is to call our routines from inside the BODY of our asp page.
Here is the code.
Dim frmDrives, frmFolders, frmFiles
frmDrive = Request.Form("frmDrives")
frmFolder = Request.Form("frmFolders")
frmFile = Request.Form("frmFiles")
Set Iterate = New clsIterate
Call Iterate.BuildDriveList(frmDrive)
IF frmDrive <> "" Then
Set objFS = Server.CreateObject("Scripting.FileSystemObject")
Set oDrive = objFS.GetDrive(frmDrive)
Set oRootDir = oDrive.RootFolder
Iterate.EchoB("<B>Select Folder</B>")
Iterate.Echo("<SELECT NAME=frmFolders STYLE=" & Chr(34) _
& "font-size: 10px" & Chr(34) & ">")
'Used To Change Drives
Iterate.Echo("<OPTION VALUE="""">- None -</OPTION>")
Call Iterate.BuildFolderList(oRootDir, frmFolder)
Iterate.EchoB("</SELECT>")
End IF
IF frmFolder <> "" Then
'Build Options
Call Iterate.BuildFileList(frmFolder)
End IF
Iterate.Echo("<INPUT TYPE=" & Chr(34) & "SUBMIT" & Chr(34) _
& " VALUE=" & Chr(34) & "Go Get It" & Chr(34) & ">")
Iterate.Echo("</TD>")
Iterate.Echo("</TR><TR><TD VALIGN=TOP CLASS=dispSource>")
IF frmFile <> "" Then
Iterate.EchoB(Iterate.FileType(frmFile))
IF Iterate.FileType(frmFile) = "Text" Then
Set oText = objFS.OpenTextFile(frmFile, 1, True)
Do While Not oText.AtEndOfStream
Data = Server.HTMLEncode(Trim(oText.Readline))
tempData = tempData & Data & "<BR>"
Loop
Iterate.Echo(tempData)
Else
Iterate.AddHeaders frmFile
End IF
End IF
Set oText = Nothing
Iterate.Cleanup oDrive
Iterate.Cleanup oRootDir
Iterate.Cleanup objFS
Set Iterate = Nothing
That's it, you can now get any file off your home or office computer from anywhere with an Internet connection.
