Add to Favorites    Make Home Page 7947 Online  
 Language Categories  
 Our Services  

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

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

Search Projects & Source Codes:

Title Directory Viewer with Download
Description A directory Viewer with the option of downloading the file and reading text
Category ASP » Files
Hits 3643
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.

New! Click here to Add your Code!


ASP Home | C Home | C++ Home | COBOL Home | Java Home | Pascal Home
Source Codes Home Page

 Advertisements  

Google Search

Google

Source Codes World.com is a part of Vyom Network.

Vyom Network : Web Hosting | Dedicated Server | Free SMS, GRE, GMAT, MBA | Online Exams | Freshers Jobs | Software Downloads | Interview Questions | Jobs, Discussions | Placement Papers | Free eBooks | Free eBooks | Free Business Info | Interview Questions | Free Tutorials | Arabic, French, German | IAS Preparation | Jokes, Songs, Fun | Free Classifieds | Free Recipes | Free Downloads | Bangalore Info | Tech Solutions | Project Outsourcing, Web Hosting | GATE Preparation | MBA Preparation | SAP Info | Software Testing | Google Logo Maker | Freshers Jobs

Sitemap | Privacy Policy | Terms and Conditions
Copyright ©2003-2020 SourceCodesWorld.com, All Rights Reserved.
Page URL: http://www.sourcecodesworld.com/source/show.asp?ScriptID=341


Download Yahoo Messenger | Placement Papers | Free SMS | C Interview Questions | C++ Interview Questions | Quick2Host Review