RemoteExplorer.asp

A directory Viewer with the option of downloading the file and reading text
Directory Viewer with Download

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

Views 986 Downloads 340

'FileSystemObject'

JeffSmith
26
File System Classic ASP
Revisions

v1.0