utilitaires système

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Le Soldat Inconnu
Messages : 4312
Inscription : mer. 28/janv./2004 20:58
Localisation : Clermont ferrand OU Olsztyn
Contact :

utilitaires système

Message par Le Soldat Inconnu »

Salut,

un petit code, enfin petit ... bon, n'ergotons pas :roll:

donc il permet de faire les choses suivantes :
- Ouvrir le panneau de config
- Ouvrir l'ajout suppression de programme
- de modifier les logiciels qui se lance au démarrage du système
- de vider la corbeille, le dossier "temp" et le dossier "récents"
- d'ajouter ou supprimer des raccourcis dans le dossier "Envoyer vers"

et c'est tout, c'est déjà pas mal :wink:

Code : Tout sélectionner

Global Nb.l, Gain.l, Reste.l

Enumeration
  #Menu
  #Panneau_Configuration
  #Vider_Corbeille
  #Vider_Temp
  #Envoyer_vers
  #Lancement_Demarrage
  #Ajout_Supression_Programme
  #Vider_Recents
  #Liste
  #Ajouter
  #Supprimer
  #NouveauDossier
  #Remonter
  #Renommer
  ; #Monter
  ; #Descendre
  #Ajouter_Image
  #Supprimer_Image
  #NouveauDossier_Image
  #Remonter_Image
  #Renommer_Image
  
  ; Lancement au démarrage
  #UtilisateurActuel
  #UtilisateurTous
  #Sauver
  #Restaurer
  #Info
  #Texte_Sauvegarde
EndEnumeration

Procedure.s ApplicationDir()
  appdir$ = Space(255)
  GetCurrentDirectory_(255, @appdir$)
  If Right(appdir$, 1) <> "\" ; si l'adresse ne finit pas par "\"
    appdir$ = appdir$ + "\" ; on rajoute le "\"
  EndIf
  ProcedureReturn appdir$
EndProcedure

