// balaye un reprtoires ou un disque, recherche les fichiers correspondant aux critèresCa va aller ?
// et change les attributs des fichiers
// ex d'appel: ChangeFilesAttr ( 'c:\', '*.xyz', NewAttr, true);
procedure ChangeFilesAttr (root, critere : string; SubDir : boolean; Attr:integer );
var Rec : TSearchRec;
FullName : string;
begin
if root[ length(root) ]<>'\'
then root:=root + '\';
if (FindFirst (root+critere , faAnyFile, Rec)=0) then
repeat
fullname := root + rec.Name;
if (rec.name[1] <> '.') then // éviter les fichiers '.' (RootPath)
begin
// c'est un folder, si SubDir on le balaye aussi
if (rec.Attr = faDirectory) and SubDir then
ChangeFilesAttr (FullName +'\', critere, SubDir, Attr);
// et là on change l'attribut du fichier/folder ... mais moi je ne le fais pas
// FileSetAttr(FullName, Attr);
end;
until FindNext(Rec) <> 0;
end;
// balaye un reprtoires/disque, recherche les fichiers correspondant aux critères
// et change les attributs des fichiers
// ex d'appel: ChangeFilesAttr ( 'c:\', '*.xyz', NewAttr, true);
// retourne le nb de fichiers modifiés
function ChangeFilesAttr (root, critere: string; SubDir: boolean; Attr: integer ): integer;
var Rec : TSearchRec;
FullName : string;
begin
result := 0;
root := trim(root); // au cas ou
if root[ length(root) ]<>'\'
then root := root + '\'; // le dernier char doit etre un backslash
// on balaye les FICHIERS fichiers de root
if (FindFirst (root+critere , faAnyFile - faDirectory, Rec)=0)
then repeat
fullname := root + rec.Name;
if (rec.name[1] <> '.') // éviter les fichiers '.' ou '..' (RootPath)
then begin
// je mettrais un try si fichier occupé, ou pas les droits, ...
try
// FileSetAttr(FullName, Attr); // On change l'attribut
inc( result );
except
end;
end;
until FindNext(Rec) <> 0;
// si subdir, on balaye SOUS-FOLDERS de root
if SubDir and (FindFirst (root + '*.*', faDirectory, Rec)=0) then
repeat
fullname := root + rec.Name;
if (rec.name[1] <> '.') then // éviter les fichiers '.' ou '..' (RootPath)
result := result + ChangeFilesAttr (FullName+'\', critere, SubDir, Attr);
until FindNext(Rec) <> 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
var t:tdatetime;
nbr: integer;
begin
screen.cursor:=crHourglass;
t:=now;
application.processmessages;
nbr := ChangeFilesAttr (edit1.text, edit2.text, true, 0 );
t:=now-t;
memo1.lines.add ( edit1.text+edit2.text+' ' +
inttostr( nbr) + ' fichiers répondant aux critères en ' +
formatdatetime('hh:nn:ss zzz' , t) +#13#10);
screen.cursor:=crDefault;
end;
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question