<%@ 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>&nbsp;<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