'v3.6***************************************************** ' File: deltree.vbs ' Autor: dieseyer@gmx.de ' dieseyer.de ' ' Löscht alle Dateien und danach alle Verzeichnisse in ' einem Verzeichnis - vorher werden die Attribute gelöscht. ' Zieht man ein Verzeichnis auf das Skript, werden alle ' enthaltene Dateien und Unterverzeichnisse gelöscht. ' Zieht man eine Datei auf das Skript, wird das Verzeich- ' nis, in dem sich die Datei befindet, ermittelt und wie ' beschrieben gelöscht. '********************************************************* Option Explicit Dim WSHShell, fso, oArgs Dim i, Text, Pfad Set WSHShell = WScript.CreateObject("WScript.Shell") Set fso = WScript.CreateObject("Scripting.FileSystemObject") set oArgs = Wscript.Arguments If oArgs.Count > 0 Then ' gibt es Argumente? Pfad = oArgs.item(0) ' erstes Argument Else ' es gibt keine Argumente! Text = "" Text = Text & "Das ganze funktioniert so:" & vbCRLF & vbCRLF Text = Text & "Ein Verzeichnis auf das Skript ziehen & fallen lassen" & vbCRLF Text = Text & ". . . und es wird gelöscht." & vbCRLF & vbCRLF Text = Text & "Eine Datei auf das Skript ziehen & fallen lassen" & vbCRLF Text = Text & ". . . und das Verzeichnis, in dem sich die Datei befindet wird gelöscht." & vbCRLF & vbCRLF Text = Text & "ACHTUNG: Der Papierkorb bleibt leer!!!" WSHShell.Popup Text , 30, WScript.ScriptName, 64 + 0 WScript.Quit End If if not fso.FolderExists( Pfad ) then WSHShell.Popup UCase(Pfad) & " entält kein Verzeichnis!" & vbCRLF & vbCRLF & " . . . das ist das Ende.", 30, WScript.ScriptName, 64 + 0 WScript.Quit End If '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ SicherheitsAbfrage Pfad ' Sub Aufruf if DelTree( Pfad ) = true then ' Function Aufruf '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ WSHShell.Popup UCase(Pfad) & " true ist jetzt leer!", 13, WScript.ScriptName, 64 + 0 Else WSHShell.Popup UCase(Pfad) & " konnte nicht geleert werden!", 30, WScript.ScriptName, 48 + 0 End If WScript.Quit '********************************************************* Function DelTree ( Pfad ) '********************************************************* Dim fso, oFolders, oSubFolder, oFiles, WSHShell Dim Text, DateiX, VerzX, Txt Set WSHShell = WScript.CreateObject("WScript.Shell") Set fso = WScript.CreateObject("Scripting.FileSystemObject") DelTree = true if fso.FileExists( Pfad ) then Pfad = fso.GetParentFolderName( Pfad ) ' obige Zeile wird nur ausgeführt, wenn "Pfad" eine Datei ist ' Datei-Attribute System, Readonly, Hidden zurück setzen ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Text = "%comspec% /c Attrib """ & Pfad & "\*.*"" /S -s -r -h " WSHShell.run Text, 4, True ' Dateiliste ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Text = "" Set oFolders = fso.GetFolder( Pfad ) Set oFiles = oFolders.Files For Each DateiX In oFiles Text = Text & DateiX.Path & vbCRLF On Error Resume Next fso.DeleteFile DateiX.Path, True ' True: Löschen erzwingen if not err.number = 0 then DelTree = False On Error GoTo 0 Next Set oFiles = nothing Set oFolders = nothing If Text = "" then Text = "keine Dateien vorhanden." WSHShell.Popup "In " & UCase(Pfad) & " wurden folgende Dateien gelöscht:" & vbCRLF & vbCRLF & Text, 3, WScript.ScriptName, 64 + 0 ' Verzeichnisliste ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Text = "" Set oFolders = fso.GetFolder( Pfad ) Set oSubFolder = oFolders.SubFolders For Each VerzX In oSubFolder Text = Text & VerzX.Path & vbCRLF On Error Resume Next fso.DeleteFolder VerzX.Path, True ' True: Löschen erzwingen if not err.number = 0 then DelTree = False On Error GoTo 0 Next Set oFiles = nothing Set oFolders = nothing If Text = "" then Text = "keine Unterverzeichnisse vorhanden." WSHShell.Popup "In " & UCase(Pfad) & " wurden folgende Verzeichnisse gelöscht:" & vbCRLF & vbCRLF & Text, 3, WScript.ScriptName, 64 + 0 Set WSHShell = nothing Set fso = nothing End Function ' DelTree '********************************************************* '********************************************************* Sub SicherheitsAbfrage( Pfad ) ' Anfang '********************************************************* Text = "" Text = Text & "Es wird jetzt das Verzeichnis" & vbCRLF & vbCRLF Text = Text & vbTAB & UCase( Pfad ) Text = Text & vbCRLF & vbCRLF & "unwiederbringlich gelöscht." & vbCRLF & vbCRLF Text = Text & "ACHTUNG: Der Papierkorb bleibt leer!!!" If not vbYes = WSHShell.Popup ( Text , 30, WScript.ScriptName, 48 + 4 + 256 ) then WSHShell.Popup UCase(Pfad) & vbTab & vbCRLF & vbCRLF & vbTab & "wird nicht gelöscht!" & vbCRLF & vbCRLF & vbTab & " . . . das ist das Ende.", 30, WScript.ScriptName, 64 + 0 WScript.Quit End if Text = vbCRLF Text = Text & "DIE LETZTE WANUNG!" & vbCRLF & vbCRLF Text = Text & "Es wird jetzt das Verzeichnis" & vbCRLF & vbCRLF Text = Text & vbTAB & UCase( Pfad ) Text = Text & vbCRLF & vbCRLF & "unwiederbringlich gelöscht - dies betrifft auch Dateien mit " & vbCRLF Text = Text & "SYSTEM, READONLY- oder HIDDEN-Attributen!" & vbCRLF & vbCRLF Text = Text & "ACHTUNG: Der Papierkorb bleibt leer!!!" If not vbOK = WSHShell.Popup ( Text , 30, WScript.ScriptName, 16 + 1 + 256 ) then WSHShell.Popup UCase(Pfad) & vbTab & vbCRLF & vbCRLF & vbTab & "wird nicht gelöscht!" & vbCRLF & vbCRLF & vbTab & " . . . das ist das Ende.", 30, WScript.ScriptName, 64 + 0 WScript.Quit End if Text = "" Set fso = nothing End Sub ' SicherheitsAbfrage '*********************************************************