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 :p )
  • 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;

Attention !!! 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é (tmi)

Développé en Delphi

Share

Lien permanent vers Supprimer des répertoires Rédigé par Whiler \\ Tags : , , , ,

Laisser une réponse

(requis)

(requis)

*

;) (lol) (y) |-( (hi) 8-) (angel) :s (clap) (bow) (tmi) (:| plus »

This site uses Akismet to reduce spam. Learn how your comment data is processed.