Nov
29
|
Durant le CodeWay 4, Thierry nous a présenté plein de sessions dont une sur les nouvelles unités de Delphi.
Parmi ces unités, on trouve entre autres :
Dans l’après-midi, un client m’appelle et je lui demande de supprimer un répertoire… il se retrouve bloqué par Windows qui refuse de supprimer les chemins d’une trop grande taille (> 260 caractères… Windows 7 est un peu plus malin, mais sous XP, c’est assez bloquant…)
(idea) Voila comment m’est venu l’idée de développer cette mini application qui m’a permis de mettre en œuvre deux des nouvelles unités :
- RegularExpressions qui me permet de facilement découper un chemin (SplitString, non, j’connais pas
)
- IOUtils qui me donne les répertoires et fichiers
L’application compilée peut être récupérée à partir de ce lien.
Une partie du code source mettant en œuvre ces unités :
Une expression régulière pour découper les répertoires :
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 | procedure TfrmMain.ExpandPath(sPath: string; bFocus: Boolean); var rePath : TRegEx; mPart : TMatch; tnCurrent: TTreeNode; begin if bFocus then tvPath.SetFocus; // Ajout du backslash final sPath := StringReplace(sPath + '\', '\', '\', [rfReplaceAll]); // On segmente le chemin par répertoire rePath := TRegEx.Create('([^\\]+\\)'); mPart := rePath.Match(sPath); tnCurrent := tvPath.Items.GetFirstNode; while ((mPart.Success) and (tnCurrent <> nil)) do begin case tnCurrent.ImageIndex of 1: // Lecteur begin if (LowerCase(mPart.Groups[1].Value) = LowerCase(tnCurrent.Text)) then begin tnCurrent.Expand(False); if bFocus then tnCurrent.Selected := True; tnCurrent.MakeVisible; tnCurrent := tnCurrent.getFirstChild; mPart := mPart.NextMatch; end else begin tnCurrent := tnCurrent.getNextSibling; end; end; 2: // Répertoire begin if ((LowerCase(mPart.Groups[1].Value) = LowerCase(tnCurrent.Text) + '\') or (LowerCase(mPart.Groups[1].Value) = LowerCase(GetFileName(TShortPath(tnCurrent.Data).ShortPath)) + '\')) then begin tnCurrent.Expand(False); if bFocus then tnCurrent.Selected := True; tnCurrent.MakeVisible; tnCurrent := tnCurrent.getFirstChild; mPart := mPart.NextMatch; end else begin tnCurrent := tnCurrent.getNextSibling; end; end; else begin tnCurrent := tnCurrent.getNextSibling; end; end; end; end; |
Une autre pour récupérer le nom de fichier :
1 2 3 4 5 6 7 8 9 10 11 12 13 | function TfrmMain.GetFileName(sPath: string): string; var reFilename : TRegEx; mFilename : TMatch; begin Result := ''; reFilename := TRegEx.Create('.*\\(.*)$'); mFilename := reFilename.Match(sPath); if mFilename.Success then begin Result := mFilename.Groups[1].Value; end; end; |
et l’utilisation d’un TDirectory pour obtenir les répertoires, puis les fichiers :
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 | procedure TfrmMain.PopulateChildren(var tnItem: TTreeNode); var sdaDirectories: TStringDynArray; sdaFiles : TStringDynArray; sDirectory : string; sFile : string; sCurrentPath : string; tvContainer : TTreeView; tnPrevious : TTreeNode; opCurrent : TShortPath; begin sCurrentPath := GetShortPath(tnItem); tvContainer := TTreeView(tnItem.Owner.Owner); // On supprime les valeurs précédentes tnItem.DeleteChildren; // Récupère les répertoires en racine try sdaDirectories := TDirectory.GetDirectories(sCurrentPath); except on E: Exception do begin // Chemin détruit depuis ou lien symbolique // on le détruit tnPrevious := tnItem.getPrevSibling; tnItem.Delete; tnItem := tnPrevious; Exit; end; end; for sDirectory in sdaDirectories do begin with tvContainer.Items.AddChild(tnItem, GetFileName(sDirectory)) do begin ImageIndex := 2; SelectedIndex := 3; opCurrent := TShortPath.Create(ExtractShortPathName(sDirectory)); Data := opCurrent; end; end; // Récupère les fichiers en racine sdaFiles := TDirectory.GetFiles(sCurrentPath); for sFile in sdaFiles do begin with tvContainer.Items.AddChild(tnItem, GetFileName(sFile)) do begin ImageIndex := 4; SelectedIndex := 5; opCurrent := TShortPath.Create(ExtractShortPathName(sDirectory)); Data := opCurrent; end; end; end; |
La suppression définitive, les répertoires et fichiers ne vont pas dans la corbeille… Vérifiez bien lors chemin lors du message de confirmation !
J’ai testé sur mon C:\ avec un peu trop d’efficacité

Derniers commentaires