|
|
|
| | | | | | | | |  |
| 
| Code source : unité LRJ_WinFiles | |
| |
| | |
|
Description : cette unité contient l'objet LRJ_TWinFile qui extrait des informations
sur les fichiers : attributs, taille, date et
heure de création, de la dernière modification et du
dernier accès, et si elles sont disponibles, les informations incluses par le propriétaire
du fichier : commentaire, nom interne, nom du produit, nom de la société, propriétaire du
Copyright, version du produit, description, marque, private build, version du fichier, nom
du fichier original, special build. Cet objet permet aussi de modifier les attributs du
fichier, de le renommer, de le détruire, de le mettre dans la corbeille,
de le copier ou de le déplacer. Pour la copie et
le déplacement, cet objet permet de réaliser la tâche en tâche de fond sur un thread secondaire
développé dans l'unité. 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 mises
en oeuvre dans l'unité. Les codes de l'application
sont livrés avec l'unité pour illustrer comment utiliser les fonctionnalités de l'objet de
cette unité. L'application de démonstration utilise les unités
LRJ_WindowsPlus,
LRJ_WinBrowseDialog,
LRJ_GridsPlus et
LRJ_ModifDateTime non livrées avec l'application.
L'unité LRJ_WinFiles met en
oeuvre les fonctions Windows suivantes :
|
|
closeHandle
CreateFileW
DeleteFileW
GetCompressedFileSizeW
GetDiskFreeSpaceW
GetDiskFreeSpaceExW
GetFileAttributesExW
GetFileVersionInfo
GetFileVersionInfoSize
MoveFileW
SetErrorMode
SetFileTimeW
SHFileOperation
VerQueryValue
|
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 et SyncObjs.
Version : 1.8 du 10.05.2009
Auteur : Laurent Hède
Copyright : LorenJo
Nombre de lignes : 1068
Réalisée sous : Delphi 6
Systèmes compatibles : NT4, 2000, XP, Vista, serveurs
Prix : 262.00 € H.T.
Déclarations publiques de l'unité :
unit LRJ_WinFiles;
interface
uses
Windows,
Classes,
SysUtils,
ShellAPI,
SyncObjs;
function LRJ_IfDirectoryExists(const Directory: string): Boolean;
.......
function LRJ_GetAttributNameString(const AAttribut: LRJ_TAttribFichier): string;
.......
//------------OBJET----------------------------
LRJ_TBaseFileDir = class(TObject)
........
function SetAttributs(const AAttributs : LRJ_TAttribsFichier): boolean;
function GetAttributs: LRJ_TAttribsFichier;
function GetFormatedSize(const ASize: int64): string;
function GetParentDirectory: string;
function GetStringAttributs: string;
function GetTagReparsePoint: LRJ_TTagReparsePoint;
function Rename(const NewName: string): Boolean;
function GetDWORDAttribut(const AAttributs: LRJ_TAttribsFichier): DWORD;
function GetFreeDiskSpace(const ADirectory: string): int64;
function GetCompressedFileSize: int64;
function GetDiskFileSize: int64;
property FullName: string read MOFullName write SetFullName;
property Name: string read MOName;
property Size: Int64 read GetSize;
property LastAccessTime: TDateTime read GetLastAccessTime write SetLastAccessTime;
property LastWriteTime: TDateTime read GetLastWriteTime write SetLastWriteTime;
property CreationTime: TDateTime read GetCreationTime write SetCreationTime;
end;//-----------FIN--------------------------
......
LRJ_TNotifyProgress = procedure (const ASizeCopied, ASizeHasToCopy: int64) of object;
LRJ_TNotifyTerminated = procedure (const AResult: boolean) of object;
LRJ_TThreadIfCancel = function : boolean of object;
LRJ_TWinFile = class;
//------------OBJET----------------------------
LRJ_TWinFileThread = class(TThread)
.......
procedure Execute; override;
end;//-----------FIN--------------------------
// Pour move et copy, on vérifie s'il existe l'espace disque nécessaire pour l'utilisateur. Si non, result = false
// et l'instruction n'est pas exécutée
//------------OBJET----------------------------
LRJ_TWinFile = class(LRJ_TBaseFileDir)
........
function GetTypedInfoVersion(const ATypeOfInfo: LRJ_TFileInfoVersion): string;
function Delete: boolean; // sans passer par la corbeille
function DeleteToRecycleBin: Boolean; // met dans la corbeille, pourrait ne plus fonctionner à partir de Vista (?)
function Move(const ANewParentDirectory: string; const AProgressProc: LRJ_TNotifyProgress): boolean; //AProgressProc peut être nil
function Copy(const ADirectory: string; const AProgressProc: LRJ_TNotifyProgress): boolean; //AProgressProc peut être nil
function CopyOnBackground(const ANewParentDirectory: string; const AProgressProc: LRJ_TNotifyProgress;
const ATerminatedProc: LRJ_TNotifyTerminated): boolean; //copy en tâche de fond, avec un thread spécial pour ne pas
// bloquer l'application, AProgressProc et ATerminatedProc peuvent être nil
// mais serait plutôt une erreur pour ATerminatedProc. le result n'est utile
// que pour savoir si la procédure est lancée. Pour savoir si la copie a
// intégralement réussie, il faut attendre le result de ATerminatedProc
function MoveOnBackground(const ANewParentDirectory: string; const AProgressProc: LRJ_TNotifyProgress;
const ATerminatedProc: LRJ_TNotifyTerminated): boolean; //move en tâche de fond, idem ci-dessus pour remarques
// commandes pour le thread de tâche de fond
procedure SuspendBackground;
procedure RestartBackground;
procedure CancelBackground;
end;//-----------FIN--------------------------
|
Application de démonstration
L'onglet "File infos" contient les informations extraites d'un fichier. Il faut cliquer sur
"Parcourir ..." pour sélectionner un fichier. Toutes les informations
après la date du dernier accès ne
sont disponibles que si le créateur du fichier a inclus dans ce fichier ces informations. C'est
en général le cas des exe ou dll des systèmes Windows ou des logiciels tiers.
L'onglet "rename" permet de renommer le fichier sélectionné dans l'onglet "File infos".
L'onglet "delete" permet de détruire le fichier sélectionné dans l'onglet "File infos"
soit directement, soit en l'envoyant dans la corbeille.
L'onglet "Changer attributs" permet de modifier les attributs du fichier en fonction des
possibilités offertes par le système d'exploitation et des droits utilisateurs.
L'onglet "Changer dates" permet de modifier les dates et heures de création, dernière
écriture ou dernier accès au fichier sélectionné dans l'onglet "File infos". Le dernier accès est
très récent car le chargement de l'onglet "File infos" implique un accès au fichier.
L'onglet "copy" permet de copier le fichier sélectionné dans l'onglet "File infos". On peut
copier ce fichier soit de manière bloquante (en utilisant le Thread principal de l'application)
soit de manière non bloquante (en utilisant un thread secondaire de l'application) Lorsque
l'on copie de manière non bloquante, on peut terminer la tâche, la suspendre ou la relancer.
Selon le choix au niveau du développement, on peut terminer la tâche de fond ou attendre
sa fin lors de la fermeture de l'application. Pour cette application de démonstration,
si on ferme la fiche principale de l'application, nous stoppons immédiatement la tâche de
fond et nous fermons l'application.
L'onglet "Move" permet de déplacer le fichier sélectionné dans l'onglet "File infos". On
peut le déplacer de manière bloquante (en utilisant le Thread principal de l'application)
soit de manière non bloquante (en utilisant un thread secondaire de l'application). Sinon,
même remarques pour pour l'onglet "copy" pour la gestion de la tâche en tâche de fond.
Exemples d'utilisations
Charger le numéro de version d'un logiciel dans un TEdit
var
zFic: LRJ_TWinFile;
begin
zFic := LRJ_TWinFile.Create;
zFic.FullName := EditFullNameLogiciel.Text;
EditNumeroDeVersion.text := zFic.GetTypedInfoVersion(fiv_ProductVersion);
zFic.Free;
end;
|
Tester si un fichier n'est pas vide
var
zFic: LRJ_TWinFile;
begin
zFic := LRJ_TWinFile.Create;
zFic.FullName := EditFullName.Text;
if zFic.Size > 0 then
begin
end;
zFic.Free;
end;
|
Renommer un fichier
var
zFic: LRJ_TWinFile;
begin
if length(EditOldFullName.Text) > 0 then
begin
if length(EditNewName.Text) > 0 then
begin
zFic := LRJ_TWinFile.Create;
zFic.FullName := EditOldFullName.Text;
if zFic.Rename(EditNewName.Text) then
begin
EditNewName.Text := '';
EditOldFullName.Text := zFic.FullName;
.....
end;
zFic.Free;
end;
end;
end;
|
Modifier la date de dernière écriture d'un fichier
var
zModifDateTime: LRJ_TModifDateTime;
zFic: LRJ_TWinFile;
begin
zFic := LRJ_TWinFile.Create;
zFic.FullName := EditFullName.Text;
zModifDateTime := LRJ_TModifDateTime.create;
zModifDateTime.Date := trunc(zFic.LastWriteTime);
zModifDateTime.Time := zFic.LastWriteTime - zModifDateTime.Date;
if zModifDateTime.ShowModal = mrOK then
begin
zFic.LastWriteTime := zModifDateTime.Date + zModifDateTime.Time;
end;
zModifDateTime.free;
zFic.Free;
end;
|
Ajouter l'attribut hidden à un fichier
var
zFic: LRJ_TWinFile;
zAttribs: LRJ_TAttribsFichier;
begin
zFic := LRJ_TWinFile.Create;
zFic.FullName := EditFullName.Text;
zAttribs := zFic.GetAttributs;
include(zAttribs, lrj_tafHidden);
if not zFic.SetAttributs(zAttribs) then
begin
//problème
end;
zFic.Free;
end;
|
Déplacer un fichier de manière bloquante sans utiliser la notification de progression
var
zFic: LRJ_TWinFile;
begin
zFic := LRJ_TWinFile.Create;
zFic.FullName := editOldFullName.Text;
if not zFic.Move(editNewFullName.Text,nil) then
begin
//problème
end;
zFic.free;
end;
|
Déplacer un fichier de manière bloquante en utilisant la notification de progression.
Le nom du ficher se situe dans edit5, le nom du répertoire de destination si situe
dans edit6, on affiche le résultat dans edit15 et on utilise une barre de progression nommée
ProgressBar1 (exemple extrait de l'application de démonstration)
procedure TForm1.OnProgressFileMove(const ASizeCopied, ASizeHasToCopy: int64);
begin
if (ASizeCopied > 0) and (ASizeHasToCopy > 0) then
ProgressBar1.Position := trunc((ASizeCopied / ASizeHasToCopy) * 100)
else
ProgressBar1.Position := 0;
end;
{--------------------------------------------------------------}
procedure TForm1.Button13Click(Sender: TObject);
var
zFic: LRJ_TWinFile;
begin
if length(edit5.Text) > 0 then
begin
if length(edit6.Text) > 0 then
begin
zFic := LRJ_TWinFile.Create;
zFic.FullName := edit5.Text;
if zFic.Move(edit6.Text, OnProgressFileMove) then
begin
ProgressBar1.Position := 0;
edit15.Text := 'OK';
edit5.Text := zFic.FullName;
edit1.Text := zFic.FullName;
end
else
begin
edit15.Text := 'Erreur';
LRJ_ShowMessage(LRJ_GetLastErrorString);
end;
zFic.Free;
end
else
LRJ_ShowMessage('Veuillez sélectionner le répertoire de destination par Parcourir ...');
end
else
LRJ_ShowMessage('Veuillez sélectionner le fichier à déplacer par onglet File infos');
end;
|
Déplacer un fichier de manière non bloquante en utilisant la notification de progression.
Le nom du ficher se situe dans edit5, le nom du répertoire de destination si situe
dans edit6, on affiche le résultat dans edit15 et on utilise une barre de progression nommée
ProgressBar1 (exemple extrait de l'application de démonstration)
const
WM_ClearThread = WM_APP + 1;
type
TForm1 = class(TForm)
..............
private
MOFic: LRJ_TWinFile; // nil
MODoCloseOnTerminateThread: boolean; // false
procedure OnProgressFileMove(const ASizeCopied, ASizeHasToCopy: int64);
procedure OnTerminateThreadMove(const AResult: boolean);
procedure WMClearThread(var Message: TMessage); message WM_ClearThread;
public
end;
{--------------------------------------------------------------}
procedure TForm1.OnProgressFileMove(const ASizeCopied, ASizeHasToCopy: int64);
begin
if (ASizeCopied > 0) and (ASizeHasToCopy > 0) then
ProgressBar1.Position := trunc((ASizeCopied / ASizeHasToCopy) * 100)
else
ProgressBar1.Position := 0;
end;
{--------------------------------------------------------------}
procedure TForm1.onTerminateThreadMove(const AResult: boolean);
begin
if AResult then
edit15.Text := 'OK'
else
edit15.Text := 'Erreur';
ProgressBar1.Position := 0;
PostMessage(handle, WM_ClearThread, 0 , 0); // on ne peut pas détruire ici MOFic car c'est MOFic qui
// active onTerminateThreadCopy. Donc on post un Windows message
// et on détruit MOFic à la réception du message
end;
{--------------------------------------------------------------}
procedure TForm1.WMClearThread(var Message: TMessage);
begin
MOFic.Free;
MOFic := nil;
if MODoCloseOnTerminateThread then close;
end;
{--------------------------------------------------------------}
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if assigned(MOFic) 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;
MOFic.CancelBackground;
end;
end;
{--------------------------------------------------------------}
procedure TForm1.Button18Click(Sender: TObject);
begin
if assigned(MOFic) then exit;
if length(edit5.Text) > 0 then
begin
if length(edit6.Text) > 0 then
begin
if not assigned(MOFic) then
begin
edit15.Text := 'En cours';
MOFic := LRJ_TWinFile.Create;
MOFic.FullName := edit5.Text;
MOFic.MoveOnBackground(edit6.Text, OnProgressFileMove, onTerminateThreadMove);
end;
end
else
LRJ_ShowMessage('Veuillez sélectionner le répertoire de destination par Parcourir ...');
end
else
LRJ_ShowMessage('Veuillez sélectionner le fichier à déplacer par onglet File infos');
end;
|
Vous n'avez pas trouvé d'exemple répondant à votre problématique ?
Cliquez sur ce lien.
|
|
|
 | |  |
|
|
