IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Vos contributions VB6 Discussion :

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


Sujet :

Vos contributions VB6

  1. #1
    Modérateur
    Avatar de l_autodidacte
    Homme Profil pro
    Retraité : Directeur de lycée/Professeur de sciences physiques
    Inscrit en
    Juillet 2009
    Messages
    2 417
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 69
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Retraité : Directeur de lycée/Professeur de sciences physiques
    Secteur : Enseignement

    Informations forums :
    Inscription : Juillet 2009
    Messages : 2 417
    Points : 5 816
    Points
    5 816
    Par défaut 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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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)

  2. #2
    Modérateur
    Avatar de l_autodidacte
    Homme Profil pro
    Retraité : Directeur de lycée/Professeur de sciences physiques
    Inscrit en
    Juillet 2009
    Messages
    2 417
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 69
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Retraité : Directeur de lycée/Professeur de sciences physiques
    Secteur : Enseignement

    Informations forums :
    Inscription : Juillet 2009
    Messages : 2 417
    Points : 5 816
    Points
    5 816
    Par défaut Une simple précision
    Une précision ou information n'est jamais de trop.

    Du moment que le code contient la procédure "Sub Main", il est clair que le code doit être placé dans dans un module de base (.bas). Chose que j'ai oubliée de mentionner dans mon post précédent et je m'en excuse.

Discussions similaires

  1. Petit utilitaire pour retrouver les codes ascii des fontes
    Par ProgElecT dans le forum Vos contributions VB6
    Réponses: 0
    Dernier message: 26/07/2007, 23h52
  2. Utilitaire pour renouveler les index d'une base de données paradox
    Par jenteldz47 dans le forum Bases de données
    Réponses: 3
    Dernier message: 09/07/2007, 12h58
  3. utilitaire pour corriger les erreurs disk
    Par mouna201 dans le forum Composants
    Réponses: 2
    Dernier message: 17/11/2006, 13h07
  4. Utilitaire pour voir les dépendances d'un projet
    Par Najdar dans le forum VB 6 et antérieur
    Réponses: 6
    Dernier message: 02/11/2006, 22h56

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo