<%@ Language=VBScript %>
<%
Option Explicit
Response.Expires = 0
'On Error Resume Next
'*****************************************************************
'Variablendeklarationen
Dim arrvar
Dim arrfiles
Dim intcounter
Dim intsortcolumn
Dim objfile
Dim objfolder
Dim objfs
Dim strfolderpath
'*****************************************************************
'Variableninitialisierung
strfolderpath = left(request.servervariables("PATH_TRANSLATED"), _
instrrev(request.servervariables("PATH_TRANSLATED"),"\"))
Set objfs = CreateObject("Scripting.FileSystemObject")
'*****************************************************************
'Lokale Prozeduren und Funktionen
'Parameter dieser Prozedur
' - arrvar: ein zweidimensionaler Array, wobei erste Dimension
' den Datensätzen und zweite Dimension den Spalten entspricht
' - intsortcolumn: Spalte, nach der sortiert wird (beginnt bei 0!)
Sub procarrbubblesort (ByRef arrvar, intsortcolumn)
Dim blnallesok
Dim intcounter
Dim intinnercounter
Dim arrhelp
ReDim arrhelp(UBound(arrvar,2))
Do
blnallesok = true
'Achtung: UBound liefert bei eindimensionalen Arrays den letzten Index,
'd.h. Anzahl Elemente - 1, bei mehrdimensionalen Arrays dagegen die
'Anzahl Elemente -> deshalb hier UBound - 2!!!
For intcounter = 0 to UBound(arrvar,1) - 2
'Response.Write(intcounter & ". Durchgang<br />" & vbCrLf)
if arrvar(intcounter,intsortcolumn) < arrvar(intcounter+1,intsortcolumn) then
For intinnercounter = 0 to UBound(arrhelp,1) - 1
arrhelp(intinnercounter) = arrvar(intcounter, intinnercounter)
arrvar(intcounter,intinnercounter) = arrvar(intcounter+1,intinnercounter)
arrvar(intcounter+1,intinnercounter) = arrhelp(intinnercounter)
Next
blnallesok = false
end if
Next
Loop While blnallesok = false
End Sub
Sub procarrfilesbubblesort (ByRef arrvar)
Dim blnallesok
Dim intcounter
Dim objhelp
'Response.Write(UBound(arrvar) & "<br />" & vbCrLf)
'Response.Write(arrvar(intcounter).datelastmodified & "<br />" & vbCrLf)
Do
blnallesok = true
For intcounter = 0 to UBound(arrvar) - 2
if arrvar(intcounter).datelastmodified < arrvar(intcounter+1).datelastmodified then
set objhelp = arrvar(intcounter)
set arrvar(intcounter) = arrvar(intcounter+1)
set arrvar(intcounter+1) = objhelp
blnallesok = false
End If
Next
Loop While blnallesok = false
End Sub
Sub procshowarrayastable(ByVal arrvar)
Dim intcounter
Dim intinnercounter
Response.Write("<table border=""1"">" & vbCrLf)
For intcounter = 0 to UBound(arrvar,1) - 1
Response.Write(" <tr>" & vbCrLf)
For intinnercounter = 0 to UBound(arrvar,2) - 1
Response.Write(" <td>" & arrvar(intcounter,intinnercounter) & "</td>" & vbCrLf)
Next
Response.Write(" </tr>" & vbCrLf)
Next
Response.Write("</table>" & vbCrLf)
End Sub
'*****************************************************************
'Anfang Code
'*****************************************************************
'Anfang <html>
%>
<!--#include virtual="asppages/silvi/_include/preheader.inc" -->
<html>
<head>
<title>ASP nützliche Routinen: Dateien eines Laufwerks nach Datum absteigend sortiert anzeigen
</title>
<meta name="description" content="" />
<meta name="keywords" content="" />
<!--#include virtual="asppages/silvi/_include/header.inc" -->
</head>
<body>
<%
'*****************************************************************
'Code innerhalb der HTML-Seite
'Methode1: Files in Array abfüllen
if objfs.FolderExists(strfolderpath) then
Set objfolder = objfs.GetFolder(strfolderpath)
'Response.Write(objfolder.Files.count & "<br />" & vbCrLf)
ReDim arrvar(objfolder.Files.count,5)
ReDim arrfiles(objfolder.Files.count)
intcounter = 0
For Each objfile in objfolder.Files
arrvar(intcounter,0) = objfile.name
arrvar(intcounter,1) = objfile.datecreated
arrvar(intcounter,2) = objfile.datelastmodified
arrvar(intcounter,3) = objfile.size
arrvar(intcounter,4) = objfile.type
Set arrfiles(intcounter) = objfile
'Response.Write(isobject(arrfiles(intcounter)) & "<br />" & vbCrLf)
'Response.Write(arrfiles(intcounter).datelastmodified & "<br />" & vbCrLf)
intcounter = intcounter + 1
Next
else
Response.Write("Ordner " & strfolderpath & "nicht gefunden<br />")
end if
intsortcolumn = 2 'beginnt bei 0
Response.Write("<p><b>Dateien eines Laufwerks mit ASP nach Datum absteigend sortiert anzeigen</b></p>")
Response.Write("<i>Methode 1: Gewünschte Felder in zweidimensionalen Array abfüllen und nach Spalte " & _
intsortcolumn + 1 & " absteigend sortieren</i><br />")
call procarrbubblesort(arrvar, intsortcolumn)
call procshowarrayastable(arrvar)
Response.Write("<i> <br />Methode 2: Eindimensionalen Array mit Fileobjekten " &_
"abfüllen und nach datelastmodified sortieren</i><br />")
call procarrfilesbubblesort(arrfiles)
Response.Write("<table border=""1"">" & vbCrLf)
For intcounter = 0 to UBound(arrfiles) - 1
Response.Write(" <tr>" & vbCrLf)
Response.Write(" <td>" & arrfiles(intcounter).name & "</td><td>" & _
arrfiles(intcounter).datelastmodified & "</td>" & vbCrLf)
Response.Write(" </tr>" & vbCrLf)
Next
Response.Write("</table>" & vbCrLf)
%>
<!--#include virtual="asppages/silvi/_include/inchtmlnachspann.asp" -->
</body>
</html>
Demo: beispiele/070filesbubblesort.asp
Letzter Update:
26.12.2021 16:48
Zurück zur
Liste mit ASP-Beispielen auf
www.ecotronics.ch