Blue Flower

Script zum löschen der persönlichen Dateien.

Der Cleanmanager braucht doch sehr lange um mal eben schnell ein Konto von den Benutzer-Dateien zu befreien. Das Script entfernt die Dateien auf den Desktop, Eigene Dateien (Dokumente), Eigene Bilder (Pictures), Eigene Musik (Music), Zuletzt verwendete Dateien, Dateien, die auf CD geschrieben werden sollen (XP),  IExplorer temporary Internetfiles & Cookies und leert den Papierporb.

Script-Link:

'......................................................................................
'    Benuter_Dateien_löschen.vbs 1.3
'    Autor: Michael Hölldobler   hoelldobler[at]alant.de
'
' Funktionsweise:
' Es werden persönliche Ornder geleert.
'......................................................................................
Option Explicit

Dim s, fs, wsh, oShell, fCleanAll, oArgs, oFolder
Dim up, oWMI, oInstances, oItem, os
'Auch Eigene Dateien und Desktop säubern
fCleanAll = True 'False

On Error Resume Next

Set fs = CreateObject("Scripting.FileSystemObject")
Set wsh = CreateObject("WScript.shell")
Set oArgs = WScript.Arguments
Set oWMI = GetObject("winmgmts:\\.\root\cimv2")
Set oInstances = oWMI.ExecQuery("Select * from Win32_OperatingSystem",,48)
For Each oItem In oInstances

os = oItem.Caption

Next

Const LE = "Lokale Einstellungen\"
up = wsh.ExpandEnvironmentStrings("%USERPROFILE%") & "\"

If oArgs.Count > 0 Then

If CBool(oArgs(0)) = True Then fCleanAll = True

End If

If InStr(1, os, " XP") Then

os = "XP"

s = "Eigene Dateien"

ElseIf InStr(1, os, " vista") Or InStr(1, os, " 7") Then

os = "7"

s = "Documents"

End If

If fCleanAll = True Then

ListOrdner up & s

ListOrdner up & "Desktop"

Else

If wsh.Popup("Auch die Dateien In " & s & " löschen", 15 , "Löschen wird In 15 Sekunden ausgeführt!" , vbYesNo + vbExclamation) = vbYes Then _

ListOrdner up & s

If wsh.Popup("Auch die Dateien auf dem Desktop löschen", 15 , "Löschen wird In 15 Sekunden ausgeführt!" , vbYesNo + vbExclamation) = vbYes Then _

ListOrdner up & "Desktop"

End If

If os = "XP" Then

ListOrdner up & "temp"

ListOrdner up & LE & "Temp"

'Dateien, die auf CD geschrieben werden sollen (XP) löschen

ListOrdner up & LE & "Anwendungsdaten\Microsoft\CD Burning"

ListOrdner up & LE & "Verlauf"

ListOrdner up & "Recent"

ElseIf os = "7" Then

ListOrdner up & "AppData\Local\Temp"

ListOrdner up & "AppData\Local\Microsoft\Windows\Burn"

ListOrdner up & "AppData\Local\Microsoft\Windows\History"

ListOrdner up & "AppData\Roaming\Microsoft\Windows\Recent"

End If

'IExplorer Dateien löschen
Const TEMPORARY_INTERNET_FILES = &H20&
Set oShell = CreateObject("Shell.Application")
Set oFolder = oShell.Namespace(TEMPORARY_INTERNET_FILES)
Set oItem = oFolder.Self
s = oItem.Path
ListOrdner s
'c:\Users\Administrator\AppData\Local\Microsoft\Windows\Temporary Internet Files\

'Cookies löschen
Const COOKIES = &H21&
Set oFolder = oShell.Namespace(COOKIES)
Set oItem = oFolder.Self
s = oItem.Path
ListOrdner s

'Papierkorb leeren
Set oWMI = GetObject("winmgmts://./root\cimv2")
Set oInstances = oWMI.InstancesOf("Win32_LogicalDisk",48)
For Each oItem In oInstances

With oItem

If .DriveType = 3 Then

s = .Caption & "\RECYCLER"

ListOrdner s

End If

End With

Next

wsh.Popup "Soweit alles gelöscht", 10, "Konto : " & wsh.ExpandEnvironmentStrings("%USERNAME%"), vbOKOnly

' --- Funktionen ------------------------------------------------------------
Function ListOrdner(Ordner)

Dim Folder, subFolder, x

'on Error Resume Next

If fs.folderexists(ordner) Then

Set Folder = fs.getfolder(Ordner)

'Sollten die Dateien schreibgeschützt sein diesen Schutz aufheben

x =  "ATTRIB -R " & enclose(Folder.Path & "\*.*")


wsh.run x, 0, True

'Sollte der Ordner schreibgeschützt sein diesen Schutz aufheben

x =  "ATTRIB -R " & enclose(Folder.Path)

wsh.run x, 0, True

'Jetzt endlich löschen

x = "%COMSPEC% /C del /F /Q " & enclose(Folder.Path & "\*.*")

wsh.Run x, 0, True


'  For Each file In Ordner.files
'    liste = liste & file.path & vbCrlf
'    Set f1 = fs.GetFile(file.path)
'    f1.Delete
'  Next

For Each subFolder In Folder.SubFolders

'Diese Ordner nicht löschen aber den Inhalt

If os = "xp" And (Right(subFolder.Path, 13) = "Eigene Bilder" Or Right(subFolder.Path, 12) = "Eigene Musik" Or _

Right(subFolder.Path, 17) = "Gemeinsame Videos" Or Right(subFolder.Path, 20) = "Gemeinsame Dokumente" _

Or Right(subFolder.Path, 16) = "Gemeinsame Musik") Then

ListOrdner subFolder

Else

x = "%COMSPEC% /C rd /s /q " & enclose(subFolder.Path)

wsh.Run x, 0, True

'      Set fo = fs.getfolder(subFolder.Path)
'      fo.delete
'      If Err.number = 70 Then
'        Err.clear
'        ListOrdner subFolder
'        fo.delete
'      End If

End If

Next

End If

End Function

Function enclose(v)

Dim va

Const cSlash = "/"

Const cBSlash = "\"

Const cDQ = """"

Const cSpace = " "

va = v

If IsArray(va) Then

For i = 0 To UBound(va)

s = Replace(va(i), cSlash, cBSlash)

If InStr(1, s, cSpace) Then

va(i) = cDQ & s & cDQ

Else

va(i) = s

End If

Next

ElseIf va <> vbNullString Then

va = Replace(va, cSlash, cBSlash)

If InStr(1, va, cSpace) Then va = cDQ & va & cDQ

End If

enclose = va

End Function
' ---------------------------------------------------------------