Discussion :

[Roland Chastain]

Bonjour !

J'avais besoin d'un outil qui cherche et supprime les dossiers cachés "__history" de Delphi. On trouve des fichiers batch qui font cela en une ligne mais je voulais le faire en Pascal.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
rem http://stackoverflow.com/questions/521382/command-line-tool-to-delete-folder-with-a-specified-name-recursively-in-windows
for /d /r . %%d in (__history) do @if exist "%%d" rd /s /q "%%d"

Le programme est basé sur l'exemple DIRTOT d'Alcatîz : Programmation Win32.

Pour supprimer le dossier avec tout son contenu, j'ai trouvé une solution de facilité.

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
 
unit Commands;
 
interface
 
procedure DelTree(const root: string); 
 
implementation
 
uses Dos;
 
var
  p: pathStr;
 
procedure DelTree(const root: string);
var
  c: comStr;
begin
  c := '/C RD /S /Q "' + root + '"';
  Exec(p, c);
end;
 
begin
  p := GetEnv('COMSPEC');
end.

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
 
program del__history;
 
{ http://alcatiz.developpez.com/tutoriel/owl/ }
 
{$PMTYPE VIO}
 
uses
  Crt,
  Strings,
  SysUtils,
  Windows,
  Commands; { DelTree }
 
const
  Masque = '\*.*';
 
var
  BufferChemin: array[0..MAX_PATH]of Char;
 
procedure RECHERCHE_RECURSIVE(Dossier: pChar);
var
  hRecherche: tHandle;
  FindData: tWin32FindData;
  NomDossier: pChar;
  Chemin: pChar;
  ContinuerRecherche: LongBool;
begin
  TextColor(Blue);
  WriteLn(Dossier);
  WriteLn(BufferChemin);
  TextColor(LightGray);
  NomDossier := StrNew(Dossier);
  StrCopy(BufferChemin, Dossier);
  StrCat(BufferChemin, Masque);
  Chemin := StrNew(BufferChemin);
  hRecherche := FindFirstFile(Chemin, FindData);
  if hRecherche <> Invalid_Handle_Value then
  begin
    ContinuerRecherche := True;
    while ContinuerRecherche do
    begin
      if (FindData.dwFileAttributes and File_Attribute_Directory) <> 0 then
      begin
        if FindData.cFileName[0] <> '.' then
        begin
          StrCopy(BufferChemin, NomDossier);
          if BufferChemin[StrLen(BufferChemin) - 1] <> '\' then
            StrCat(BufferChemin, '\');
          StrCat(BufferChemin, FindData.cFileName);
          if StrComp(FindData.cFileName, '__history') = 0 then
          begin
            TextColor(Red);
            WriteLn(FindData.cFileName);
            TextColor(LightGray);
            DelTree(StrPas(BufferChemin));
          end else
          begin
            TextColor(Green);
            WriteLn(FindData.cFileName);
            TextColor(LightGray);
            RECHERCHE_RECURSIVE(BufferChemin);
          end;
        end;
      end;
      ContinuerRecherche := FindNextFile(hRecherche, FindData);
    end;
    FindClose(hRecherche);
  end;
  if NomDossier <> nil then
    StrDispose(NomDossier);
  if Chemin <> nil then
    StrDispose(Chemin);
end;
 
(* ========== Programme principal ========== *)
 
BEGIN
  ClrScr;
  StrPCopy(BufferChemin, ExtractFilePath(ParamStr(0)));
  RECHERCHE_RECURSIVE(BufferChemin);
  WriteLn('Appuyez sur Entr'#130'e...');
  ReadLn;
END.

Qu'en pensez-vous ?

[Alcatîz]

Bonjour,

(surtout avec de telles références )

Il ne reste plus qu'à faire le deltree également en Pascal.

[Roland Chastain]

Il ne reste plus qu'à faire le deltree également en Pascal.

Il faut supprimer d'abord les fichiers, ensuite les dossiers, n'est-ce pas ?

Voici une version du programme qui supprime tous les fichiers d'une arborescence de dossiers. C'est pour supprimer les dossiers que j'ai encore besoin d'un peu de réflexion.

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
 
program Essai2;
{&PMTYPE VIO}
 
{ Essai préparatoire pour une fonction DelTree.
 
  Supprime tous les fichiers d'un dossier donné, y compris le contenu des sous-dossiers. }
 
uses
  Strings, Windows;
 
const
  Masque = '\*.*';
  DossierTest = 'C:\Documents and Settings\Roland\Mes documents\RAD Studio\DelTree\GP2';
{ N.B. Tout le contenu du dossier sera supprimé ! }
 
var
  BufferChemin: array[0..MAX_PATH]of Char;
  Fichier: file;
 
procedure RECHERCHE_RECURSIVE(Dossier: pChar);
var
  hRecherche: tHandle;
  FindData: tWin32FindData;
  NomDossier, Chemin: pChar;
  ContinuerRecherche: LongBool;
begin
  //////////////////////////////////////////////////////////////////////////////
  NomDossier := StrNew(Dossier);
  StrCopy(BufferChemin, Dossier);
  StrCat(BufferChemin, Masque);
  Chemin := StrNew(BufferChemin);
  //////////////////////////////////////////////////////////////////////////////
  hRecherche := FindFirstFile(Chemin, FindData);
  //////////////////////////////////////////////////////////////////////////////
  if hRecherche <> Invalid_Handle_Value then
  begin
    ContinuerRecherche := True;
    while ContinuerRecherche do
    begin
      if (FindData.dwFileAttributes and File_Attribute_Directory) <> 0 then
      begin
        if FindData.cFileName[0] <> '.' then
        begin
          StrCopy(BufferChemin, NomDossier);
          if BufferChemin[StrLen(BufferChemin) - 1] <> '\' then
            StrCat(BufferChemin, '\');
          StrCat(BufferChemin, FindData.cFileName);
          RECHERCHE_RECURSIVE(BufferChemin);
        end;
      end else
      begin
        StrCopy(BufferChemin, NomDossier);
        if BufferChemin[StrLen(BufferChemin) - 1] <> '\' then
          StrCat(BufferChemin, '\');
        StrCat(BufferChemin, FindData.cFileName);
        ////////////////////////////////////////////////////////////////////////
        Assign(Fichier, BufferChemin);
        Erase(Fichier);
        ////////////////////////////////////////////////////////////////////////
      end;
      ContinuerRecherche := FindNextFile(hRecherche, FindData);
    end;
    FindClose(hRecherche);
  end;
  //////////////////////////////////////////////////////////////////////////////
  if NomDossier <> nil then StrDispose(NomDossier);
  if Chemin <> nil then StrDispose(Chemin);
  //////////////////////////////////////////////////////////////////////////////
end;
 
BEGIN
  //////////////////////////////////////////////////////////////////////////////
  StrCopy(BufferChemin, DossierTest);
  //////////////////////////////////////////////////////////////////////////////
  RECHERCHE_RECURSIVE(BufferChemin);
  //////////////////////////////////////////////////////////////////////////////
  Write('Appuyez sur la touche Entr'#130'e...'); ReadLn;
  //////////////////////////////////////////////////////////////////////////////
END.

[Roland Chastain]

C'est pour supprimer les dossiers que j'ai encore besoin d'un peu de réflexion.

J'ai finalement réussi à faire un programme qui efface les sous-dossiers, mais en m'aidant d'une liste de chaînes.

Après cela j'ai repris le problème depuis le début. Pour commencer, au lieu de prendre un dossier au hasard sur mon disque pour essayer de le vider, je me suis dit : "Tiens, je vais faire un petit programme qui générera ce dossier." Eh bien il m'a fallu une bonne heure pour y arriver. Si vous avez mieux comme code, j'achète (enfin, façon de parler ).

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
program GenereDossier;
 
{&PMTYPE VIO}
{$IFNDEF VIRTUALPASCAL}
{$APPTYPE CONSOLE}
{$ENDIF}
 
{ Génère une arborescence de dossiers vides. }
 
function ExtractFilePath(const fullFileName: string): string;
var
  i: integer;
begin
  i := Length(fullFileName);
  while (fullFileName[i] <> '\') and (i > 1) do
    Dec(i);
  if fullFileName[i] <> '\' then
    Result := 'C:\'
  else
    Result := Copy(fullFileName, 1, i);  
end;
 
function MakeDir(dirName: string): boolean;
begin
  {$I-}
  MkDir(dirName);
  {$I+}
  Result := IOResult = 0;
end;
 
function C(n: integer): char;
begin
  Result := Chr(Ord('0') + n);
end;
 
const
  nom = 'dossier';
 
var
  cheminExe: string;
  i, j, k: integer;
  b: boolean;
 
begin
  cheminExe := ExtractFilePath(ParamStr(0));
 
  b := MakeDir(cheminExe+nom);
  for i := 1 to 4 do
  begin
    b := b and MakeDir(cheminExe+nom+'\'+C(i));
    for j := 1 to 4 do
    begin
      b := b and MakeDir(cheminExe+nom+'\'+C(i)+'\'+C(j));
      for k := 1 to 4 do
      begin
        b := b and MakeDir(cheminExe+nom+'\'+C(i)+'\'+C(j)+'\'+C(k));
      end;
    end;
  end;
 
  WriteLn(b);
  WriteLn('Appuyez sur la touche ENTREE...');
  ReadLn;
end.

[Roland Chastain]

Voici le programme qui efface les dossiers, au moyen d'une liste de chaînes contenant tous les chemins. Je n'ai pas mieux pour le moment.

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
90
91
92
93
94
95
96
97
98
99
100
 
program Essai4;
 
{&PMTYPE VIO}
{$IFNDEF VIRTUALPASCAL}
{$APPTYPE CONSOLE}
{$ENDIF}
 
uses
  SysUtils, Windows, Classes;
 
const
  entree = 'Appuyez sur la touche ENTREE...';
  masque = '\*.*';
 
var
  bufferChemin: array[0..MAX_PATH]of Char;
  liste: tStringList;
 
procedure RECHERCHE_RECURSIVE(dossier: pChar);
var
  hRecherche: tHandle;
  findData: tWin32FindData;
  nomDossier, chemin: pChar;
  continuer: LongBool;
begin
  //////////////////////////////////////////////////////////////////////////////
  nomDossier := StrNew(dossier);
  //////////////////////////////////////////////////////////////////////////////
  StrCopy(bufferChemin, dossier); StrCat(bufferChemin, masque);
  //////////////////////////////////////////////////////////////////////////////
  chemin := StrNew(bufferChemin);
  //////////////////////////////////////////////////////////////////////////////
  hRecherche := FindFirstFile(chemin, findData);
  //////////////////////////////////////////////////////////////////////////////
  if hRecherche = Invalid_Handle_Value then WriteLn('chemin introuvable !') else
  begin
    ////////////////////////////////////////////////////////////////////////////
    continuer := True;
    ////////////////////////////////////////////////////////////////////////////
    while continuer do
    begin
      //////////////////////////////////////////////////////////////////////////
      if (findData.dwFileAttributes and File_Attribute_Directory) <> 0 then
      begin
        ////////////////////////////////////////////////////////////////////////
        if findData.cFileName[0] <> '.' then
        begin
          //////////////////////////////////////////////////////////////////////
          StrCopy(bufferChemin, nomDossier);
          //////////////////////////////////////////////////////////////////////
          if bufferChemin[StrLen(bufferChemin) - 1] <> '\' then
            StrCat(bufferChemin, '\');
          //////////////////////////////////////////////////////////////////////
          StrCat(bufferChemin, findData.cFileName);
          //////////////////////////////////////////////////////////////////////
          RECHERCHE_RECURSIVE(bufferChemin);
          //////////////////////////////////////////////////////////////////////
        end;
        ////////////////////////////////////////////////////////////////////////
      end;
      //////////////////////////////////////////////////////////////////////////
      continuer := FindNextFile(hRecherche, findData);
      //////////////////////////////////////////////////////////////////////////
      if not continuer then liste.Add(StrPas(nomDossier));
      //////////////////////////////////////////////////////////////////////////
    end;
    ////////////////////////////////////////////////////////////////////////////
    FindClose(hRecherche);
    ////////////////////////////////////////////////////////////////////////////
  end;
  //////////////////////////////////////////////////////////////////////////////
  if nomDossier <> nil then StrDispose(nomDossier);
  if chemin <> nil then StrDispose(chemin);
  //////////////////////////////////////////////////////////////////////////////
end;
 
const
  cible = 'dossier';
 
var
  racine: string;
  i: integer;
 
BEGIN
  racine := ExtractFilePath(ParamStr(0)) + cible;
  //////////////////////////////////////////////////////////////////////////////
  StrPCopy(bufferChemin, racine);
  //////////////////////////////////////////////////////////////////////////////
  liste := tStringList.Create;
  //////////////////////////////////////////////////////////////////////////////
  RECHERCHE_RECURSIVE(bufferChemin);
  //////////////////////////////////////////////////////////////////////////////
  for i := 0 to liste.Count-1 do RmDir(liste.Strings[i]);
  //////////////////////////////////////////////////////////////////////////////
  liste.SaveToFile('liste.txt'); liste.Free;
  //////////////////////////////////////////////////////////////////////////////
  Write(entree); ReadLn;
  //////////////////////////////////////////////////////////////////////////////
END.

Si au lieu de remplir la liste, j'essaie de supprimer sur le champ les dossiers, ça ne marche pas. Pourtant il semble que la liste soit dans le bon ordre.

[tsandras]

RmDir (Chemin) or RmDir (App.Path & "\" & NfactureAirtel)

[Roland Chastain]

Je ne sais pas si c'est le cas en Visual Basic, mais en Pascal la procédure RmDir ne supprime que les dossiers vides.

Enfin, j'ai trouvé la solution... dans la FAQ : l'exemple proposé est parfait. Il est basé sur l'unité Dos.

[Roland Chastain]

Voici ma procédure DelTree, inspirée de l'exemple de la FAQ mais basée sur l'unité Windows.

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
 
unit UDelTree;
 
interface
 
procedure DelTree(root: pChar);
 
implementation
 
uses
  Strings, Windows;
 
function DelFile(const name: pChar): boolean;
var
  f: file;
begin
  Assign(f, name);
  {$I-}
  Erase(f);
  {$I+}
  Result := IOResult = 0;
end;
 
const
  masque = '\*.*';
 
var
  buffer: array[0..MAX_PATH]of Char;
 
procedure DelTree(root: pChar);
var
  hRecherche: tHandle;
  findData: tWin32FindData;
  dossier, chemin: pChar;
  continuer: LongBool;
begin
  dossier := StrNew(root);
  StrCopy(buffer, root);
  StrCat(buffer, masque);
  chemin := StrNew(buffer);
 
  hRecherche := FindFirstFile(chemin, findData);
  if hRecherche <> Invalid_Handle_Value then
  begin
    continuer := true;
    while continuer do
    begin
      StrCopy(buffer, dossier);
      if buffer[StrLen(buffer) - 1] <> '\' then StrCat(buffer, '\');
      StrCat(buffer, findData.cFileName);
 
      if (findData.dwFileAttributes and File_Attribute_Directory) <> 0 then
      begin
        if findData.cFileName[0] <> '.' then
          DelTree(buffer);
      end else
        DelFile(buffer);
 
      continuer := FindNextFile(hRecherche, findData);
    end;
    FindClose(hRecherche);
    RmDir(dossier);
  end;
 
  if dossier <> nil then
    StrDispose(dossier);
  if chemin <> nil then
    StrDispose(chemin);
end;
 
end.

Le programme del_history emploie donc une procédure récursive (pour supprimer les dossiers) à l'intérieur d'une autre procédure récursive (pour chercher les dossiers _history). Je doutais un peu du résultat, mais apparemment ça marche.

[Roland Chastain]

Un dernier exemple, "pour la route". C'est un programme qui nettoie un répertoire, c'est-à-dire supprime tous les fichiers à l'exception de ceux qui ont telle ou telle extension.

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
90
91
 
program Nettoyeur;
 
{&PMTYPE VIO}
{$IFNDEF VIRTUALPASCAL}
{$APPTYPE CONSOLE}
{$IFDEF FPC}{$MODE DELPHI}{$ENDIF}
{$ENDIF}
 
{ Nettoie les répertoires suivants :
 
  C:\Vp21\Out.w32
  C:\Vp21\Out.w32\Units
  
  Tous les fichiers sont supprimés, sauf *.lib et *.vpi. }
 
uses
  SysUtils, Windows;
 
function SupprimeFichier(Chemin: pChar): boolean;
var
  f: file;
begin
  Assign(f, Chemin);
  {$I-}
  Erase(f);
  {$I+}
  Result := IOResult = 0;
end;
 
const
  Masque = '\*.*';
 
var
  BufferChemin: array[0..MAX_PATH]of Char;
 
procedure RECHERCHE(Dossier: pChar);
var
  hRecherche: tHandle;
  FindData: tWin32FindData;
  NomDossier, Chemin: pChar;
  ContinuerRecherche: LongBool;
  Ext: string;
begin
  //////////////////////////////////////////////////////////////////////////////
  NomDossier := StrNew(Dossier);
  StrCopy(BufferChemin, Dossier);
  StrCat(BufferChemin, Masque);
  Chemin := StrNew(BufferChemin);
  //////////////////////////////////////////////////////////////////////////////
  hRecherche := FindFirstFile(Chemin, FindData);
  //////////////////////////////////////////////////////////////////////////////
  if hRecherche <> Invalid_Handle_Value then
  begin
    ContinuerRecherche := True;
    while ContinuerRecherche do
    begin
      if (FindData.dwFileAttributes and File_Attribute_Directory) = 0 then
      begin
        StrCopy(BufferChemin, NomDossier);
        if BufferChemin[StrLen(BufferChemin) - 1] <> '\' then
          StrCat(BufferChemin, '\');
        StrCat(BufferChemin, FindData.cFileName);
        ////////////////////////////////////////////////////////////////////////
        Ext := ExtractFileExt(StrPas(BufferChemin));
        if (UpperCase(Ext) = '.LIB')
        or (UpperCase(Ext) = '.VPI') then
          Sleep(10)
        else
          if SupprimeFichier(BufferChemin) then
            WriteLn('Fichier supprim'#130' ', BufferChemin);
        ////////////////////////////////////////////////////////////////////////
      end;
      ContinuerRecherche := FindNextFile(hRecherche, FindData);
    end;
    FindClose(hRecherche);
  end;
  //////////////////////////////////////////////////////////////////////////////
  if NomDossier <> nil then StrDispose(NomDossier);
  if Chemin <> nil then StrDispose(Chemin);
  //////////////////////////////////////////////////////////////////////////////
end;
 
BEGIN
  //////////////////////////////////////////////////////////////////////////////
  RECHERCHE('C:\Vp21\Out.w32');
  RECHERCHE('C:\Vp21\Out.w32\Units');
  //////////////////////////////////////////////////////////////////////////////
  Write('Appuyez sur la touche Entr'#130'e...'); ReadLn;
  //////////////////////////////////////////////////////////////////////////////
END.

[Roland Chastain]

Bonjour ! J'ai retravaillé mon programme, dont le but était de rechercher et de supprimer les dossiers __history que Delphi XE2 crée automatiquement dans le répertoire de chaque projet. Désormais le programme doit être appelé par une ligne de commande, contenant le répertoire où commence la recherche et le nom des dossiers à supprimer.

Ainsi le programme peut servir, par exemple, à rechercher et à supprimer les dossiers backup et lib créés par Lazarus.

Code batch :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
rem Exemple d'utilisation du programme DeleteDirectories.
rem Supprime les dossiers backup et lib créés par Lazarus.
 
call C:\Outils\MesOutils\DeleteDirectories "C:\Atelier\Pascal\Lazarus" "backup"
call C:\Outils\MesOutils\DeleteDirectories "C:\Atelier\Pascal\Lazarus" "lib"

Le programme a été testé sous Windows 8. Au cas où quelqu'un voudrait l'essayer, mais serait un peu hésitant vu le caractère potentiellement périlleux de l'opération, j'ai inclus une version qui recherche les dossiers sans les supprimer (DeleteDirectories_NoDelete).

Le code peut probablement être compilé avec Free Pascal, mais je n'ai pas essayé.