VIDER LES DOSSIERS TEMP ET RECENT

Option Explicit

Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type
Type SHITEMID
    cb As Long
    abID As Byte
End Type
Type ITEMIDLIST
    mSID As SHITEMID
End Type
Const CSIDL_RECENT = &H8
Const NOERROR = &H0
Const VER_PLATFORM_WIN32_NT = 2

Dim Obj As Object
'Const Key1 = "HKCU\Software\Microsoft\Windows\CurrentVersion\"
Const Key = "HKLM\Software\Microsoft\Windows\CurrentVersion\"

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Private Declare Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal lBuffer As Long) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long
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 ShowWindow Lib "USER32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function PostMessage Lib "USER32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Dim FSO As New FileSystemObject, FF&
Const WM_CLOSE = &H10
Const SW_SHOWMINNOACTIVE = 7
Private Function GetSpecialfolder(CSIDL As Long) As String
    Dim Ret&
    Dim IDL As ITEMIDLIST, Path$
    ' Retourne un dossier (SpecialFolder)
    Ret = SHGetSpecialFolderLocation(100, CSIDL, IDL)
    If Ret = NOERROR Then
        'Crée un tempon
        Path$ = Space$(512)
        ' Retourne un chemin à partir de  IDList
        Ret = SHGetPathFromIDList(ByVal IDL.mSID.cb, ByVal Path$)
        '  Supprime les espaces de fin
        GetSpecialfolder = Left$(Path, InStr(Path, Chr$(0)) - 1)
        Exit Function
    End If
    GetSpecialfolder = ""
End Function

Private Function IsWinNT() As Boolean
    Dim ThisOS As OSVERSIONINFO
    ThisOS.dwOSVersionInfoSize = Len(ThisOS)
    GetVersionEx ThisOS
    IsWinNT = (ThisOS.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function
Private Function batFile() As String
   batFile = IIf(Right(App.Path, 1) = "\", App.Path + "DelTmp.bat", App.Path + "\DelTmp.bat")
End Function
Private Function GetShortPath(strFileName As String) As String

    Dim lngRes As Long, strPath As String
    ' Crée un tempon
    strPath = String$(165, 0)
    '  Retourne le nom court du chemin
    lngRes = GetShortPathName(strFileName, strPath, 164)
    '  Supprime les espaces de fin
    GetShortPath = Left$(strPath, lngRes)
End Function
Private Sub CloseThisWindow(Ret As String)
   Dim WinWnd&
    '  Recherche la fenêtre
    WinWnd = FindWindow(vbNullString, Ret)
    If WinWnd = 0 Then MsgBox "Ne peut trouver la fenêtre ...": Exit Sub
    ' Affiche la fenêtre
    ShowWindow WinWnd, SW_SHOWMINNOACTIVE 'SW_SHOWNORMAL
    PostMessage WinWnd, WM_CLOSE, 0&, 0&
End Sub
Private Sub WaitToClose()
   Dim OK As Boolean
      OK = False
      Do
        OK = FindWindow(vbNullString, "Terminé - DelTmp")
        DoEvents
      Loop Until OK
      If OK Then
         CloseThisWindow ("Terminé - DelTmp")
         Sleep 500
         DeleteFile batFile
      End If
End Sub
Private Sub EcritFich(Optional OK1 As Integer = False, Optional OK2 As Integer = False)
    Dim sPath As String, strSave As String
    
    Dim strTemp As String
     '   Crée une chaîne tempon
    strTemp = String(100, Chr$(0))
    ' Retourne le chemin temporaire
    GetTempPath 100, strTemp
    '  Nettoyage du tempon des espaces indésirables
    strTemp = Left$(strTemp, InStr(strTemp, Chr$(0)) - 1)

    strSave = String(200, Chr$(0))
    '  Retourne le chemin du dossier Windows
    sPath = Left$(strSave, GetWindowsDirectory(strSave, Len(strSave)))
    FF = FreeFile
    ' Ecrit des données dans un fichier de commandes qui _
      sera exécuté par la suite.
      '   "Nul" est ajouté pour éviter l'ffichage de la liste _
        des fichiers ou dossiers supprimés
    Open batFile For Output As #FF
            Print #FF, "@Echo ON"
            If OK1 Then
            Print #FF, "@DelTree /Y " + GetShortPath(strTemp) + "* > Nul"
            End If
        If Not IsWinNT Then
            If OK2 Then
            Print #FF, "@DelTree /Y " + sPath + "\Recent\* > Nul"
            End If
        Else
           If OK2 Then
            Print #FF, "@DelTree /Y " & GetShortPath(GetSpecialfolder(CSIDL_RECENT)) + "\* > Nul"
           End If
        End If
     Close #FF
End Sub
Public Sub Main()
   Dim Fold$, AppName$, Apath$
   
   AppName = UCase(App.EXEName) + ".EXE"
   ' S'assure que le chemin se termine par "\"
   Apath = IIf(Right(App.Path, 1) = "\", UCase(App.Path), UCase(App.Path) + "\")
   ' Crée un objet pour accéder au registre et crée une _
     entrée pour le lancement du programme au démarrage _
    de WINDOWS
   Set Obj = CreateObject("Wscript.Shell")
   With Obj
     .RegWrite Key & "RunServices\" & AppName, Apath & AppName
   End With
   Call EcritFich(True, True)
   Fold = GetSpecialfolder(CSIDL_RECENT)
   Shell batFile, vbHide
   Call WaitToClose
End Sub