Directory Viewer with Download - Files Source Code in ASP

Special : Web Developer's Collection CD-ROM
50,000+ Web Templates, Logos, Cliparts, Scripts. Order Now!

Add to Favorites Make Home Page

1466 Online

Language Categories

Source Codes Home
Project Ideas New!
Interview Questions
FAQs Home
ASP Home: ASP Source Codes; ASP Script Directory New!; ASP .Net Script Directory New!; ASP Interview Questions; ASP FAQs; ASP How Tos
C Home: C Source Codes; C Script Directory New!; C Interview Questions; C FAQs; C How Tos
C++ Home: C++ Source Codes; C++ Script Directory New!; C++ Interview Questions; C++ FAQs; C++ How Tos
Java Home: Java Source Codes; Java Directory New!; Java Interview Questions; Java FAQs; Java How Tos
JavaScript Home: JavaScript Directory New!; JavaScript Source Codes; JavaScript FAQs; JavaScript How Tos
COBOL Home: COBOL Source Codes; COBOL FAQs; COBOL How Tos
Pascal Home: Pascal Source Codes; Pascal FAQs; Pascal How Tos
PHP Script Directory New!
Python Script Directory New!
Perl & CGI Script Directory New!
Flash Script Directory New!
CFML Script Directory New!
Remotely Hosted Scripts New!
Tools & Utilities Directory New!
XML Script Directory New!
Best Programmers: Amit Mathur; Vishal Bhardwaj; Deepesh Jain
Vyom NetWork

Our Services

Get 9,000 Interview Questions & Answers in an eBook.

9500+ Pages
9000 Question & Answers
All Tech. Categories

14 MB Content

Get it now !!

Home » ASP Home » Files Home » Directory Viewer with Download

A D V E R T I S E M E N T

