Bildgalerie erstellen

VBS-Anwendungen für das Dateisystem

[Beschreibung] · [Programm-Listing] · [Download des Skripts]


Beschreibung

Gelegentlich hat man verschiedene Garfikdateien auf der Festplatte, einem Netzlaufwerk oder einem Server des firmeninternen Intranets. Wenn man ein bestimmtes Bild sucht, ohne ein geeignetes Bildbetrachtungsprogramm zu besitzen (kommt auf Firmenrechnern häufiger vor, weil soclhe Werkzeuge nicht vom Adiministrator genehmigt oder lizensiert wurden), muss man jede Datei einzeln öffnen, um die Bilder anzusehen.

Dsa folgende Programm erstellt eine HTML-Datei, welche alle Bilder eines Verzeichnisses zeigt. Die Grafikformate müssen allerdings vom Internet-Explorer darstellbar sein, sonst werden die Dateien von diesem VBS ignoriert. Der Internet-Explorer stellt diese Grafikformate dar: JPEG, GIF, PNG, BMP oder TIFF.

Wichtig: Das Skript erstellt keine Thumbnails. Dies hat zwar einerseits den Vorteil, dass es (außer der HTML-Datei) keine zusätzlichen Dateien erzeugt, heißt aber andererseits, dass der Browser das Bild in voller Größe lädt und es dann für die Anzeige anpaßt. Dadurch muss das ganze Bild in voller Dateigröße geladen werden, weshalb sich dieses Skript nicht für Seiten im Internet eignet.

Das Skript basiert auf dem bereits beschriebenen rekurisven Skript zur Suche im Dateisystem.

Es kann auf mehrere Arten aufgerufen werden:

  • Drag & Drop: Man markiert im Explorer eine oder mehrere Dateien und/oder Verzeichnisse und zieht sie auf das Skript

  • Senden an: Im Ordner ‘\Windows\SendTo’ kann eine Verknüpfung zum Skript angelegt werden. Dadurch steht das Skript im Kontextmenü des Explorers unter ‘Senden an...’ zur Verfügung.
    Hinweis: Der Ordner ‘\Windows\SendTo’ ist versteckt, und kann nur angezeigt werden, wenn man im Explorer im Menü ‘Extras -> Ordneroptionen’ (je nach Windows-Version) die Registerkarte ‘Ansicht’ wählt und bei ‘Versteckte Dateien’ die Option ‘Alle Dateien anzeigen’ wählt.

  • Dialog: Falls keine Argumente übergeben wurden, öffnet das Skript beim Aufrufen ein Windows-Dialogfenster, in dem eine Datei oder ein Verzeichnis ausgewählt werden kann. Dies funktioniert nicht unter Windows NT 4.0

Das Skript schlägt dann einen Dateinamen für die Index-Datei vor, wobei die Datei standardmäßig unter dem Namen index.html im gleichen Verzeichnis wie die Bilder gespeichert wird. Das Skript durchsucht keine Unterverzeichnisse.

Programm-Listing

Die grünen Texte im unten angegebenen Quellcode sind Kommentare, die bei der Eingabe ausgelassen werden können.

Option Explicit
On Error Resume Next

Const TabSpalten = 3
Const BildBreite = 100
Const SeitenTitel = "Bildgalerie"
Const BildQuelle = "Internet"

Dim FS, Liste, Nr, Verzeichnis, Objekt
Dim AusgabeDatei, DateiName, BildDateiTypen, SpalteNr

Set Liste    = WScript.Arguments
Set FS       = CreateObject("Scripting.FileSystemObject")

' Dateiendungen, die als Grafiken angezeigt werden sollen
BildDateiTypen = array(".JPG", ".JPEG", ".GIF", ".PNG", ".TIF", ".TIFF", ".BMP")
SpalteNr = 1


If Liste.Count > 0 Then
    ' Then wird ausgeführt, wenn aus dem Explorer Dateien
    ' mit Drag & Drop auf diese Skript-Datei gezogen wurden

    DateiErstellen Liste(0)

    For Nr = 0 To Liste.Count - 1
        DateiSystemDurchsuchen Liste(Nr)
    Next

Else
    ' Else wird ausgeführt, wenn dieses Skript gestartet
    ' wurde, ohne dass Argumente übergeben wurden

    ' Ruft einen Dialog von Windows auf, mit dem eine
    ' Datei oder ein Ordner ausgewählt werden kann
    Set Verzeichnis = CreateObject("Shell.Application") _
        .BrowseForFolder(0, "Datei oder Verzeichnis wählen" _
        , &H4011, 17)

    ' Skript beenden, falls im Dialog die Schaltfläche
    ' Abbrechen gedrückt wurde
    If TypeName(Verzeichnis) = "Nothing" Then WScript.Quit

    Objekt = LCase(TypeName(Verzeichnis.ParentFolder))


    If (Objekt LIKE "folder*") Then
        For Each Objekt In Verzeichnis.ParentFolder.Items
            If Objekt.Name = Verzeichnis.Title Then Exit For
        Next
    End If
    DateiErstellen Objekt.Path

    DateiSystemDurchsuchen Objekt.Path
End If


' Ende der Ausgabedatei schreiben
With AusgabeDatei
     If Nr Mod 3 = 0 Then AusgabeDatei.WriteLine "</TR>"
     .WriteLine "</TABLE>"
     .WriteLine "</BODY></HTML>"
     .Close