Structure SH_FILEINFO ; la structure SH FILE INFO PB est fausse
  hIcon.l
  iIcon.l
  dwAttributes.l
  szDisplayName.b[#MAX_PATH]
  szTypeName.b[80]
EndStructure

Procedure.l ExtractSmallIconFile(IconPath.s)
  ; Cette procedure permet d'extraire l'ID de l'icône 16*16 associé au type de fichier ou au dossier dont l'adresse est IconPath
  SHGetFileInfo_(IconPath, 0, @InfosFile.SH_FILEINFO, SizeOf(SH_FILEINFO), #SHGFI_ICON | #SHGFI_SMALLICON)
  ProcedureReturn InfosFile\hIcon
EndProcedure

Procedure CreateShellLink(PATH$, LINK$, Argument$, DESCRIPTION$, WorkingDirectory$, ShowCommand.l, HotKey.l, IconFile$, IconIndexInFile.l)
  CoInitialize_(0)
  If CoCreateInstance_(?CLSID_ShellLink, 0, 1, ?IID_IShellLink, @psl.IShellLinkA) = 0
    
    Set_ShellLink_preferences :
    
    ; The file TO which is linked ( = target for the Link )
    ;
    psl\SetPath(@PATH$)
    
    ; Arguments for the Target
    ;
    psl\SetArguments(@Argument$)
    
    ; Working Directory
    ;
    psl\SetWorkingDirectory(@WorkingDirectory$)
    
    ; Description ( also used as Tooltip for the Link )
    ;
    psl\SetDescription(@DESCRIPTION$)
    
    ; Show command:
    ; SW_SHOWNORMAL = Default
    ; SW_SHOWMAXIMIZED = aehmm... Maximized
    ; SW_SHOWMINIMIZED = play Unreal Tournament
    psl\SetShowCmd(ShowCommand)
    
    ; Hotkey:
    ; The virtual key code is in the low-order byte,
    ; and the modifier flags are in the high-order byte.
    ; The modifier flags can be a combination of the following values:
    ;
    ; HOTKEYF_ALT = ALT key
    ; HOTKEYF_CONTROL = CTRL key
    ; HOTKEYF_EXT = Extended key
    ; HOTKEYF_SHIFT = SHIFT key
    ;
    psl\SetHotkey(HotKey)
    
    ; Set Icon for the Link:
    ; There can be more than 1 icons in an icon resource file,
    ; so you have to specify the index.
    ;
    psl\SetIconLocation(@IconFile$, IconIndexInFile)
    
    
    ShellLink_SAVE :
    ; Query IShellLink For the IPersistFile interface For saving the
    ; shortcut in persistent storage.
    If psl\QueryInterface(?IID_IPersistFile, @ppf.IPersistFile) = 0
      ; Ensure that the string is Unicode.
      Mem.s = Space(1000) ; AllocateMemory(1,1000)
      MultiByteToWideChar_(#CP_ACP, 0, LINK$, -1, Mem, 1000)
      ; Save the link by calling IPersistFile::Save.
      hres = ppf\Save(@Mem, #True)
      result = 1
      ppf\Release()
    EndIf
    psl\Release()
  EndIf
  CoUninitialize_()
  ProcedureReturn result
  
  DataSection
    CLSID_ShellLink :
    ; 00021401-0000-0000-C000-000000000046
      Data.l $00021401
      Data.w $0000, $0000
      Data.b $C0, $00, $00, $00, $00, $00, $00, $46
    IID_IShellLink :
    ; DEFINE_SHLGUID(IID_IShellLinkA, 0x000214EEL, 0, 0);
    ; C000-000000000046
      Data.l $000214EE
      Data.w $0000, $0000
      Data.b $C0, $00, $00, $00, $00, $00, $00, $46
    IID_IPersistFile :
    ; 0000010b-0000-0000-C000-000000000046
      Data.l $0000010B
      Data.w $0000, $0000
      Data.b $C0, $00, $00, $00, $00, $00, $00, $46
  EndDataSection
  
EndProcedure

Procedure.s GetTempDirectory()
  Protected WinTemp.s
  WinTemp = Space(255)
  GetTempPath_(255, WinTemp)
  If Right(WinTemp, 1) <> "\" : WinTemp = WinTemp + "\" : EndIf
  ProcedureReturn WinTemp
EndProcedure

Procedure.s GetWindowsDirectory()
  Protected WinFolder.s
  WinFolder = Space(255)
  GetWindowsDirectory_(WinFolder, 255)
  If Right(WinFolder, 1) <> "\" : WinFolder = WinFolder + "\" : EndIf
  ProcedureReturn WinFolder
EndProcedure

Procedure Vider_Corbeille()
  If OpenLibrary(0, "shell32.dll")
    CallFunction(0, "SHEmptyRecycleBinA", WindowID(0), "", 0)
    CallFunction(0, "SHUpdateRecycleBinIcon")
    CloseLibrary(0)
  EndIf
EndProcedure

Procedure Nettoyer(Folder.s, n)
  If Right(Folder, 1) <> "\" : Folder + "\" : EndIf
  If ExamineDirectory(n, Folder, "*.*")
    Repeat
      Filetype = NextDirectoryEntry()
      Nom.s = DirectoryEntryName()
      If Filetype = 1
        If DeleteFile(Folder + Nom)
          Gain + DirectoryEntrySize()
          Nb + 1
        Else
          Reste + 1
        EndIf
      ElseIf Filetype = 2 And Nom <> ".." And Nom <> "."
        Nettoyer(Folder + Nom, n + 1)
        DeleteDirectory(Folder + Nom, "*.*", #PB_FileSystem_Force)
        UseDirectory(n)
      EndIf
    Until Filetype = 0
  EndIf
EndProcedure

Procedure.s DisplaySize(size.l)
  If size >= 1000 : unit = 1 : approximation = 2 : EndIf
  If size >= 10000 : unit = 1 : approximation = 1 : EndIf
  If size >= 1000000 : unit = 2 : approximation = 2 : EndIf
  If size >= 10000000 : unit = 2 : approximation = 1 : EndIf
  Select unit
    Case 1 : val = 1024 : Txt.s = " Ko"
    Case 2 : val = 1024 * 1024 : Txt = " Mo"
    Default : val = 1 : Txt = " octects"
  EndSelect
  ProcedureReturn StrF(size / val, approximation) + Txt
EndProcedure

Procedure Resultat()
  CreatePopupMenu(1)
  MenuItem(10, "Nettoyage terminé")
  SetMenuItemState(1, 10, 1)
  MenuBar()
  If Nb > 1
    MenuItem(11, Str(Nb) + " Fichiers supprimés [" + DisplaySize(Gain) + "]")
  Else
    MenuItem(11, Str(Nb) + " Fichier supprimé [" + DisplaySize(Gain) + "]")
  EndIf
  If Reste
    MenuItem(11, Str(Reste) + " Fichiers non supprimés")
  EndIf
  DisplayPopupMenu(1, WindowID())
EndProcedure

Procedure.s GetSpecialFolderLocation(lngCSIDL.l)
  Protected lngRet.l
  Protected strLocation.s
  Protected pidl.l
  strLocation = Space(260)
  lngRet = SHGetSpecialFolderLocation_(0, lngCSIDL, @pidl)
  If lngRet = 0
    SHGetPathFromIDList_(pidl, @strLocation)
    If lngRet = 0
      strLocation = RTrim(strLocation)
      If Right(strLocation, 1) <> "\"
        strLocation = strLocation + "\"
      EndIf
      ProcedureReturn strLocation
    EndIf
    CoTaskMemFree_(pidl)
  EndIf
EndProcedure

Procedure ListIconGadgetXP(GadgetID.l, x.l, y.l, tx.l, ty.l, colonne.s, largeur.l, options.l)
  ; Même paramètres que pour une ListIconGadget, seule le paramètres options est obligatoire, mettre 0 si vous ne mettez pas d'option
  ListIconGadget(GadgetID, x, y, tx, ty, colonne, largeur, options)
  #LVM_SETEXTENDEDLISTVIEWSTYLE = 4150 : #LVS_EX_SUBITEMIMAGES = 2
  hImageListS.l = SHGetFileInfo_("c:\", 0, @InfosFile.SH_FILEINFO, SizeOf(SH_FILEINFO), #SHGFI_SYSICONINDEX | #SHGFI_SMALLICON)
  SendMessage_(GadgetID(GadgetID), #LVM_SETIMAGELIST, #LVSIL_SMALL, hImageListS)
  SendMessage_(GadgetID(GadgetID), #LVM_SETEXTENDEDLISTVIEWSTYLE, #LVS_EX_SUBITEMIMAGES, #LVS_EX_SUBITEMIMAGES)
EndProcedure

Procedure AddGadgetItemXP(GadgetID.l, Pos.l, Texte.s, IconPath.s)
  Protected var.LV_ITEM
  ; GadgetID : Numéro de la ListIconGadgetXP
  ; Pos : position à laqualle on souhaite insérer l'élément
  ; Texte : Texte de l'élément
  ; IconPath : Fichier dont on souhaite affiché l'icône
  
  SHGetFileInfo_(IconPath, 0, @InfosFile.SH_FILEINFO, SizeOf(SH_FILEINFO), #SHGFI_SYSICONINDEX | #SHGFI_SMALLICON)
  
  var\mask = #LVIF_IMAGE | #LVIF_TEXT
  var\iSubitem = 0
  var\iItem = Pos
  var\pszText = @Texte
  var\iImage = InfosFile\iIcon
  SendMessage_(GadgetID(GadgetID), #LVM_INSERTITEM, 0, @var)
EndProcedure

Dim Fichier.s(1000)
Dim Dossier.s(1000)

Procedure MoveFileToRecycleBin(DeletedFile.s)
  Protected lpFileOp.SHFILEOPSTRUCT
  
  If FileSize(DeletedFile) <> - 1
    If Right(DeletedFile, 1) = "\"
      DeletedFile = Left(DeletedFile, Len(DeletedFile) - 1)
    EndIf
    
    Mem = AllocateMemory(Len(DeletedFile) + 2)
    If Mem
      lpFileOp\hwnd = 0
      lpFileOp\pTo = 0
      lpFileOp\wFunc = #FO_DELETE
      lpFileOp\pFrom = Mem
      lpFileOp\fFlags = #FOF_ALLOWUNDO | #FOF_NOCONFIRMATION
      
      CopyMemoryString(DeletedFile, @Mem)
      CopyMemoryString(Chr(0))
      CopyMemoryString(Chr(0))
      
      SHFileOperation_(@lpFileOp)
      
      FreeMemory(0)
    EndIf
  EndIf
EndProcedure

Procedure ChargeDossier(Folder.s)
  Protected PosF, PosD, Filetype, Nom.s, n, Event
  
  If ExamineDirectory(0, Folder, "*.*")
    
    PosF = 0
    PosD = 0
    Repeat
      
      Filetype = NextDirectoryEntry()
      Nom.s = DirectoryEntryName()
      
      If Filetype = 1
        Fichier(PosF) = Nom
        PosF + 1
      ElseIf Filetype = 2 And Nom <> "." And Nom <> ".."
        Dossier(PosD) = Nom
        PosD + 1
      EndIf
      
    Until Filetype = 0
    
    SortArray(Fichier(), 2, 0, PosF - 1)
    SortArray(Dossier(), 2, 0, PosD - 1)
    
    For n = 0 To PosD - 1
      AddGadgetItemXP(#Liste, n, Dossier(n), Folder + Dossier(n))
      UpdateWindow_(WindowID())
      Repeat ; pour quitter en cours d'analyse
        Event = WindowEvent()
        If Event = #WM_CLOSE
          End
        EndIf
      Until Event = 0
    Next
    
    For n = 0 To PosF - 1
      AddGadgetItemXP(#Liste, PosD + n, Fichier(n), Folder + Fichier(n))
      UpdateWindow_(WindowID())
      Repeat ; pour quitter en cours d'analyse
        Event = WindowEvent()
        If Event = #WM_CLOSE
          End
        EndIf
      Until Event = 0
    Next
    
  Else
    HideWindow(1, 1)
    MessageRequester("Erreur", "Impossible d'analyser le dossier suivant :" + Chr(10) + Folder, 0)
    HideWindow(1, 0)
  EndIf
EndProcedure

Procedure Envoyer_Vers()
  Protected dropped.l, num.l, index.l, size.l, FileName.s, Dossier.s, Fichier.s, Txt.s, n, Event, Pos
  
  If OpenWindow(1, 0, 0, 300, 200, #PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_MinimizeGadget, "Menu 'Envoyer vers'") And CreateGadgetList(WindowID())
    SetWindowPos_(WindowID(), -1, 0, 0, 0, 0, #SWP_NOSIZE | #SWP_NOMOVE) ; on met la fenêtre au premier plan
    
    ListIconGadgetXP(#Liste, 0, 0, 195, 200, "Eléments", 168, #PB_ListIcon_FullRowSelect | #PB_ListIcon_AlwaysShowSelection | #PB_ListIcon_MultiSelect)
    Dossier.s = GetSpecialFolderLocation(9) ; on récupère l'adresse du dossier SendTo
    ChargeDossier(Dossier) ; on charge la liste
    DragAcceptFiles_(GadgetID(#Liste), #True) ; Accepter le glisser déposer sur la liste
    
    ButtonGadget(#Ajouter, 220, 2, 78, 22, "Ajouter")
    ButtonGadget(#Renommer, 220, 24, 78, 22, "Renommer")
    ButtonGadget(#Supprimer, 220, 46, 78, 22, "Supprimer")
    
    ButtonGadget(#NouveauDossier, 220, 72, 78, 22, "Dossier")
    GadgetToolTip(#NouveauDossier, "Créer un nouveau dossier")
    ButtonGadget(#Remonter, 220, 94, 78, 22, "Remonter")
    
    Repeat
      Event = WaitWindowEvent()
      
      If Event = #PB_EventGadget
        Select EventGadgetID() ; boutons, zone de texte, ...
          Case #Supprimer ; Pour supprimer un élément
            For n = 0 To CountGadgetItems(#Liste) - 1 ; On va tester tous les éléments de la liste
              If GetGadgetItemState(#Liste, n) & #PB_ListIcon_Selected ; on regarde si l'élément est sélectionné
                Fichier.s = Dossier + GetGadgetItemText(#Liste, n, 0)
                MoveFileToRecycleBin(Fichier) ; On envoi le fichier à la corbeille
                RemoveGadgetItem(#Liste, n) ; on retire l'élément de la liste
              EndIf
            Next
            
          Case #Ajouter ; Pour ajouter un élément
            MessageRequester("Ajout", "Glisser déposer les dossiers dans la liste pour les ajouter", 0)
            
          Case #NouveauDossier ; Pour créer un nouveau dossier
            Txt.s = InputRequester("Nouveau dossier", "Entrez le nom du dossier :", "")
            If Txt <> "" And IsFilename(Txt) ; Si le nom est correct
              CreateDirectory(Dossier + Txt) ; on crée le dossier
              AddGadgetItemXP(#Liste, -1, Txt, Dossier + Txt) ; on ajoute le dossier dans la liste
            EndIf
            
          Case #Remonter ; Pour remonter d'un niveau dans l'arborescence des dossiers
            If Len(Dossier) > Len(GetSpecialFolderLocation(9)) ; on regarde si le dossier est actuel est plus grand que l'adresse du dossier SendTo
              Dossier = GetPathPart(Left(Dossier, Len(Dossier) - 1)) ; on descend d'un niveau
              If Right(Dossier, 1) <> "\"
                Dossier = Dossier + "\"
              EndIf
              ClearGadgetItemList(#Liste) ; on vide la liste
              ChargeDossier(Dossier) ; on la recharge
            EndIf
            
          Case #Liste
            Pos = GetGadgetState(#Liste)
            If Pos <> - 1
              Select EventType()
                Case #PB_EventType_LeftDoubleClick ; Si on double clic sur un élément de la liste
                  Fichier.s = GetGadgetItemText(#Liste, Pos, 0)
                  If FileSize(Dossier + Fichier) >= 0 ; on teste si c'est un fichier
                    ; On renomme le fichier
                    Txt.s = InputRequester("Renommer", "Entrez le nouveau nom :", GetGadgetItemText(#Liste, n, 0))
                    If Txt <> "" And IsFilename(Txt)
                      If RenameFile(Dossier + GetGadgetItemText(#Liste, Pos, 0), Dossier + Txt)
                        SetGadgetItemText(#Liste, Pos, Txt, 0)
                      EndIf
                    EndIf
                  ElseIf FileSize(Dossier + Fichier) = -2 ; on teste si c'est un dossier
                    ; on ouvre le dossier
                    Dossier = Dossier + Fichier
                    If Right(Dossier, 1) <> "\"
                      Dossier = Dossier + "\"
                    EndIf
                    ClearGadgetItemList(#Liste) ; efface la liste
                    ChargeDossier(Dossier) ; recharge la liste
                  EndIf
                  
              EndSelect
            EndIf
            
          Case #Renommer ; Renommer le fichier ou dossier
            Pos = GetGadgetState(#Liste)
            Txt.s = InputRequester("Renommer", "Entrez le nouveau nom :", GetGadgetItemText(#Liste, n, 0))
            If Txt <> "" And IsFilename(Txt) ; si le nom du fichier est correct
              If RenameFile(Dossier + GetGadgetItemText(#Liste, Pos, 0), Dossier + Txt) ; on renomme le fichier
                SetGadgetItemText(#Liste, Pos, Txt, 0) ; on change le texte de la liste si le fichier à été renommer correctement
              EndIf
            EndIf
            
        EndSelect
        
      ElseIf Event = #WM_DROPFILES ; Glisser déposer
        dropped.l = EventwParam()
        num.l = DragQueryFile_(dropped, -1, "", 0)
        For index = 0 To num - 1
          size.l = DragQueryFile_(dropped, index, 0, 0)
          FileName.s = Space(size)
          DragQueryFile_(dropped, index, FileName, size + 1)
          If FileSize(FileName) = -2
            CreateShellLink(FileName, Dossier + GetFilePart(FileName + ".lnk"), "", "", "", #SW_SHOWNORMAL, 0, FileName, 0)
            AddGadgetItemXP(#Liste, -1, GetFilePart(FileName + ".lnk"), Dossier + GetFilePart(FileName + ".lnk"))
          EndIf
        Next
        DragFinish_(dropped)
      EndIf
      
    Until Event = #PB_Event_CloseWindow
    
  EndIf
EndProcedure

Procedure.s GetFileFromShellLink(pszShortcutFile.s)
  ; Pour récupérer la cible du raccourci
  CoInitialize_(0)
  
  #STGM_READ = 0
  #SLGP_SHORTPATH = 2
  
  If CoCreateInstance_(?CLSID_ShellLink2, 0, 1, ?IID_IShellLink2, @psl.IShellLinkA ) = 0
    
    If psl\QueryInterface(?IID_IPersistFile2, @ppf.IPersistFile) = 0
      
      size.l = MultiByteToWideChar_(#CP_ACP, 0, pszShortcutFile, -1, 0, 0)
      Dim unicode.w(size)
      MultiByteToWideChar_(#CP_ACP, 0, pszShortcutFile, Len(pszShortcutFile), unicode(), size)
      
      If ppf\Load(unicode(), #STGM_READ) = 0
        szGotPath.s = Space(1024)
        psl\GetPath(@szGotPath, 1024, 0, #SLGP_SHORTPATH)
      EndIf
      
      ppf\Release()
    EndIf
    
    psl\Release()
  EndIf
  
  CoUninitialize_()
  ProcedureReturn szGotPath
  
  DataSection
    CLSID_ShellLink2 :
    ; 00021401-0000-0000-C000-000000000046
      Data.l $00021401
      Data.w $0000, $0000
      Data.b $C0, $00, $00, $00, $00, $00, $00, $46
    IID_IShellLink2 :
    ; DEFINE_SHLGUID(IID_IShellLinkA,         0x000214EEL, 0, 0);
    ; C000-000000000046
      Data.l $000214EE
      Data.w $0000, $0000
      Data.b $C0, $00, $00, $00, $00, $00, $00, $46
    IID_IPersistFile2 :
    ; 0000010b-0000-0000-C000-000000000046
      Data.l $0000010B
      Data.w $0000, $0000
      Data.b $C0, $00, $00, $00, $00, $00, $00, $46
  EndDataSection
  
EndProcedure

Procedure ChargeRegistre(Utilisateur.l)
  Protected hKey.l, Nom.s, Cible.s, Type.l, Taille.l, Cible2.s, MenuDemarrer.s, Txt.s, Pos.l
  
  If Utilisateur = 1 ; On regarde quel clé de registre on doit ouvrir
    Resultat = RegOpenKey_(#HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Run", @hKey) ; Clé de registre du démarrage de l'utilisateur actuel
  Else
    Resultat = RegOpenKey_(#HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run", @hKey) ; Clé de registre du démarrage de tous les utilisateurs
  EndIf
  If Resultat = 0 ; Si le résultat est égal à 0, on a réussi à ouvrir la clé de registre
    n = 0
    Taille.l = 255
    Nom = Space(Taille)
    Cible = Space(Taille)
    While RegEnumValue_(hKey, n, @Nom, @Taille, 0, @Type, @Cible, @Taille) <> #ERROR_NO_MORE_ITEMS ; Tant qu'il reste des valeur dans la clé de registre
      ; Nom est le nom de la valeur
      ; Cible est le contenu de la valeur
      ; Type est le type de la valeur
      
      ; On nettoie le texte de la cible pour tener de trouver l'icone correspondant
      ; pour cela, on retire les " et les paramètre d'exécution du programme
      Cible2 = RemoveString(Cible, Chr(34))
      Pos = Len(Cible2) + 1
      Repeat
        Pos - 1
      Until Mid(Cible2, Pos, 1) = "." Or Pos = 1
      Repeat
        Pos + 1
      Until Mid(Cible2, Pos, 1) = " " Or Pos = Len(Cible2) + 1
      Cible2 = Left(Cible2, Pos - 1)
      
      ; Si le type est un string et que le fichier contenu dans la cible existe
      If Type = #REG_SZ And FileSize(Cible2) <> - 1
        AddGadgetItemXP(#Liste, n, Nom, Cible2) ; on écrit une nouvelle ligne avec le nomp dans la ListIconGadget
      Else ; sinon
        AddGadgetItemXP(#Liste, n, Nom, "") ; ici, c'est normalement l'adresse d'un icône qui représente une clé de registre
      EndIf
      
      ; On complète la valeur avec la cible et le type
      SetGadgetItemText(#Liste, n, Cible, 1)
      SetGadgetItemText(#Liste, n, "Clé de registre", 2)
      
      ; On prépare les variables pour rechercher la valeur suivante dans la clé de registre
      n + 1
      Taille = 255
      Nom = Space(Taille)
      Cible = Space(Taille)
    Wend
    RegCloseKey_(hKey) ; on ferme la clé de registre ouverte
  EndIf
  
  ; On recherche dans le menu démarrer
  ; Menu démarrer\Programmes\Démarrage\
  If Utilisateur = 1
    MenuDemarrer = GetSpecialFolderLocation(7) ; On récupère l'adresse du dossier de démarrage de l'utilisateur actuel
  Else
    MenuDemarrer = GetSpecialFolderLocation(24) ; On récupère l'adresse du dossier de démarrage de tous les utilisateurs
  EndIf
  If ExamineDirectory(0, MenuDemarrer, "*.*") ; Si on peut analyser le dossier
    Repeat ; On recherche tous les raccourci contenu dans le dossier
      Filetype = NextDirectoryEntry()
      Nom = DirectoryEntryName()
      If Filetype = 1 And LCase(Nom) <> "desktop.ini" ; On prend soin de filtrer le fichier desktop.ini
        AddGadgetItemXP(#Liste, n, Nom, MenuDemarrer + Nom) ; On complète la ListIconGadget
        SetGadgetItemText(#Liste, n, GetFileFromShellLink(MenuDemarrer + Nom), 1)
        SetGadgetItemText(#Liste, n, "Menu démarrer", 2)
        n + 1
      EndIf
    Until Filetype = 0
  EndIf
  
EndProcedure

Procedure Demarrage()
  If OpenWindow(1, 0, 0, 700, 225, #PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_MinimizeGadget, "Démarrage du système") And CreateGadgetList(WindowID())
    ; SetWindowPos_(WindowID(), -1, 0, 0, 0, 0, #SWP_NOSIZE | #SWP_NOMOVE) ; on met la fenêtre au premier plan
    
    ListIconGadgetXP(#Liste, 0, 0, 700, 200, "Nom", 150, #PB_ListIcon_FullRowSelect)
    AddGadgetColumn(#Liste, 1, "Cible", 430)
    AddGadgetColumn(#Liste, 2, "Emplacement", 90)
    
    ChargeRegistre(1)
    
    ButtonGadget(#UtilisateurActuel, 0, 201, 100, 23, "Utilisateur actuel", #PB_Button_Toggle)
    ButtonGadget(#UtilisateurTous, 100, 201, 100, 23, "Tous les utilisateur", #PB_Button_Toggle)
    SetGadgetState(#UtilisateurActuel, 1)
    
    ButtonGadget(#Sauver, 210, 201, 100, 23, "Sauver")
    GadgetToolTip(#Sauver, "Sauver l'état actuel des programmes lancés au démarrage du registre")
    ButtonGadget(#Restaurer, 310, 201, 100, 23, "Restaurer")
    GadgetToolTip(#Restaurer, "Restaurer l'état des programmes lancés au démarrage du registre")
    
    ButtonGadget(#Supprimer, 420, 201, 100, 23, "Supprimer")
    GadgetToolTip(#Supprimer, "Supprimer ce programme du démarrage de l'ordinateur")
    
    Utilisateur.s = Space(255)
    Longueur.l = 255
    GetUserName_(@Utilisateur, @Longueur)
    
    Repeat
      Event = WaitWindowEvent()
      
      If Event = #PB_EventGadget
        Select EventGadgetID() ; boutons, zone de texte, ...
          Case #UtilisateurActuel
            SetGadgetState(#UtilisateurActuel, 1)
            SetGadgetState(#UtilisateurTous, 0)
            ClearGadgetItemList(#Liste)
            ChargeRegistre(1)
            
          Case #UtilisateurTous
            SetGadgetState(#UtilisateurActuel, 0)
            SetGadgetState(#UtilisateurTous, 1)
            ClearGadgetItemList(#Liste)
            ChargeRegistre(2)
            
          Case #Sauver
            If OpenWindow(2, 0, 0, 200, 25, #PB_Window_BorderLess | #WS_THICKFRAME | #PB_Window_WindowCentered, "Sauvegarde en cours", WindowID(1))
              If CreateGadgetList(WindowID())
                TextGadget(#Texte_Sauvegarde, 0, 5, 200, 15, "Sauvegarde en cours ...", #PB_Text_Center)
              EndIf
              UpdateWindow_(WindowID())
              Delay(1000)
              CreateDirectory("Démarrage système")
              CreateDirectory("Démarrage système\" + Utilisateur)
              CreateDirectory("Démarrage système\Tous les utilisateurs")
              
              ; Sauvegarde de l'utilisateur actuel
              If CreateFile(0, "Démarrage système\" + Utilisateur + "\Sauvegarde registre.reg")
                ClearGadgetItemList(#Liste)
                ChargeRegistre(1)
                Pos = 0
                ; Sauvegarde du registre
                WriteStringN("Windows Registry Editor Version 5.00") ; En-tête du fichier
                WriteStringN("")
                WriteStringN("[HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run]") ; Emplacement des clés de registre
                While Pos < CountGadgetItems(#Liste) And GetGadgetItemText(#Liste, Pos, 2) = "Clé de registre"
                  WriteString(Chr(34) + GetGadgetItemText(#Liste, Pos, 0) + Chr(34) + "=")
                  WriteStringN(Chr(34) + ReplaceString(ReplaceString(GetGadgetItemText(#Liste, Pos, 1), "\", "\\"), Chr(34), "\" + Chr(34)) + Chr(34))
                  Pos + 1
                Wend
                CloseFile(0) ; On ferme le fichier
                
                ; Sauvegarde du menu démarrer
                Pos - 1
                While Pos < CountGadgetItems(#Liste)
                  CopyFile(GetSpecialFolderLocation(7) + GetGadgetItemText(#Liste, Pos, 0), "Démarrage système\" + Utilisateur + "\" + GetGadgetItemText(#Liste, Pos, 0))
                  Pos + 1
                Wend
                
              Else
                MessageRequester("Erreur", "Impossible de sauvegarder le contenu du registre contenant les informations du démarrage de l'utilisateur actuel.", 0)
              EndIf
              
              ; Sauvegarde de tous les utilisateurs
              If CreateFile(0, "Démarrage système\Tous les utilisateurs\Sauvegarde registre.reg")
                ClearGadgetItemList(#Liste)
                ChargeRegistre(2)
                Pos = 0
                ; Sauvegarde du registre
                WriteStringN("Windows Registry Editor Version 5.00") ; En-tête du fichier
                WriteStringN("")
                WriteStringN("[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run]") ; Emplacement des clés de registre
                While Pos < CountGadgetItems(#Liste) And GetGadgetItemText(#Liste, Pos, 2) = "Clé de registre"
                  WriteString(Chr(34) + GetGadgetItemText(#Liste, Pos, 0) + Chr(34) + "=")
                  WriteStringN(Chr(34) + ReplaceString(ReplaceString(GetGadgetItemText(#Liste, Pos, 1), "\", "\\"), Chr(34), "\" + Chr(34)) + Chr(34))
                  Pos + 1
                Wend
                CloseFile(0) ; On ferme le fichier
                
                ; Sauvegarde du menu démarrer
                Pos - 1
                While Pos < CountGadgetItems(#Liste)
                  CopyFile(GetSpecialFolderLocation(24) + GetGadgetItemText(#Liste, Pos, 0), "Démarrage système\Tous les utilisateurs\" + GetGadgetItemText(#Liste, Pos, 0))
                  Pos + 1
                Wend
                
              Else
                MessageRequester("Erreur", "Impossible de sauvegarder le contenu du registre contenant les informations du démarrage de tous les utilisateurs.", 0)
              EndIf
              
              ; On charge la liste de démarrage ouverte
              If GetGadgetState(#UtilisateurActuel)
                ClearGadgetItemList(#Liste)
                ChargeRegistre(1)
              EndIf
              
              CloseWindow(2)
              UseWindow(1)
              UseGadgetList(WindowID())
            EndIf
            
          Case #Restaurer
            RunProgram(ApplicationDir() + "Démarrage système\" + Utilisateur + "\Sauvegarde registre.reg", "", "", 1)
            RunProgram(ApplicationDir() + "Démarrage système\Tous les utilisateurs\Sauvegarde registre.reg", "", "", 1)
            If ExamineDirectory(0, "Démarrage système\" + Utilisateur + "\", "*.*")
              Repeat
                Filetype = NextDirectoryEntry()
                Nom.s = DirectoryEntryName()
                If Filetype = 1 And LCase(Nom) <> "desktop.ini" And LCase(Nom) <> "sauvegarde registre.reg"
                  CopyFile("Démarrage système\" + Utilisateur + "\" + Nom, GetSpecialFolderLocation(7) + Nom)
                EndIf
              Until Filetype = 0
            EndIf
            If ExamineDirectory(0, "Démarrage système\Tous les utilisateurs\", "*.*")
              Repeat
                Filetype = NextDirectoryEntry()
                Nom = DirectoryEntryName()
                If Filetype = 1 And LCase(Nom) <> "desktop.ini" And LCase(Nom) <> "sauvegarde registre.reg"
                  CopyFile("Démarrage système\Tous les utilisateurs\" + Nom, GetSpecialFolderLocation(24) + Nom)
                EndIf
              Until Filetype = 0
            EndIf
            If GetGadgetState(#UtilisateurActuel)
              ClearGadgetItemList(#Liste)
              ChargeRegistre(1)
            Else
              ClearGadgetItemList(#Liste)
              ChargeRegistre(2)
            EndIf
            
          Case #Supprimer
            Pos = GetGadgetState(#Liste)
            If Pos >= 0
              If GetGadgetItemText(#Liste, Pos, 2) = "Clé de registre"
                If GetGadgetState(#UtilisateurActuel)
                  Resultat = RegOpenKey_(#HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Run", @hKey)
                Else
                  Resultat = RegOpenKey_(#HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run", @hKey)
                EndIf
                If Resultat = 0
                  RegDeleteValue_(hKey, GetGadgetItemText(#Liste, Pos, 0))
                  RegCloseKey_(hKey)
                EndIf
              Else
                If GetGadgetState(#UtilisateurActuel)
                  DeleteFile(GetSpecialFolderLocation(7) + GetGadgetItemText(#Liste, Pos, 0))
                Else
                  DeleteFile(GetSpecialFolderLocation(24) + GetGadgetItemText(#Liste, Pos, 0))
                EndIf
              EndIf
              RemoveGadgetItem(#Liste, Pos)
            EndIf
            
        EndSelect
      EndIf
      
    Until Event = #PB_Event_CloseWindow
    
  EndIf
EndProcedure



;- Début du programme

;- Test Envoyer vers
; Envoyer_Vers()
; End

;- Test Démarrage
; Demarrage()
; End

If CreatePopupMenu(#Menu) And OpenWindow(0, 0, 0, 200, 200, #PB_Window_Invisible, "Système")
  MenuItem(#Panneau_Configuration, "Panneau de configuration")
  MenuBar()
  MenuItem(#Ajout_Supression_Programme, "Ajout/Supression de programmes")
  MenuItem(#Lancement_Demarrage, "Démarrage du système")
  MenuBar()
  OpenSubMenu("Nettoyage")
    MenuItem(#Vider_Corbeille, "Vider la corbeille")
    MenuItem(#Vider_Temp, "Vider le dossier temporaire")
    MenuItem(#Vider_Recents, "Vider le le dossier 'Récents'")
  CloseSubMenu()
  MenuBar()
  MenuItem(#Envoyer_vers, "Menu 'Envoyer vers'")
Else
  MessageRequester("Erreur", "Impossible d'ouvrir le menu", 0)
  End
EndIf

DisplayPopupMenu(#Menu, WindowID(0))

Event = WindowEvent()

If Event = #PB_EventMenu
  Select EventMenuID() ; menu et barre d'outils
    Case #Panneau_Configuration
      RunProgram("::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\::{21EC2020-3AEA-1069-A2DD-08002B30309D}")
      
    Case #Vider_Corbeille
      Vider_Corbeille()
      
    Case #Vider_Temp
      Temp1.s = GetTempDirectory()
      Temp2.s = GetWindowsDirectory() + "Temp\"
      Nettoyer(Temp1, 1)
      If LCase(Temp1) <> LCase(Temp2)
        Nettoyer(Temp2, 1)
      EndIf
      Resultat()
      
    Case #Ajout_Supression_Programme
      RunProgram("rundll32.exe", "shell32, Control_RunDLL appwiz.cpl", "")
      
    Case #Vider_Recents
      Nettoyer(GetSpecialFolderLocation($8), 1)
      Resultat()
      
    Case #Envoyer_vers
      Envoyer_Vers()
      
    Case #Lancement_Demarrage
      Demarrage()
      
  EndSelect
EndIf
par contre, j'ai pas testé sur 98, Me et NT et je ne suis pas sur que le code va marcher dessus, donc si des suicidaires veulent bien esssayer, merci :D

je conseille également d'être admin de la machine pour la fonction de régalage des programmes de démarrage, j'ai pas encore fait de teste pour savaoir si ça va marcher si on est pas admin

autre chose, faire bien attention à la fonction qui permet de régler les prog de démarrage. je conseille de sauver (il y a un bouton pour ça) avant de bidouiller. (ça va créer un dossier "Démarrage système" dans lequel sera sauver le registre et les raccourci du "menu démarrer\programmes\démarrage\")

voilà
Je ne suis pas à moitié Polonais mais ma moitié est polonaise ... Vous avez suivi ?

[Intel quad core Q9400 2.66mhz, ATI 4870, 4Go Ram, XP (x86) / 7 (x64)]
fweil
Messages : 505
Inscription : dim. 16/mai/2004 17:50
Localisation : Bayonne (64)
Contact :

Message par fweil »

Marche parfaitement sur mon W2K ...

C'est un outil sympa.

Manque plus qu'à ajouter les messages en plusieurs langues !
Mon avatar reproduit l'image de 4x1.8m présentée au 'Salon international du meuble de Paris' en janvier 2004, dans l'exposition 'Shades' réunisant 22 créateurs autour de Matt Sindall. L'original est un stratifié en 150 dpi.
Le Soldat Inconnu
Messages : 4312
Inscription : mer. 28/janv./2004 20:58
Localisation : Clermont ferrand OU Olsztyn
Contact :

Message par Le Soldat Inconnu »

à la base, cet outil est intégré dans mon bi-exploreur (mais la version qui le contient n'est pas encore en libre service)

au fait, si vous avez de bonne idée pour le compléter :wink:
Je ne suis pas à moitié Polonais mais ma moitié est polonaise ... Vous avez suivi ?

[Intel quad core Q9400 2.66mhz, ATI 4870, 4Go Ram, XP (x86) / 7 (x64)]
hardy
Messages : 333
Inscription : mer. 02/juin/2004 13:19
Localisation : Tours

Message par hardy »

Il a oublié un des éléments de mon groupe de démarrage :mrgreen:
Sinon, ça marche (XP Pro)
Tiens, j'avais commencé à mettre un éditeur du groupe de démarrage dans mon prog. de gestion des processus, puis m'étais dit que ma foi il y a msconfig et l'avais enlevé.
Vais peut être en mettre un quand même.
Peux utiliser ton code? (j'ai pas gardé ce que j'avais fait! ça ira plus vite...)
Le Soldat Inconnu
Messages : 4312
Inscription : mer. 28/janv./2004 20:58
Localisation : Clermont ferrand OU Olsztyn
Contact :

Message par Le Soldat Inconnu »

ben, je l'ai posté pour ça :D
Je ne suis pas à moitié Polonais mais ma moitié est polonaise ... Vous avez suivi ?

[Intel quad core Q9400 2.66mhz, ATI 4870, 4Go Ram, XP (x86) / 7 (x64)]
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

oui mais avec msconfig ya un problem chiant chez moi
c'est que si tu desactive un prog du demarage t'a une fenetre tres embetant qui s'affiche au demarage de windows qui dit que tu utilise une version
modifie de dossier de demarage !!
pas tres genial leur truc a MicroMachin !! :)
(d'ailleurs si quelqu'un connais le truc pour eviter ça ?!!! ) :?
Oliv
Messages : 2117
Inscription : mer. 21/janv./2004 18:39

Message par Oliv »

(d'ailleurs si quelqu'un connais le truc pour eviter ça ?!!! )
Il n'y a pas une case à cocher quand il te dit le message pour plus que ça revienne ?

Sinon j'essai le prog sous 98SE demain
hardy
Messages : 333
Inscription : mer. 02/juin/2004 13:19
Localisation : Tours

Message par hardy »

Moi j'ai pas de telle fenêtre. Et pourtant je l'utilise souvent. (mystère...)
NY152
Messages : 148
Inscription : dim. 14/mai/2006 20:41

Re: utilitaires système

Message par NY152 »

J'aurais aimé voir ce que ce code donne mais il n'est plus du tout adapté à la version actuelle de PB. Je trouve que le langage change trop pour être productif, dommage ...
.:NY152:.
nico
Messages : 3702
Inscription : ven. 13/févr./2004 0:57

Re: utilitaires système

Message par nico »

Des personnes ici sont capable de le remettre en forme pour la version actuelle; il n'y a pas que PB qui change, il y a aussi l'OS; je remarque des changements sur les API depuis la version vista de window, notamment concernant la poubelle.
Marc56
Messages : 2148
Inscription : sam. 08/févr./2014 15:19

Re: utilitaires système

Message par Marc56 »

NY152 a écrit :J'aurais aimé voir ce que ce code donne mais il n'est plus du tout adapté à la version actuelle de PB. Je trouve que le langage change trop pour être productif, dommage ...
Tu réveille un code (système) vieux de presque 11 ans :arrow: Posté: Sam 19/Juin/2004 16:42 et qui utilise des fonctions système.
comme l'as dit nico l'OS a changé depuis, même si les API de base sont identiques :wink: donc les utilitaires système ont toutes les chances de ne plus fonctionner sur une aussi longue période.

Un certains nombre de langages de programmation ont même disparus en moins de temps que ça, ex: VB a duré officiellement 7 ans alors que la première version publique de PB est sortie en 2000: 15 ans! Heureusement que PB évolue sinon on ne pourrait plus rien faire à part Hello world! :P
Avatar de l’utilisateur
Ar-S
Messages : 9478
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: utilitaires système

Message par Ar-S »

@NY152
Salut,
Tu as pas mal de codes sur le forum qui fonctionnent pour pas mal des codes d'LSI ou qui te permettront de faire la même chose.
Pour les répertoires systèmes tu as des commandes natives, pour les infos du registre tu as plein de codes existants, idem pour la corbeille etc..
Farfouille un peu.
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
NY152
Messages : 148
Inscription : dim. 14/mai/2006 20:41

Re: utilitaires système

Message par NY152 »

Marc56 a écrit :
NY152 a écrit :J'aurais aimé voir ce que ce code donne mais il n'est plus du tout adapté à la version actuelle de PB. Je trouve que le langage change trop pour être productif, dommage ...
Tu réveille un code (système) vieux de presque 11 ans :arrow: Posté: Sam 19/Juin/2004 16:42 et qui utilise des fonctions système.
comme l'as dit nico l'OS a changé depuis, même si les API de base sont identiques :wink: donc les utilitaires système ont toutes les chances de ne plus fonctionner sur une aussi longue période.

Un certains nombre de langages de programmation ont même disparus en moins de temps que ça, ex: VB a duré officiellement 7 ans alors que la première version publique de PB est sortie en 2000: 15 ans! Heureusement que PB évolue sinon on ne pourrait plus rien faire à part Hello world! :P
Je sais que j'en ai demandé beaucoup lol

Pour Visual Basic ... 7 ans pas sur ^^ VB 1.0 est sorti en 1991 et VB6 en 1998, oui 7 ans de date de sortie à date de sortie mais le support officiel de VB6 a été stoppé en 2005, là on est plus à 7 ans mais le double ^^

Pour le code, je me suis tourné vers le "je le fais moi-même" du coup :-P

Je ne critique pas l'évolution de PB loin de là mais des fois des fonctions changent de sens les paramètres (je ne vois pas l'apport là dessus), d'autres disparaissent ... Donc des fois on est un peu dans les choux pour rien.
.:NY152:.
doudouvs
Messages : 244
Inscription : jeu. 07/mars/2013 19:02
Localisation : France Alsace / Espagne Girona

Re: utilitaires système

Message par doudouvs »

Heureusement que PB évolue, autrement Windows/MAC/LINUX n'évoluerai pas....

Imagine toi utiliser le premier excel d'un windows 3.0 de 1995 sur un windows8 hihih
GCC 7.4.0 / PureBasic 5.71 / Ubuntu 18.04.3 LTS
Répondre