Equivalent de la commande DOS deltree
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:
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. |