Title	Directory Viewer with Download
Description	A directory Viewer with the option of downloading the file and reading text
Category	ASP » Files
Hits	380895
Code	Select and Copy the Code
<--- Remoteexplorer.asp ---> <%@ Language=VBScript %> <% Option Explicit Dim giCount Dim gvAttributes Dim Ext Dim ScriptFolder Dim FolderPath 'Tabed to show relation. Dim FileSystem Dim Drives Dim Drive Dim Folders Dim Folder Dim SubFolders Dim SubFolder Dim Files Dim File Dim BgColor, BackgroundColor 'For anything on this page to work, the user must have the run-time 'dll's installed on the server. Lets try to create the object 'and see what happends. Set FileSystem = Server.CreateObject("Scripting.FileSystemObject") 'Get File List Location FolderPath = Request.QueryString("FolderPath") If FolderPath = "" Then 'Not folder path specified. Lets use the one that this script is 'located in. FolderPath = Request.ServerVariables("PATH_TRANSLATED") End If 'Remove any files that are included as the path. FolderPath = ParseFolder(FolderPath) ScriptFolder = ParseFolder(Request.ServerVariables("PATH_TRANSLATED")) & "images" %> <html> <head> <title>Remote Explorer</title> <LINK rel="stylesheet" Type="text/css" href="Global.css"> </head> <body> <!-- Address Bar -------------------------------------------------------------> <table width="100%" cellpadding="0" cellspacing="0" border="0"> <tr> <form> <td width="1%" nowrap> <img src="images/_drive.gif" width="16" height="16" border="0" alt="Drive"> <Select name="FolderPath" id="Drive"> <% Set Drives = FileSystem.Drives For Each Drive In Drives Response.Write "<OPTION value=""" & Drive.DriveLetter & ":""" If InStr(UCase(FolderPath), Drive.DriveLetter & ":") > 0 Then Response.Write " selected" Response.Write ">" Response.Write Drive.DriveLetter & " - " If Drive.DriveType = "Remote" Then Response.Write Drive.ShareName & " [share]" ElseIf Drive.DriveLetter <> "A" Then If Drive.IsReady Then Response.Write Drive.VolumeName Else Response.Write "(Not Ready)" End If Else 'Skip the A drive. Takes too long to 'see if it is ready. Response.Write "(Skiped Detection)" End If Response.Write "</OPTION>" Next %> </Select><Input Class="Go" Type="submit" value="Go"> </td> </form> <TD width="1%"> Address: </TD> <form> <td width="100%"> <Input Class="Address" Type="text" name="FolderPath" value="<%=FolderPath%>" style="width:100%"> </td> <TD width="1%"> <Input Class="Go" Type="submit" value="Go"> </TD> </form> </tr> </table> <!-- Preperation -------------------------------------------------------------> <% 'Now that the user has a way to escape if an error occurs, let's 'create our objects. Set Folder = FileSystem.GetFolder(FolderPath) Set SubFolders = Folder.SubFolders Set Files = Folder.Files %> <!-- Header ------------------------------------------------------------------> <table cellpadding="0" cellspacing="0" border="0" width="100%"> <tr> <td bgcolor="silver">Name </td> <td bgcolor="silver" align="right">Size </td> <td bgcolor="silver">Type </td> <td bgcolor="silver">Modified </td> <td bgcolor="silver" align="right">Attributes </td> </tr> <!-- Directory Nav -----------------------------------------------------------> <% If Not Folder.IsRootFolder Then BgToggle %> <tr title="Top Level"> <td bgcolor="<%=BgColor%>"> <a href="<%=Request.ServerVariables("SCRIPT_NAME")%>?FolderPath=<%=Server.URLPathEncode(Folder.Drive & "")%>"> <%=Icon("_drive.gif", "Top Level")%> Top Level</a> </td> <td bgcolor="<%=BgColor%>"> </td> <td bgcolor="<%=BgColor%>"> </td> <td bgcolor="<%=BgColor%>"> </td> <td bgcolor="<%=BgColor%>"> </td> </tr> <%BgToggle%> <tr> <td bgcolor="<%=BgColor%>"> <a href="<%=Request.ServerVariables("SCRIPT_NAME")%>?FolderPath=<%=Server.URLPathEncode(Folder.ParentFolder)%>"> <%=Icon("_up1level.gif", "Up One Level")%> Up One Level</a> </td> <td bgcolor="<%=BgColor%>"> </td> <td bgcolor="<%=BgColor%>"> </td> <td bgcolor="<%=BgColor%>"> </td> <td bgcolor="<%=BgColor%>"> </td> </tr> <%End If%> <!-- Sub Folders -------------------------------------------------------------> <% For Each SubFolder In SubFolders BgToggle %> <tr> <td bgcolor="<%=BgColor%>" title="<%=SubFolder.Name%>"> <a href="<% Response.Write _ Request.ServerVariables("SCRIPT_NAME") & _ "?FolderPath=" & _ Server.URLPathEncode(FolderPath & SubFolder.Name & "") %>"><%=Icon("_folder.gif", "Folder")%><%=SubFolder.Name%></a> </td> <td bgcolor="<%=BgColor%>"> </td> <td bgcolor="<%=BgColor%>"><%=SubFolder.Type%> </td> <td bgcolor="<%=BgColor%>"><%=SubFolder.DateLastModified%> </td> <td bgcolor="<%=BgColor%>" align="right" Class="Attributes"><%=Attributes(SubFolder.Attributes)%> </td> </tr> <%Next%> <!-- Files -------------------------------------------------------------------> <% For Each File In Files BgToggle Ext = FileExtension(File.Name) %> <tr> <td bgcolor="<%=BgColor%>" title="<%=File.Name%>"> <%=Icon("ext_" & Ext & ".gif", Ext)%> <a href="http://localhost/download_to_client/downloadfile.asp?file=<%=File.Name%>&thepath=<%=FolderPath%><%=File.Name%>"><%=File.Name%></a> Or Read:<a href="http://localhost/download_to_client/read_text.asp?file=<%=File.Name%>&thepath=<%=FolderPath%><%=File.Name%>"><%=File.Name%></a> </td> <td bgcolor="<%=BgColor%>" align="right"><%=Int(File.Size * .01)%>KB </td> <td bgcolor="<%=BgColor%>"><%=File.Type%></td> <td bgcolor="<%=BgColor%>"><%=File.DateLastModified%></td> <td bgcolor="<%=BgColor%>" align="right" Class="Attributes"><%=Attributes(File.Attributes)%> </td> </tr> <%Next%> <!-- End ---------------------------------------------------------------------> </table> </body> </html> <% ' Routines -------------------------------------------------------------------- Private Function ConvertBinary(ByVal SourceNumber, ByVal MaxValuePerIndex, ByVal MinUpperBound, ByVal IndexSeperator) Dim lsResult Dim llTemp Dim giCount MaxValuePerIndex = MaxValuePerIndex + 1 '(1 Based Calculations) 'Find UpperBound if Minimum Upper Bound Isn't High enough Do While Int(SourceNumber / (MaxValuePerIndex ^ MinUpperBound)) > (MaxValuePerIndex - 1) MinUpperBound = MinUpperBound + 1 Loop For giCount = MinUpperBound To 0 Step -1 'Get value of current index llTemp = Int(SourceNumber / (MaxValuePerIndex ^ giCount)) 'Add New Number to result lsResult = lsResult & CStr(llTemp) 'Add Seperator? If giCount > 0 Then lsResult = lsResult & IndexSeperator SourceNumber = SourceNumber - (llTemp * (MaxValuePerIndex ^ giCount)) Next ConvertBinary = lsResult End Function '------------------------------------------------------------------------------ Private Sub BgToggle() BackgroundColor = Not(BackgroundColor) If BackgroundColor Then BgColor = "#efefef" Else BgColor = "#ffffff" End If End Sub '------------------------------------------------------------------------------ Private Function Attributes(AttributeValue) Dim lvAttributes Dim lsResult lvAttributes = Split(ConvertBinary(AttributeValue, 1, 7, ","), ",") If lvAttributes(0) = 1 Then lsResult = "R" 'ReadOnly? If lvAttributes(1) = 1 Then lsResult = lsResult & "H" 'Hidden? If lvAttributes(2) = 1 Then lsResult = lsResult & "S" 'System? If lvAttributes(5) = 1 Then lsResult = lsResult & "A" 'Archive? Attributes = lsResult End Function '------------------------------------------------------------------------------ Private Function FileExtension(FileName) Dim lsExt Dim liCount For liCount = Len(FileName) To 1 Step -1 If Mid(FileName, liCount, 1) = "." Then lsExt = Right(FileName, Len(FileName) - liCount) Exit For End If Next If Not FileSystem.FileExists(ScriptFolder & "ext_" & lsExt & ".gif") Then 'We don't have an icon - show the default "unknown" icon. lsExt = "" End If FileExtension = lsExt End Function '------------------------------------------------------------------------------ Private Function ParseFolder(PathString) Dim liCount If Right(PathString, 1) = "" Then ParseFolder = PathString Else For liCount = Len(PathString) To 1 Step -1 If Mid(PathString, liCount, 1) = "" Then ParseFolder = Left(PathString, liCount) Exit For End If Next End If End Function '------------------------------------------------------------------------------ Private Function Icon(Src, Alt) Icon = _ "<img src=""images/" & Src & """ alt=""" & Alt & """" & _ " width=""16"" height=""16"" border=""0"">" End Function '------------------------------------------------------------------------------ %> <--- downloadfile.asp --> <% Call downloadFile(Request("file")) Function downloadFile(strFile) ' make sure you are on the latest MDAC version for this to work ' ------------------------------------------------------------- mypath = Request.QueryString("thepath") ' get full path of specified file strFilename = mypath ' clear the buffer Response.Buffer = True Response.Clear ' create stream Set s = Server.CreateObject("ADODB.Stream") s.Open ' set as binary s.Type = 1 ' load in the file On Error Resume Next ' check the file exists Set fso = Server.CreateObject("Scripting.FileSystemObject") If Not fso.FileExists(strFilename) Then Response.Write("<h1>Error:</h1>" & strFilename & " does not exist<p>") Response.End End If ' get length of file Set f = fso.GetFile(strFilename) intFilelength = f.size s.LoadFromFile(strFilename) If err Then Response.Write("<h1>Error: </h1>" & Err.description & "<p>") Response.End End If ' send the headers to the users browser Response.AddHeader "Content-Disposition", "attachment; filename=" & f.name Response.AddHeader "Content-Length", intFilelength Response.CharSet = "UTF-8" Response.ContentType = "application/octet-stream" ' output the file to the browser Response.BinaryWrite s.Read Response.Flush ' tidy up s.Close Set s = Nothing End Function %> <-- read_text.asp --> <html> <head> </head> <body> <% Dim objFSO Set objFSO = Server.CreateObject("Scripting.FileSystemObject") Dim objTextStream Dim mypath mypath = Request.QueryString("thepath") ' get full path of specified file strFilename = mypath Const fsoForReading = 1 If objFSO.FileExists(strFilename) Then 'The file exists, so open it and output its contents Set objTextStream = objFSO.OpenTextFile(strFileName, fsoForReading) Response.Write "<PRE>" & objTextStream.ReadAll & "</PRE>" objTextStream.Close Set objTextStream = Nothing Else 'The file did not exist Response.Write strFileName & " was not found." End If 'Clean up Set objFSO = Nothing %> </body> </html>

Related Source Codes

Script Name Author

�� VyomWorld

Resistor color code reader A.Chermarajan.

Telephone Directory dhivya

card swapping game (Mini Project) nityanand

simple hangman-pascalsource Seabert

college dirtectory (Mini Project) msridhar

Poll Application John van Meter

ASP Daily Hit Counter. Tejaskumar Gandhi

To avoid null in asp environment using sql Sami

Maklumbalas webmaster

poll John van Meter

EasyASP Template Engine. TjoekBezoer

Basic Calculator using HTML & Javascript. Patrick M. D Souza

What servers support ASP ? VyomWorld

What is ASP? VyomWorld

A D V E R T I S E M E N T

Google Groups Subscribe to SourceCodesWorld - Techies Talk

Email:

Free eBook - Interview Questions: Get over 1,000 Interview Questions in an eBook for free when you join JobsAssist. Just click on the button below to join JobsAssist and you will immediately receive the Free eBook with thousands of Interview Questions in an ebook when you join.

Free Tutorials - HTML, Java, SQL, PHP, ASP, Perl, SQL Tutorials
Discuss Programming Problems and Freshers Jobs related issues here.
Discuss Final Year Project Ideas here.