Option Explicit
On Error Resume Next
Dim Anzahl
Anzahl = 0
Dim FS, Liste, Nr, Verzeichnis, Objekt
Set Liste = WScript.Arguments
Set FS = CreateObject("Scripting.FileSystemObject")
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 (Objekt LIKE "folder*") 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
CreateObject("WScript.Shell").PopUp Anzahl & _
" Dateien und Ordner bearbeitet", 5, "Schreibschutz entfernen"
'*** Ende des Skripts
' Hier wird festgelegt, wie Dateien bearbeitet werden sollen.
Private Function Bearbeiten(Datei, IstDatei)
' Schreibschutz-Attribut einer/s Datei/Ordners löschen
Datei.Attributes = Datei.Attributes And Not 1
Anzahl = Anzahl + 1
Bearbeiten = True
End Function
|