Directory Viewer

Directory Viewer

--------------------------------------------------------------------------------

Description : A directory Viewer with the option of downloading the file and reading text

<--- 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>

<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>

<%
'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
%>

<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>

<%
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%>

<%
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%>

<%
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%>

</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>

--------------------------------------------------------------------------------