|
|
|
| | | | | | | | |  |
| 
| Code source : unité LRJ_WinDirectories | |
| |
| | |
|
Description : cette unité contient les objets suivants :
- LRJ_TListFile contient la liste des LRJ_TWinFile contenus
dans un répertoire.
- LRJ_TListDirectory contient la liste des LRJ_TWinDirectory contenus dans un répertoire.
- LRJ_TWinDirectory hérite d'un ascendant de
LRJ_TWinFile
et extrait des informations sur le répertoire : attributs, date et heure de création,
de dernière modification et de dernier accès. LRJ_TWinDirectory permet la création, la destruction directe ou en passant par la corbeille,
le changement de nom ou d'attributs, le déplacement, la copie d'un répertoire. LRJ_TWinDirectory permet
la recherche à partir du répertoire et dans l'ensemble des sous répertoires de fichiers ou
de répertoires en fonction d'un masque de recherche (s'inspirant de la recherche classique de fichiers
ou répertoire sous Windows). Les listes de répertoires et fichiers sont discriminés selon les
attributs désignés (ou aucun si l'on souhaite). LRJ_TWinDirectory permet le calcul de la taille
réelle et sur le disque du répertoire désigné et de l'ensemble de son contenu. LRJ_TWinDirectory
permet de réaliser certaines des tâches en tâche de fond dans un thread spécifique
développé dans cette unité : copie, déplacement, calcul des tailles
réelles et disque du contenu, destruction et recherche de fichiers et répertoires. Cet objet utilise
les noms de fichier longs (jusqu'à 32767 caractères) au cas où.
L'unité est livrée avec une application de démonstration (
voir description plus loin
) qui utilise les fonctionnalités des
objets contenus dans l'unité. Les codes de l'application
sont livrés avec l'unité pour illustrer comment utiliser les objets de
cette unité. L'application de démonstration utilise aussi les unités
LRJ_WindowsPlus,
LRJ_ClassesPlus,
LRJ_GridsPlus,
LRJ_WinBrowseDialog,
LRJ_WinFiles et
LRJ_WinDrives non livrées
avec l'application.
L'unité LRJ_WinDirectories met en
oeuvre les fonctions de Windows suivantes :
|
|
CreateDirectoryW
FindClose
FindFirstFileW
FindNextFileW
RemoveDirectoryW
SetErrorMode
SHFileOperation
|
Déclarations publiques de l'unité
I
Télécharger l'application de démonstration
I
Exemples d'utilisations
Utilise les unités : Windows, Classes, SysUtils, ShellAPI, SyncObjs,
LRJ_ClassesPlus et
LRJ_WinFiles.
Version : 1.5 du 10.05.2009
Auteur : Laurent Hède
Copyright : LorenJo
Nombre de lignes : 1389
Réalisée sous : Delphi 6
Systèmes compatibles : NT4, 2000, XP, Vista, serveurs
Prix : 352.00 € H.T.
Déclarations publiques de l'unité :
unit LRJ_WinDirectories;
interface
uses
Windows,
classes,
SysUtils,
ShellAPI,
SyncObjs,
LRJ_ClassesPlus,
LRJ_WinFiles;
type
...............
//------------OBJET----------------------------
LRJ_TListFile = class(LRJ_TList)
...............
function IfFileExist(const AFileName: string): boolean; // exécuter RefreshListes sur le parent avant pour charger la liste
property DiskFile[const index: integer] : LRJ_TWinFile read GetDiskFile;
end;//-----------FIN--------------------------
//------------OBJET----------------------------
LRJ_TListDirectory = class(LRJ_TList)
...............
function IfDirectoryExist(const ADirName: string): boolean; // exécuter RefreshListes sur le parent avant pour charger la liste
property Directory[const index: integer] : LRJ_TWinDirectory read GetDirectory;
end;//-----------FIN--------------------------
...............
//------------OBJET----------------------------
LRJ_TWinDirThread = class(TThread)
...............
procedure Execute; override;
end;//-----------FIN--------------------------
//------------OBJET----------------------------
LRJ_TWinDirectory = class(LRJ_TBaseFileDir)
........
function WDFindFirst(const Path: string; var F: LRJ_TSearchRecW; const AExcludeAttribs: LRJ_TAttribsFichier): Integer;
function WDFindNext(var F: LRJ_TSearchRecW; const AExcludeAttribs: LRJ_TAttribsFichier): Integer;
procedure WDFindClose(var F: LRJ_TSearchRecW);
procedure SetLecteur(const Alecteur: char); // si le repertoire est une racine, sinon utiliser FullName
procedure RefreshListes(const AExcludeAttribut: LRJ_TAttribsFichier); // charge ou recharge ListeDirectory et ListeFichier
procedure ClearListes;
function GetCountTypedFichiers(const AAttribut: LRJ_TAttribFichier; const AExcludeAttribut: LRJ_TAttribsFichier): integer; // que
// du répertoire en cours, non récursif
function GetCountChildDirectories(const AExcludeAttribut: LRJ_TAttribsFichier): integer; // ne charge pas les listes,
// uniquement pour le répertoire en cours
function IfChildDirectories(const AExcludeAttribut: LRJ_TAttribsFichier): boolean;
function GetContentSize: int64; // Taille du contenu récursivement
function GetContentDiskSpaceSize: int64; // Taille sur le disque du contenu récursivement
function IfFileExist(const AFileName: string) : boolean; // juste le nom, sans le chemin, ne charge pas les listes. marche avec
// fichiers ou répertoires. Plus complet que FileExists si le nom est
// bizare, du genre '.' ou '..' par exemple. Non récursif
function CreateDirectory(const ACompleteName: string; const ASecurityAttributes: pointer = nil): boolean; // crée le répertoire et les
// répertoires parent si nécessaire
function Delete: boolean; // ne marche que si répertoire est vide, sans passer par la corbeille
function FullDelete: boolean; //détruit tout, le répertoire et son contenu récursivement, sans passer par la corbeille
function DeleteToRecycleBin: Boolean; // met dans la corbeille avec le contenu, récursivement, pourrait ne plus fonctionner
// à partir de Vista (?)
function Copy(const ADirectory : string; const AProgressProc: LRJ_TNotifyProgressDirectory): boolean; // copie le contenu avec, récursivement
function Move(const ANewParentDirectory : string; const AProgressProc: LRJ_TNotifyProgressDirectory): boolean; // déplace le contenu
//y compris, récursivement
function Search(const AMaskFileName: string; const AStrListResult: TStrings; const AExcludeAttribut: LRJ_TAttribsFichier): boolean;
// charge les listes car recherche récursive, charge AStrListResult avec les résultats correspondants au mask
//pour recherche que des répertoire, faire [dir] + mask de recherche expliqué ci-dessous
//pour recherche que des fichiers, faire [file] + mask de recherche expliqué ci-dessous
// si ni [dir] ni [file] en préfixe, alors on prend fichiers et répertoires correspondant au mask
// pour le masque de recherche :
// exe* : recherche tous les fichiers ou répertoires commencant par exe
// *exe : recherche tous les fichiers ou répertoires finissant (extension comprise) par exe
// *exe* : recherche tous les fichiers ou répertoires contenant (extension comprise) exe
// exe : recherche tous les fichiers ou répertoires égaux (extension comprise) à exe
// exe*.* : recherche les fichiers ou répertoires commencant par exe
// exe.* : recherche tous les fichiers ou répertoires du nom de exe ayant une extension quelconque
// *exe*.* : recherche tous les fichiers ou répertoires dont le nom contient exe ayant une extension quelconque
// exe.*l : recherche tous les fichiers ou répertoires du nom de exe dont l'extension finit par l
// exe.d* : recherche tous les fichiers ou répertoires du nom de exe dont l'extension commence par d
// exe.*d* : recherche tous les fichiers ou répertoires du nom de exe dont l'extension contient d
// Pour contient, cela signifie autant commence par, finit par ou contient
// méthodes exécutées en tâche de fond, ne détruire cet objet qu'après retour de ATerminatedProc et dans une autre méthode
// car on ne peut détruire un objet dans une méthode qu'il active lui-même
function CopyOnBackGround(const ADirectory : string; const AProgressProc: LRJ_TNotifyProgressDirectory;
const ATerminatedProc: LRJ_TNotifyTerminated): boolean;
function MoveOnBackground(const ANewParentDirectory : string; const AProgressProc: LRJ_TNotifyProgressDirectory;
const ATerminatedProc: LRJ_TNotifyTerminated): boolean;
function GetContentSizeBackground(const AResultCalcSizeProc: LRJ_TNotifyResultCalcSize): boolean;
function GetContentDiskSpaceSizeBackground(const AResultCalcSizeProc: LRJ_TNotifyResultCalcSize): boolean;
function FullDeleteBackground(const ATerminatedProc: LRJ_TNotifyTerminated): boolean;
function SearchBackground(const AMaskFileName: string; const AStrListResult: TStrings; const AExcludeAttribut: LRJ_TAttribsFichier;
const ATerminatedProc: LRJ_TNotifyTerminated): boolean;
// commandes pour le thread de tâche de fond
procedure SuspendBackground;
procedure RestartBackground;
procedure CancelBackground;
property ListDirectory: LRJ_TListDirectory read ReadListeDirectory;
property ListFile: LRJ_TListFile read ReadListeFichier;
end;//-----------FIN--------------------------
|
Application de démonstration
L'onglet "Explore" permet de naviguer dans les répertoires. En double-cliquant sur un répertoire
dans la liste Répertoires, on entre dans ce répertoire et en cliquant sur <------, on revient
dans le répertoire parent. Lorsqu'on entre dans un répertoire, la liste Répertoires affiche les
répertoires contenus dans ce répertoire et la liste Fichiers affiche les fichiers contenus dans
ce répertoire. Lorsqu'on clique sur un répertoire dans la liste Répertoires, des informations sur
le répertoire sont affichées dans la grille. Idem lorsqu'on clique sur un fichier de la liste
Fichiers. Si on coche sur "Afficher le nombre de sous-répertoires entre parenthèses", les répertoires
de la liste Répertoires sont suivis par un nombre entre parenthèses qui comptabilise le nombre
de sous-répertoires (cela ralentit considérablement la navigation dans les répertoires lorsqu'il
y a beaucoup de sous-répertoires dans le répertoire dans lequel on entre). En cliquant
sur "Paramètres explore", on va dans l'onglet "Paramètres explorer".
L'onglet "Paramètres explore" permet de définir les attributs de répertoire et fichier qui excluront
des répertoires ou des fichiers dans les listes de l'onglet "Explore".
L'onglet "création" permet de créer un répertoire dans le répertoire sélectionné dans l'onglet
"Explore".
L'onglet "Destruction" permet de détruire le répertoire sélectionné dans l'onglet "Explore". L'onglet
donne le choix entre la destruction du répertoire que s'il est vide, la destruction du répertoire
et de son contenu (fichiers et sous-répertoires), la destruction en tâche de fond et la mise
à la corbeille.
L'onglet "Renommer" permet de renommer le répertoire sélectionné dans l'onglet "Explore".
L'onglet "Changer attributs" permet de modifier certains attributs du répertoire sélectionné dans
l'onglet "Explore".
L'onglet "Size" permet de calculer la taille du contenu du répertoire, soit la taille stricte ou
soit la taille sur le disque. Le calcul des tailles peut être réalisé en tâche de fond.
L'onglet "Copier" permet de copier le répertoire et son contenu dans un autre répertoire.
L'opération peut être réalisé dans le thread principal de l'application (bloquante) ou dans un
thread secondaire (non bloquante). Lorsqu'on réalise l'opération en tâche de fond, on peut
stopper l'opération ("Stop") ou la suspendre ("Suspend") et la poursuivre ("restart").
L'onglet "Déplacer" permet de déplacer le répertoire et son contenu dans un autre répertoire.
L'opération peut être réalisée en tâche de fond (mêmes particularités que l'onglet "Copier").
L'onglet "Recherche" permet de rechercher les fichiers et/ou des répertoires à partir du répertoire
et dans l'ensemble de son contenu (sous-répertoires). Comme pour "Copier" ou "Déplacer", opération
peut être exécutée dans le thread principal de l'application (bloquante) ou dans un thread
secondaire (non bloquante).
Exemples d'utilisations
Charger les sous-répertoires d'un répertoires dans ListBox1 et les fichiers du
répertoire dans listBox2 (procédure de l'application de démonstration)
procedure TForm1.Int_ChargeDirectory;
var
i: integer;
zDir: LRJ_TWinDirectory;
zFic: LRJ_TWinFile;
zcount: integer;
begin
MODirectories.RefreshListes(GetListExcludeAttribs);
ListBox1.Items.BeginUpdate;
ListBox1.Clear;
ListBox1.Items.AddObject(ctStringRetour, nil);
for i:=0 to MODirectories.ReadListeDirectory.Tot_Idx0 do
begin
zDir := MODirectories.ReadListeDirectory[i];
if (zDir.Name <> '.') and (zDir.Name <> '..') then
begin
if CheckBox1.Checked then
begin
zcount := zDir.GetCountChildDirectories(GetListExcludeAttribs);
if zDir.IfFileExist('.') then dec(zcount);
if zDir.IfFileExist('..') then dec(zcount);
if zcount > 0 then
ListBox1.Items.AddObject(zDir.Name + ' (' + IntToStr(zcount) + ')', zDir)
else
ListBox1.Items.AddObject(zDir.Name , zDir);
end
else
ListBox1.Items.AddObject(zDir.Name , zDir);
end;
end;
ListBox1.Items.EndUpdate;
ListBox2.Items.BeginUpdate;
ListBox2.Clear;
for i:=0 to MODirectories.ReadListeFichier.Tot_Idx0 do
begin
zFic := MODirectories.ReadListeFichier[i];
begin
ListBox2.Items.AddObject(zFic.Name, zFic);
end;
end;
ListBox2.Items.EndUpdate;
Label1.Caption := 'Répertoires (' + intToStr(MODirectories.ReadListeDirectory.Count) + ')';
Label2.Caption := 'Fichiers (' + intToStr(MODirectories.ReadListeFichier.Count) + ')';
edit1.Text := MODirectories.FullName;
end;
|
Renommer un répertoire
var
zRep: LRJ_TWinDirectory;
begin
zRep := LRJ_TWinDirectory.Create;
zRep.FullName := EditOldFullName.Text;
if zRep.Rename(EditNewName.Text) then
begin
EditNewName.Text := '';
EditOldFullName.Text := zRep.FullName;
end;
zRep.Free;
end;
|
Modifier la date de dernière écriture d'un répertoire
var
zModifDateTime: LRJ_TModifDateTime;
zRep: LRJ_TWinDirectory;
begin
zRep := LRJ_TWinDirectory.Create;
zRep.FullName := EditFullName.Text;
zModifDateTime := LRJ_TModifDateTime.create;
zModifDateTime.Date := trunc(zRep.LastWriteTime);
zModifDateTime.Time := zRep.LastWriteTime - zModifDateTime.Date;
if zModifDateTime.ShowModal = mrOK then
begin
if zModifDateTime.IfChangeDateTime then
zRep.LastWriteTime := zModifDateTime.Date + zModifDateTime.Time;
end;
zModifDateTime.free;
zRep.Free;
end;
|
Ajouter l'attribut hidden à un répertoire
var
zRep: LRJ_TWinDirectory;
zAttribs: LRJ_TAttribsFichier;
begin
zRep := LRJ_TWinDirectory.Create;
zRep.FullName := EditFullName.Text;
zAttribs := zRep.GetAttributs;
include(zAttribs, lrj_tafHidden);
if not zRep.SetAttributs(zAttribs) then
begin
//problème
end;
zRep.Free;
end;
|
Faire une recherche dans un répertoire. Le nom du répertoire sélectionné se situe dans edit19,
CheckBox2 (fichiers) et CheckBox3 (répertoires) servent à choisir si on recherche des fichiers,
des répertoires ou les deux, le mask de recherche se situe dans edit20, on affiche la liste
dans ListBox3, et on affiche le résultat de la recherche (OK ou erreur) dans edit21 et la
quantité trouvée dans edit22.
var
zDir: LRJ_TWinDirectory;
zMaskSearch: string;
begin
if length(edit19.Text) > 0 then
if (CheckBox2.Checked) or (CheckBox3.Checked) then
begin
edit22.Text := '';
edit21.Text := '';
if (CheckBox2.Checked) and (CheckBox3.Checked) then
zMaskSearch := edit20.Text
else
begin
if (CheckBox2.Checked) then zMaskSearch := '[file]' + edit20.Text;
if (CheckBox3.Checked) then zMaskSearch := '[dir]' + edit20.Text;
end;
zDir := LRJ_TWinDirectory.Create;
zDir.FullName := edit19.Text;
ListBox3.Items.BeginUpdate;
ListBox3.Items.Clear;
if zDir.Search(zMaskSearch , ListBox3.Items, []) then
begin
edit21.Text := 'OK';
edit22.Text := IntToStr(ListBox3.Items.Count);
end
else
begin
edit21.Text := 'Erreur';
end;
zDir.Free;
ListBox3.Items.EndUpdate;
end;
end;
|
Copier un répertoire dans un autre répertoire en tâche de fond. Le nom complet
du répertoire se situe dans edit11, le nom complet du répertoire de destination se situe
dans edit12, le résultat de l'opération est affiché dans edit14, les fichiers et
répertoires copiés sont affichés en cours d'opération dans edit13 et la progression de
l'opération est illustrée par ProgressBar2 (exemple tirée de l'application de démo).
const
WM_ClearThread = WM_APP + 1;
type
TForm1 = class(TForm)
........
private
MOADir: LRJ_TWinDirectory;
MODoCloseOnTerminateThread: boolean;
procedure OnProgressCopy(const ASizeCopied, ASizeHasToCopy: int64; const AFicName: PChar);
procedure onTerminateThreadCopy(const AResult: boolean);
procedure WMClearThread(var Message: TMessage); message WM_ClearThread;
public
end;
{--------------------------------------------------------------}
procedure TForm1.WMClearThread(var Message: TMessage);
begin
MOADir.Free;
MOADir := nil;
edit13.Text := '';
ProgressBar2.Position := 0;
if MODoCloseOnTerminateThread then close;
end;
{--------------------------------------------------------------}
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if assigned(MOADir) then
begin
// comme on ferme la fiche mais que la tâche est en cours, la fenêtre n'est que rendue invisible le temps
// que la tâche se termine et l'application se fermera à la fin de la tâche.
CanClose := false;
MODoCloseOnTerminateThread := true;
hide;
MOADir.CancelBackground;
end;
end;
{--------------------------------------------------------------}
procedure TForm1.onTerminateThreadCopy(const AResult: boolean);
begin
if AResult then
edit14.Text := 'Finish'
else
edit14.Text := 'Erreur';
PostMessage(handle, WM_ClearThread, 0 , 0); // on ne peut pas détruire ici MOADir car c'est MOADir qui
// active onTerminateThreadCopy. Donc on post un Windows message
// et on détruit MOADir à la réception du message
end;
{--------------------------------------------------------------}
procedure TForm1.OnProgressCopy(const ASizeCopied, ASizeHasToCopy: int64; const AFicName: PChar);
begin
if (ASizeCopied > 0) and (ASizeHasToCopy > 0) then
ProgressBar2.Position := trunc((ASizeCopied / ASizeHasToCopy) * 100);
Edit13.Text := AFicName;
Edit13.refresh;
end;
{--------------------------------------------------------------}
procedure TForm1.Button17Click(Sender: TObject);
begin
if assigned(MOADir) then exit;
if length(edit11.Text) > 0 then
begin
if length(edit12.Text) > 0 then
begin
edit14.Text := '';
edit13.Text := '';
MOADir := LRJ_TWinDirectory.Create;
MOADir.FullName := edit11.Text;
MOADir.CopyOnBackGround(edit12.Text, OnProgressCopy, onTerminateThreadCopy);
end
else
LRJ_ShowMessage('Veuillez sélectionner le répertoire de destination par Parcourir ...');
end
else
LRJ_ShowMessage('Veuillez sélectionner le répertoire à copier par onglet Explore');
end;
|
Vous n'avez pas trouvé d'exemple répondant à votre problématique ?
Cliquez sur ce lien.
|
|
|
 | |  |
|
|
