Forum Moderators: open
<%@ Language=VBScript %>
<%
On Error Resume Next
Dim d, i
Const dictKey = 1
Const dictItem = 2
Dim sHTTPFolder
Dim sFolderPath
On Error Resume Next
sFolderPath = "c:\inetpub\wwwroot\YourFolderName" 'This must be the absolute path for the FSO
sHTTPFolder = "YourFolderName/" 'This could be blank if this file lives where all the Files To List are. Used for <a href below
Set fso = server.CreateObject("Scripting.FileSystemObject")
Set fldr = fso.GetFolder(sFolderPath)
If Err.number > 0 then
Response.Write "Error Opening Folder: " & err.description
Set fso = nothing
Response.End
end if
Set d = Server.CreateObject("Scripting.Dictionary")
Set Files = fldr.Files
If Files.Count <> 0 Then
For Each File In Files
d.Add File.Name, GetFileTime(file)
Next
End If
%>
<HTML>
<BODY bgcolor=Wheat Link=blue alink=red>
<CENTER>
<h1>File Download Center</h1>
<%
SortDictionary d,dictItem
For Each i In d
If right(i,3) <> "asp" then
if right(i,3) <> "txt" then
Response.Write "<a href=" & sHTTPFolder & i & "><font size=4>" & i & "</a> - " & d(i) & "<BR>"
end if
end if
Next
Function SortDictionary(objDict,intSort)
' declare our variables
Dim strDict()
Dim objKey
Dim strKey,strItem
Dim X,Y,Z
' get the dictionary count
Z = objDict.Count
' we need more than one item to warrant sorting
If Z > 1 Then
' create an array to store dictionary information
ReDim strDict(Z,2)
X = 0
' populate the string array
For Each objKey In objDict
strDict(X,dictKey) = CStr(objKey)
strDict(X,dictItem) = CStr(objDict(objKey))
X = X + 1
Next
' perform a a shell sort of the string array
For X = 0 to (Z - 2)
For Y = X to (Z - 1)
If StrComp(strDict(X,intSort),strDict(Y,intSort),vbTextCompare) > 0 Then
strKey = strDict(X,dictKey)
strItem = strDict(X,dictItem)
strDict(X,dictKey) = strDict(Y,dictKey)
strDict(X,dictItem) = strDict(Y,dictItem)
strDict(Y,dictKey) = strKey
strDict(Y,dictItem) = strItem
End If
Next
Next
' erase the contents of the dictionary object
objDict.RemoveAll
' repopulate the dictionary with the sorted information
u = z
For X = 0 to (Z - 1)
u = u - 1
objDict.Add strDict(u,dictKey), strDict(u,dictItem)
Next
End If
End Function
Function GetFileTime(File)
Dim intSlash1
Dim intSlash2
Dim mm
Dim dd
Dim yy
Dim hh
Dim mn
GetFileTime = file.DateLastModified
'Response.Write (GetFileTime) & "<BR>"
intSlash1 = instr(1,GetFileTime,"/")
mm = left(GetFileTime,(intSlash1 - 1))
If len(mm) = 1 then
mm = "0" & mm
end if
intSlash2 = instr((intSlash1+1),GetFileTime,"/")
dd = mid(GetFileTime,(intSlash1+1), (intSlash2 - intSlash1 - 1))
If len(dd) = 1 then
dd = "0" & dd
end if
yy = mid(GetFileTime,(intSlash2+1),4)
MyTime = Right(GetFileTime,(len(GetFileTime) - (intSlash2 + 4)))
'Response.Write (MyTime) & " " & FormatDateTime(MyTime,4) & "<BR>"
hh = left (FormatDateTime(MyTime,4),2)
mn = right (FormatDateTime(MyTime,4),2)
if hh = "00" then
hh = "23"
mn = "59"
dd = dd - 1
end if
If len(dd) = 1 then
dd = "0" & dd
end if
'mn = right (FormatDateTime(MyTime,4),2)
MyTime = hh&":"& mn
'Response.Write "New HH " & hh
GetFileTime = mm & "/" & dd & "/" & yy & " " & MyTime
'Response.Write (GetFileTime & MyTime) & "<BR>"
'Response.Write (MyTime) & "<BR>"
'Response.Write (GetFileTime) & "<BR>"
end Function
Set fso = nothing
%>
</CENTER>
</BODY>
</HTML>