http://dieseyer.de • all rights reserved • © 2011 v11.4
'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
'*********************************************************
http://dieseyer.de • all rights reserved • © 2011 v11.4