Utilitaire pour vider les dossiers "Temp" et "Recent"

Ce n'est pas une création mais un outil simple qui vous permet de vider les dossiers Temp et Recent qui contiennent soit des fichiers et dossiers(pour temp) soit des raccourcis vers des éléments que vous avez utilisés(dossier Recent) et qui occupent inutilement de l'espace disque de quelques dizaines voire centaines de Mo.
Cet utilitaire se charge de la suppression de ces données superflues à chaque démarrage de votre machine.

A son premier démarrage, l'utilitaire crée une entrée dans la BDR sous HKKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run du nom de DelAtStartup.

C'est une application console(sans interface). Pour la désactiver, il suffit de supprimer l'entrée précitée:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
Option Explicit
 
Type SH_ITEMID
    cb As Long
    aID As Byte
End Type
Type ITEMIDLIST
    mkid As SH_ITEMID
End Type
Const CSIDL_RECENT = &H8
Const NOERROR = &H0
Dim Obj As Object
Const Key = "HKCU\Software\Microsoft\Windows\CurrentVersion\"
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function lOpen Lib "kernel32" Alias "_lopen" (ByVal lpPathName As String, ByVal iReadWrite As Long) As Long
Private Declare Function lClose Lib "kernel32" Alias "_lclose" (ByVal hFile As Long) As Long
 
Dim FSO As New FileSystemObject, FF&
Private Function GetSpecialfolder(CSIDL As Long) As String
    Dim Ret&
    Dim IDL As ITEMIDLIST, sPath$
    Ret = SHGetSpecialFolderLocation(100, CSIDL, IDL)
    If Ret = NOERROR Then
        sPath$ = Space$(512)
        Ret = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath$)
        GetSpecialfolder = Left$(sPath, InStr(sPath, Chr$(0)) - 1)
        Exit Function
    End If
    GetSpecialfolder = ""
End Function
Private Function IsFileInUse(FileName) As Boolean
    Dim hFile As Long
    Dim lastErr As Long
    hFile = -1
    lastErr = 0
    hFile = lOpen(FileName, &H10)
    If hFile = -1 Then
        lastErr = Err.LastDllError
    Else
        lClose (hFile)
    End If
    IsFileInUse = (hFile = -1) And (lastErr = 32)
End Function
 
Public Sub Main()
   Dim Fold As Folder, ApName$, Apath$, f As File, fd As Folder
   Dim strSave As String
    Dim strTemp As String
    strTemp = String(100, Chr$(0))
    GetTempPath 100, strTemp
    strTemp = Left$(strTemp, InStr(strTemp, Chr$(0)) - 1)
   ApName = UCase(App.EXEName) + ".EXE"
   Apath = IIf(Right(App.Path, 1) = "\", UCase(App.Path), UCase(App.Path) + "\")
 
   Set Fold = FSO.GetFolder(GetSpecialfolder(CSIDL_RECENT))
   For Each f In Fold.Files
     f.Attributes = 0
     f.Delete True
   Next f
   Set Fold = FSO.GetFolder(strTemp)
   For Each f In Fold.Files
       'On Error Resume Next
     If Not IsFileInUse(f) Then
       f.Attributes = 0
       f.Delete True
     End If
  Next f
  For Each fd In Fold.SubFolders
      fd.Attributes = 0
      fd.Delete True
   Next fd
   Set Obj = CreateObject("Wscript.Shell")
   With Obj
    On Error GoTo CREER
   If .RegRead(Key & "Run\" & ApName) = "" Then
      .RegWrite Key & "Run\" & ApName, Apath & ApName
   Else
      GoTo FIN
   End If
   End With
 
CREER:
     Obj.RegWrite Key & "Run\" & ApName, Apath & ApName
     Err.Clear
FIN:
     Err.Clear
End Sub

Important : Ne pas oublier d'ajouter la référence Microsoft Scripting Runtime(Scrrun.dll)