Tote Links löschen

VBS-Anwendungen für das Dateisystem

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


Beschreibung

Windows kennt keinen Mechanismus, um Links vernünftig zu überprüfen und sie gegebenenfalls zu löschen. Wer sich beispielsweise das Startmenü anders unterteilt hat, der darf nicht darauf hoffen, dass ein Deinstallationsprogramm den verschobenen Link findet. Auch die zuletzt verwendeten Dateien (Windows Ordner 'Recent', auch im Start-Menü) zeigen hartnäckig Dateien an, die es längst nicht mehr gibt.

Das Skript schafft hier Abhilfe, denn es findet heraus, ob der Link noch funktioniert und löscht ihn dann.
Vorsicht: Wenn der Link auf ein nicht verfügbares Laufwerk zeigt, dann löscht es ihn auch. Davon sind folgende Linktypen betroffen:

  • Link auf eine Datei im Netz, wenn das Netzwerk nicht verfügbar ist

  • Link auf einen auswechselbaren Datenträger (DVD, CD, Speicherkarten), wenn der Datenträger nicht vorhanden ist oder einfach ein anderer Datenträger im Laufwerk liegt

  • Link auf ein USB-Laufwerk, wenn dieses abgeschaltet oder nicht verbunden ist oder wenn gelegentlich mehrere USB-Laufwerke gleichzeitig verwendet werden, und sich dabei die Laufwerksbuchstaben verschieben.

Speziell bei auswechselbaren Datenträgern und USB-Laufwerken sind automatisch erzeugte Links flüchtig, so dass es vermutlich nicht so schlimm ist, wenn sie vom Skript gelöscht werden.

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

Dim FS, Liste, Nr, Verzeichnis, Objekt
Dim Anzahl, WshShell

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

Anzahl = 0


If Liste.Count > 0 Then
    ' Then wird ausgeführt, wenn aus dem Explorer Dateien
    ' mit Drag & Drop auf diese Skript-Datei gezogen wurden
    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 (InStr(1, Objekt, "folder*")>0) Then
        For Each Objekt In Verzeichnis.ParentFolder.Items
            If Objekt.Name = Verzeichnis.Title Then Exit For
        Next
    End If
    DateiSystemDurchsuchen Objekt.Path
End If

' *** 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

         ' Alle Unterordner rekursiv bearbeiten
        For Each UnterOrdner In Ordner.SubFolders
            ' Einstieg In die Rekursion
            DateiSystemDurchsuchen UnterOrdner
        Next

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

' Zeigt 5 Sekunden lang die Anzahl der bearbeiteten Dateien
WshShell.PopUp Anzahl & " Links gelöscht", 5, "Tote Links"

'*** Ende des Skripts


' Diese Prozedur prüft, ob ein Link existiert
Private Function Bearbeiten(Objekt, IstDatei)
    Bearbeiten = True  ' In jedem Falle weitermachen

    Dim Quelle, LaufWerk, Typ

    ' Funktion verlassen, wenn ein Ordner übergeben wurde
    If Not IstDatei Then Exit Function

    ' Funktion verlassen, wenn die Datei kein Link ist
    If LCase(FS.GetExtensionName(Objekt)) <> "lnk" _
        Then Exit Function

    ' Auf welche Datei/Verzeichnis zeigt der Link ?
    Quelle = WshShell.CreateShortcut(Objekt).TargetPath

    ' Funktion verlassen, wenn die Datei / Ordner, auf
    ' die der Link zeigt, existiert
    If FS.FileExists(Quelle)   Then Exit Function
    If FS.FolderExists(Quelle) Then Exit Function

    ' Laufwerksbuchstaben bestimmen
    LaufWerk = FS.GetDriveName(Quelle)

    ' Existiert wenigstens das Laufwerk ?
    If FS.DriveExists(LaufWerk) Then
        ' Laufwerkstyp bestimmen
        Typ = FS.Drives(CStr(LaufWerk)).DriveType

        ' Falls der Link auf eine Datei/Ordner auf einer
        ' lokalen Festplatte (2) oder ein Netzlaufwerk (3)
        ' verweist, dann löschen
        If (Typ = 2) Or (Typ = 3) Then
            FS.DeleteFile Objekt
            Anzahl = Anzahl + 1
        End If
    End If
End Function