Changer l'extension de fichiers (un seul, par lot, etc...)

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 :

Changer l'extension de fichiers (un seul, par lot, etc...)

Message par Le Soldat Inconnu »

Salut,

encore un outils de mon Bi-Exploreur pour les mêmes raison que le message suivant :
http://purebasic.hmt-forum.com/viewtopic.php?t=820

donc ce code permet de changer des extensions de fichiers.
faire clic droit sur un fichier pour accéder aux options.

Code : Tout sélectionner

Enumeration
  #Dossier1
  #Dossier2
  #Quitter
  #Liste
  #Affiche
  #Ext
  #Selectionne
  #SelectionneIdem
  #SelectionInverse
  
  #ImgBouton11
  #ImgBouton12
  #ImgBouton21
  #ImgBouton22
  #ImgBouton31
  #ImgBouton32
EndEnumeration

Global Dossier.s

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

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.SHFILEINFO, SizeOf(SHFILEINFO), #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)
  ; 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.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_ICON | #SHGFI_SMALLICON)
  If Pos = -1
    Pos = CountGadgetItems(GadgetID) + 1
  EndIf
  
  Structure LVITEM
    mask.l
    iItem.l
    iSubitem.l
    state.l
    stateMask.l
    pszText.l
    cchTextMax.l
    iImage.l
    lParam.l
    iIndent.l
    iGroupId.l
    cColumns.l
    puColumns.l
  EndStructure
  
  var.LVITEM
  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

