'......................................................................................
'    Benuter_Dateien_löschen.vbs 1.3
'    Autor: Michael Hölldobler   hoelldobler[at]alant.de
'
' Funktionsweise:
' Es werden persönliche Ornder gelöscht. 
'......................................................................................
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
' ---------------------------------------------------------------