End With

' Ausgabedatei öffnen
' CreateObject("WScript.Shell").Run DateiName, True


'*** Ende des Skripts



Private Sub DateiErstellen(AusgabePfad)
    Dim MeldungsText

On Error Resume Next


    MeldungsText = "AusgabeDatei wählen"
    DateiName = FS.GetDriveName(AusgabePfad)
    DateiName = FS.GetFolder(AusgabePfad).Path
    DateiName = FS.GetFile(AusgabePfad).ParentFolder
    DateiName = DateiName & "\index.html"

    Do
        DateiName = InputBox(MeldungsText, "Bildgalerie erstellen", DateiName)
        If DateiName = "" Then WScript.Quit
    MeldungsText = "Ausgabedatei existiert. Bitte neuen Namen wählen"
    Loop While FS.FileExists(DateiName)

    Set AusgabeDatei = FS.CreateTextFile(DateiName, True)

    ' Dateikopf schreiben
    With AusgabeDatei
        .WriteLine "<HTML><HEAD>"
        .WriteLine "<STYLE TYPE=""text/css"">"
        .WriteLine "  H1 {font-family:helvetica,sans-serif}"
        .WriteLine "  P, CAPTION, BODY {font-family:verdana,helvetica,sans-serif;font-size:8pt}"
        .WriteLine "</STYLE>"
        .WriteLine "<TITLE>" & SeitenTitel & "</TITLE>" ' Titelleitse
        .WriteLine "</HEAD><BODY>"
        .WriteLine "<H1 ALIGN=CENTER>" & SeitenTitel & "</H1>"  ' Überschrift
        .WriteLine "<P ALIGN=CENTER>Quelle: " & BildQuelle
        .WriteLine "<TABLE BORDER=0 CELLPADDING=10 CELLSPACING=0 ALIGN=CENTER>"
        .WriteLine "<CAPTION ALIGN=BOTTOM>Zum Vergrößern der Bilder klicken.<BR>So werden die Bilder auf die Festplatte kopiert:<BR>Mauszeiger über das Bild, rechte Maustaste klicken, 'Bild speichern unter ...' wählen.</CAPTION>"
    End With

End Sub


' *** Ende des Scripts

' ---------------------------------------------------------- '
' Rekursives Unterprogramm um das Dateisystem zu durchsuchen
' ---------------------------------------------------------- '

Private Sub DateiSystemDurchsuchen(Pfad)
    Dim Ordner, UnterOrdner, Datei

    If FS.FolderExists(Pfad) Then
        ' Then: Falls Ordner übergeben wurde
        Set Ordner = FS.GetFolder(Pfad)

        ' Papierkorb nicht bearbeiten
        If LCase(Ordner.Name) = "recycled" Then Exit Sub

        ' Funktion Bearbeiten() für Ordner aufrufen
        If Not Bearbeiten(Ordner, False) Then Exit Sub

        ' Alle Dateien im Ordner bearbeiten
        For Each Datei In Ordner.Files
            ' Prozedur Bearbeiten() für Dateien aufrufen
            If Not Bearbeiten(Datei, True) Then Exit For
        Next

    ElseIf FS.FileExists(Pfad) Then
        ' Else: Falls eine einzelne Datei übergeben wurde
        Bearbeiten FS.GetFile(Pfad), True
    End If
End Sub


' Funktion, die den Inhalt der Ausgabe bestimmt
Private Function Bearbeiten(Datei, IstDatei)
    Dim Ext, BildPfad
    Bearbeiten = True
    If IstDatei Then
        For Each Ext In BildDateiTypen
            If UCase(Right(Datei.Name, Len(Ext))) = Ext Then
                If SpalteNr Mod TabSpalten = 1 Then AusgabeDatei.WriteLine "<TR VALIGN=MIDDLE>"
                BildPfad = RelativerPfad(DateiName, Datei.Path)
                AusgabeDatei.WriteLine "<TD><P ALIGN=CENTER><A HREF=""" & BildPfad & """ TARGET=""_BLANK""><IMG SRC=""" & BildPfad & """ ALT=""" & Datei.Name & """ ALIGN=CENTER WIDTH=" & BildBreite & " BORDER=0></A></TD>"
        If SpalteNr Mod TabSpalten = 0 Then AusgabeDatei.WriteLine "</TR>"
        SpalteNr = SpalteNr + 1
                Exit Function
            End If
        Next
    End If
End Function


Private Function RelativerPfad(ByVal Pfad, ByVal LinkAuf)
    Dim Pos

    Pfad = Replace(Pfad, "\", "/")
    LinkAuf = Replace(LinkAuf, "\", "/")

    Do
        Pos = InStr(1, LinkAuf, "/")
        If UCase(Mid(Pfad, 1, Pos)) <> UCase(Mid(LinkAuf, 1, Pos)) Then Exit Do
        Pfad = Mid(Pfad, Pos + 1)
        LinkAuf = Mid(LinkAuf, Pos + 1)
    Loop Until Pos = 0

    Pos = InStr(1, Pfad, "/")
    While Pos <> 0
        LinkAuf = "../" & LinkAuf
        Pos = InStr(Pos + 1, Pfad, "/")
    Wend

    RelativerPfad = Replace(LinkAuf, " ", "%20")
End Function