Bonjour !

Je vous propose un programme utilisant une procédure récursive pour supprimer tout le contenu d'un répertoire donné.

Ce programme est la traduction en Pascal d'un code trouvé sur le forum anglais FreeBASIC.

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
 
(* -------------------------------------------------------------------------- *) 
(* Procedure supprimant tout le contenu du répertoire courant.                *)
(* Adaptation d'un programme FreeBASIC :                                      *)
(* http://www.freebasic.net/forum/viewtopic.php?p=193892#p193892              *)
(* Compilation : Free Pascal 2.6.2, Virtual Pascal 2.1.                       *)
(* Testé sous Windows 8.                                                      *)
(* -------------------------------------------------------------------------- *)
(* Procedure deleting all the content of the current directory.               *)
(* Adaptation of a FreeBASIC program :                                        *)
(* http://www.freebasic.net/forum/viewtopic.php?p=193892#p193892              *)
(* Compilation : Free Pascal 2.6.2, Virtual Pascal 2.1.                       *)
(* Tested under Windows 8.                                                    *)
(* -------------------------------------------------------------------------- *)
 
program TestDeleteAll;
 
{$IFDEF VPASCAL}
  {&PMTYPE VIO}
  {&USE32+}
  {$H+}
{$ELSE}
  {$APPTYPE CONSOLE}
  {$MODE DELPHI}
  {$H+}
{$ENDIF}
 
uses
  SysUtils;
 
const
  NL = #10;
 
function InStr(const start: integer; const string1, string2: string): integer;
var
  s: string;
begin
  s := Copy(string1, start, Length(string1) - start + 1);
  result := Pos(string2, s) + start - 1;
end;
 
procedure DeleteAll;
var
  n, t: string;
  a, e, l: integer;
  r: tSearchRec;
begin
  t := '';
 
  if FindFirst('*', faAnyFile and faDirectory, r) = 0 then
  begin
    while Length(r.name) > 0 do
    begin
      if (r.name <> '.') and (r.name <> '..') then
        t := t + r.name + NL;
      if FindNext(r) <> 0 then
        r.name := '';
    end;
  end;
  FindClose(r);
 
  a := 1;
  e := a;
  l := Length(t);
 
  while a < l do
  begin
    e := InStr(a, t, NL);  
    n := Copy(t, a, e - a);
    if SetCurrentDir(n) then
    begin
      DeleteAll;
      SetCurrentDir('..');    
      RemoveDir(n);
    end;
    a := e + 1;
  end;
 
  if FindFirst('*', faAnyFile and not faDirectory, r) = 0 then
    while Length(r.name) > 0 do
    begin
      DeleteFile(r.name);
      if FindNext(r) <> 0 then
        r.name := '';
    end;
  FindClose(r);
end;
 
begin
  if SetCurrentDir('X:\') then
    DeleteAll;
end.