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