Procedure Charge(Folder.s)
  
  If Right(Folder, 1) <> "\"
    Folder = Folder + "\"
  EndIf
  
  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
      If GetExtensionPart(Fichier(n))
        Nom.s = Left(Fichier(n), Len(Fichier(n)) - 1 - Len(GetExtensionPart(Fichier(n))))
      Else
        Nom = Fichier(n)
      EndIf
      AddGadgetItemXP(#Liste, PosD + n, Nom, Folder + Fichier(n))
      SetGadgetItemText(#Liste, PosD + n, GetExtensionPart(Fichier(n)), 1)
      UpdateWindow_(WindowID())
      Repeat ; pour quitter en cours d'analyse
        Event = WindowEvent()
        If Event = #WM_CLOSE
          End
        EndIf
      Until Event = 0
    Next
    
    Dossier = Folder
  Else
    HideWindow(0, 1)
    MessageRequester("Erreur", "Impossible d'analyser le dossier suivant :" + Chr(10) + Folder, 0)
    HideWindow(0, 0)
  EndIf
EndProcedure

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 Extension(Pos.l, Ext.s)
  If Ext
    Fichier.s = GetGadgetItemText(#Liste, Pos, 0) + "." + Ext
  Else
    Fichier.s = GetGadgetItemText(#Liste, Pos, 0)
  EndIf
  If LCase(Ext) <> LCase(GetGadgetItemText(#Liste, Pos, 1)) And IsFilename(Fichier)
    If FileSize(Dossier + Fichier) = -1
      RenameFile(Dossier + GetGadgetItemText(#Liste, Pos, 0) + "." + GetGadgetItemText(#Liste, Pos, 1), Dossier + Fichier)
      RemoveGadgetItem(#Liste, Pos)
      If GetExtensionPart(Fichier(n))
        Nom.s = Left(Fichier, Len(Fichier) - 1 - Len(GetExtensionPart(Fichier)))
      Else
        Nom = Fichier
      EndIf
      AddGadgetItemXP(#Liste, Pos, Nom, Dossier + Fichier)
      SetGadgetItemText(#Liste, Pos, Ext, 1)
    Else
      HideWindow(0, 1)
      If MessageRequester("Remplacement de fichier", "Le fichier '" + Fichier + "' exsite déjà." + Chr(10) + "Ecraser le fichier ?", 4 + 2 * 16) = 6
        MoveFileToRecycleBin(Dossier + Fichier)
        RenameFile(Dossier + GetGadgetItemText(#Liste, Pos, 0) + "." + GetGadgetItemText(#Liste, Pos, 1), Dossier + Fichier)
        ClearGadgetItemList(#Liste)
        Charge(Dossier)
      EndIf
      HideWindow(0, 0)
    EndIf
  EndIf
EndProcedure

Procedure.s GetSpecialFolderLocation(lngCSIDL.l)
  Protected lngRet.l, strLocation.s, 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






;- Debut du programme

#TailleX = 300
#TailleY = 280

; Création de la fenêtre et dela GadgetList
If OpenWindow(0, 0, 0, #TailleX - 1, #TailleY - 1, #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_Invisible, " Extension") = 0 Or CreateGadgetList(WindowID()) = 0
  End
EndIf

SetWindowLong_(WindowID(), #GWL_EXSTYLE, GetWindowLong_(WindowID(), #GWL_EXSTYLE) | #WS_EX_TOOLWINDOW) ; choix de la barre d'outil réduite
ResizeWindow(#TailleX, #TailleY) ; redimensionne la fenetre
ResizeWindow(#TailleX, 2 * #TailleY - WindowHeight())
ShowWindow_(WindowID(), #SW_SHOW) ; montre la fenêtre
SetWindowPos_(WindowID(), -1, 0, 0, 0, 0, #SWP_NOSIZE | #SWP_NOMOVE) ; mets la fenêtre toujours au premier plan

Dossier = "c:\"
ExplorerComboGadget(#Affiche, 1, 1, #TailleX, 200, Dossier)


; Hauteur du comboboxgadget
GetWindowRect_(GadgetID(#Affiche), Combo.RECT)
Hauteur = Combo\Bottom - Combo\Top

ListIconGadgetXP(#Liste, 1, Hauteur, #TailleX, #TailleY - 1 - Hauteur, "Fichier", #TailleX / 2 + 25, #PB_ListIcon_FullRowSelect | #PB_ListIcon_AlwaysShowSelection | #PB_ListIcon_MultiSelect)
AddGadgetColumn(#Liste, 1, "Extension", #TailleX / 2 - 75)

Charge(Dossier)

If CreatePopupMenu(0)
  MenuItem(#Ext, "Changer l'extension des fichiers sélectionnés")
  MenuBar()
  MenuItem(#Selectionne, "Tout sélectionner")
  MenuItem(#SelectionneIdem, "Sélectionner tous les fichiers ayant la même extension")
  MenuBar()
  MenuItem(#SelectionInverse, "Inverser la sélection")
Else
  HideWindow(0, 1)
  MessageRequester("Erreur", "Impossible de créer le popupmenu", 0)
  End
EndIf


Repeat
  Event = WaitWindowEvent()
  
  If Event = #PB_EventMenu
    Select EventGadgetID()
      Case #Ext
        Pos = GetGadgetState(#Liste)
        Ext.s = InputRequester("Nouvelle extension", "Entrez la nouvelle extension de la sélection :", GetGadgetItemText(#Liste, Pos, 1))
        For n = 0 To CountGadgetItems(#Liste) - 1
          If GetGadgetItemState(#Liste, n) = #PB_ListIcon_Selected ; on regarde si l'élément est sélectionné
            If GetGadgetItemText(#Liste, n, 1) ; on note le nom du fichier sélectionné
              Fichier.s = GetGadgetItemText(#Liste, n, 0) + "." + GetGadgetItemText(#Liste, n, 1)
            Else
              Fichier.s = GetGadgetItemText(#Liste, n, 0)
            EndIf
            If FileSize(Dossier + Fichier) >= 0 ; on teste si c'est un fichier ou un dossier
              Extension(n, Ext)
            EndIf
          EndIf
        Next
        
      Case #Selectionne
        For n = 0 To CountGadgetItems(#Liste) - 1
          SetGadgetItemState(#Liste, n, #PB_ListIcon_Selected)
        Next
        
      Case #SelectionneIdem
        Pos = GetGadgetState(#Liste)
        Ext.s = LCase(GetGadgetItemText(#Liste, Pos, 1))
        For n = 0 To CountGadgetItems(#Liste) - 1
          If Ext = LCase(GetGadgetItemText(#Liste, n, 1))
            SetGadgetItemState(#Liste, n, #PB_ListIcon_Selected)
          EndIf
        Next
        
      Case #SelectionInverse
        For n = 0 To CountGadgetItems(#Liste) - 1
          SetGadgetItemState(#Liste, n, #PB_ListIcon_Selected - GetGadgetItemState(#Liste, n))
        Next
        
    EndSelect
  EndIf
  
  If Event = #PB_EventGadget
    Select EventGadgetID() ; boutons, zone de texte, ...
      Case #Affiche
        ClearGadgetItemList(#Liste)
        Charge(GetGadgetText(#Affiche))
        
      Case #Liste
        Pos = GetGadgetState(#Liste)
        If Pos <> - 1
          Select EventType()
            Case #PB_EventType_LeftDoubleClick
              If GetGadgetItemText(#Liste, Pos, 1) ; on note le nom du fichier sélectionné
                Fichier.s = GetGadgetItemText(#Liste, Pos, 0) + "." + GetGadgetItemText(#Liste, Pos, 1)
              Else
                Fichier.s = GetGadgetItemText(#Liste, Pos, 0)
              EndIf
              If FileSize(Dossier + Fichier) >= 0 ; on teste si c'est un fichier ou un dossier
                Ext.s = InputRequester("Nouvelle extension", "Entrez la nouvelle extension du fichier :", GetGadgetItemText(#Liste, Pos, 1))
                Extension(Pos, Ext)
              ElseIf FileSize(Dossier + Fichier) = -2
                ClearGadgetItemList(#Liste)
                Charge(Dossier + Fichier)
                SetGadgetText(#Affiche, Dossier)
              EndIf
              
            Case #PB_EventType_RightClick
              DisplayPopupMenu(0, WindowID())
              
          EndSelect
        EndIf
    EndSelect
  EndIf
  
Until Event = #PB_EventCloseWindow

End
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)]