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. |
Partager