Bron code: automatisch rapporten menu
<SCRIPT LANGUAGE="VBSCRIPT" RUNAT="SERVER">
Function GetRapportHTML(strRapportDir)
'--------------------------------------------------------------------------------------------------------------------
' Alle subdirectory's van de opgegeven rapporten directory opzoeken.
' Hiermee html samenstellen die de beschikbare rapporten kan weergeven.
'--------------------------------------------------------------------------------------------------------------------
Dim objFolder, objSubFolders, strDirHTML
On Error Resume Next
'// Een folder object maken (objSubFolders) met informatie over
'// alle subdirectory's. De functie geeft true bij succes.
If GetRapportSubDirs(objSubFolders, strRapportDir) Then
'// In een loop wordt voor iedere subdirectory een html-regel gemaakt
'// met daarin de naam, het formaat van de directory en een link naar de directory.
For Each objFolder In objSubFolders
'// Geen frontpage en images directory's weergeven.
If objFolder.Name <> "_vti_cnf" And objFolder.Name <> "images" Then
'// We gaan er vanuit dat een directory alleen bestaat als er ook een rapport is staat.
'// We maken daarom altijd een link en mogen er bij webmasters die dit script implementeren
'// toch wel vanuit gaan dat directory niet leeg is. Verwijder dus ook de directory als het
'// rapport wordt verwijderd!
strDirHTML = strDirHTML & "<p><font face=""Tahoma, Arial"" size=""2"">Analyse <a href=" _
& Chr(34) & strRapportDir & objFolder.Name & Chr(34) & ">periode " & objFolder.Name _
& "</a>, formaat " & FormatNumber(objFolder.Size, 0, 0, 0, -1) _
& " bytes.</font></p>" & vbCrLf
End If
Next
Else
'// False gekregen, problemen met het folder object. Is het pad correct?
strDirHTML = "<p><font face=""Tahoma, Arial"" size=""2"">Geen rapporten gevonden.</font></p>"
End If
'// Vroegtijdig opruimen.
Set objFolder = Nothing: Set objSubFolders = Nothing
'// De html retourneren.
GetRapportHTML = strDirHTML
End Function
Function GetRapportSubDirs(objSubFolders, RapportDir)
'------------------------------------------------------------------------
' Alle subdirectory's van de RapportDir inlezen.
'------------------------------------------------------------------------
Dim objFileSystem, objFolder, strRapportDir
On Error Resume Next
'// Volledig pad maken: w:\websites\domein.nl\www\rapport\
strRapportDir = Server.MapPath("/") & RapportDir
'// Filesystem object voor het vervolgens creeren van een Folder object.
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
'// Folder objecten die alle subdirs gaan bevatten. We controleren niet
'// op het bestaan van de directory, de webmaster moet zelf maar opletten.
Set objFolder = objFileSystem.GetFolder(strRapportDir)
Set objSubFolders = objFolder.SubFolders
'// Vroegtijdig opruimen.
Set objFolder = Nothing: Set objFileSystem = Nothing
'// Succes of probleem teruggeven.
If Err = 0 Then: GetRapportSubDirs = True
End Function
</SCRIPT>
<html>
<head>
<title>Practical Active Server Pages : Rapporten Menu</title>
<!-- Practical ASP wordt u aangeboden door Nedcomp Hosting -->
</head>
<body>
<hr size="1" color="#008080">
<p><strong><font face="Arial" size="2">Website Analyse Rapporten</font></strong></p>
<p><font face="Tahoma, Arial" size="2">De analyse rapporten bekijken.
De onderstaande links hebben het formaat: Jaar/Maand.</font></p>
<!-- Alle beschikbare rapporten (in de subdirectory's van de opgegeven directory) opsommen -->
<p><%= GetRapportHTML("/rapport/") %></p>
<hr size="1" color="#008080">
<!--
Opmerking: wanneer u gebruik wilt maken van het rapporten menu moeten wij ervoor
zorgen dat de rapporten iedere maand automatisch in de juiste directory worden
opgeslagen. Vraag het ons! Wij configureren dat graag voor u.
-->
</body>
</html>
|
Producten en diensten
Algemeen