rothen ecotronics Bern: ASP-Skript "ASP Weitere Objekte: Web-Seiten nach Datum absteigend anzeigen"

<%@ Language=VBScript %>
<%
Option Explicit
Response.Expires = 0
'On Error Resume Next

'*****************************************************************
'Variablendeklarationen
Const constforReading = 1 'nur Lesen
Const consttristate   = 0 'kein Unicode

Dim arrvar
Dim intcounter
'Dim intmaxdays
Dim intsortcolumn
Dim objfile
Dim objfolder
Dim objfs1
Dim objtextfile
Dim strfilecontent
Dim strrelpath
Dim strfolderpath

'*****************************************************************
'Variableninitialisierung
'intmaxdays = 30
strrelpath = "/asppages/silvi/beispiele/"

strfolderpath = server.MapPath(strrelpath)
Set objfs1 = 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 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 valign=""top"">" & arrvar(intcounter,intinnercounter) & "</td>" & vbCrLf)
    Next
    Response.Write("  </tr>" & vbCrLf)
  Next
  Response.Write("</table>" & vbCrLf)
End Sub

'*****************************************************************
'Anfang <html>
%>

<html>
  <head>
    <title>ASP Weitere Objekte:
      Web-Seiten nach Datum absteigend anzeigen</title>
    <meta name="description" content="" />
    <meta name="keywords" content="" />

  </head>
<body>
<%
'*****************************************************************
'Code innerhalb der HTML-Seite

'Files und ihre properties in Array abfüllen
if objfs1.FolderExists(strfolderpath) then
  Set objfolder = objfs1.GetFolder(strfolderpath)
  'Response.Write(objfolder.Files.count & "<br />" & vbCrLf)
  ReDim arrvar(objfolder.Files.count,4)

  intcounter = 0
  For Each objfile in objfolder.Files
    'Nur Web-Seiten werden berücksichtigt
    if InStr(objfile.name, "asp") or InStr(objfile.name, "asp") then
      arrvar(intcounter,0) = objfile.name
      arrvar(intcounter,1) = objfile.datelastmodified
      'Aufdatiert oder neu
      if objfile.datecreated < objfile.datelastmodified then
        arrvar(intcounter,2) = "Updated"
      else
        arrvar(intcounter,2) = "Neu"
      end if
      'Titel aus Datei holen
      Set objtextfile = objfs1.opentextfile(objfile.path, constforreading, consttristate)
      strfilecontent = objtextfile.ReadAll
      If InStr(LCase(strfilecontent),"<title>") > 0 _
        And InStr(LCase(strfilecontent),"</title>") > 0 Then
        arrvar(intcounter,3) = mid(strfilecontent, InStr(LCase(strfilecontent),"<title>") + 7, _
          InStr(LCase(strfilecontent),"</title>") _
          - (InStr(LCase(strfilecontent),"<title>") + 7))
      Else
        arrvar(intcounter,3) = " "
      End if

      intcounter = intcounter + 1
    end if
  Next
else
  Response.Write("Ordner " & strfolderpath & "nicht gefunden<br />")
end if

intsortcolumn = 1 'beginnt bei 0
Response.Write("<p><b>Dateien eines Laufwerks mit ASP nach Datum absteigend sortiert anzeigen</b></p>")

call procarrbubblesort(arrvar, intsortcolumn)
call procshowarrayastable(arrvar)
%>

</body>
</html>

Demo: beispiele/040showwebpageswithdate.asp

Letzter Update: 26.12.2021 17:48

Zurück zur Liste mit ASP-Beispielen auf www.ecotronics.ch