|
|
|

| | | | | | | | |  |
 | 
 | Code source : unité LRJ_WinTrackChangeDir |  |

|  |
 | |  |

|
Description : cette unité contient les objets LRJ_TTrackChangesDir et
LRJ_TCD_TWaitThread. LRJ_TCD_TWaitThread contient un thread secondaire qui gère l'attente
de la survenue d'une modification. LRJ_TTrackChangesDir gère le chargement des répertoires
à surveiller, le lancement et l'arrêt du thread de surveillance et le déclenchement
des notifications lors de modifications. Les notifications ne précisent pas quel
répertoire ou fichier a été modifié.
L'unité est livrée avec une application de démonstration (
voir description plus loin
) qui met en oeuvre la surveillance d'un répertoire. Les codes de l'application de
démonstration sont visibles à la fin de cette page en tant qu'exemple d'utilisation.
L'unité LRJ_WinTrackChangeDir met en oeuvre les fonctions de Windows suivantes :
|
|
FindCloseChangeNotification
FindFirstChangeNotification
FindNextChangeNotification
WaitForMultipleObjects
|
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, SyncObjs et
LRJ_ClassesPlus
Version : 1 du 02.01.2009
Auteur : Laurent Hède
Copyright : LorenJo
Nombre de lignes : 473
Réalisée sous : Delphi 6
Systèmes compatibles : NT4, 2000, XP, Vista, serveurs
Prix : 104.00 € H.T.
Déclarations publiques de l'unité :
unit LRJ_WinTrackChangeDir;
interface
uses
Windows,
Classes,
SyncObjs,
LRJ_ClassesPlus;
..............
LRJ_TTCD_OnChange = procedure (const ADir: string; const TypeSurveil: LRJ_TSefOfTypeSurveil) of object;
LRJ_TTCD_OnTerminateWait = procedure (const AWaitStatut: DWORD) of object;
//------------OBJET---------------------------
LRJ_TTrackChangesDir = class(TObject)
..............
function AddDir(const ADir: string; const IFSubTree: boolean;
const ATypesSurveil: LRJ_TSefOfTypeSurveil): boolean;
// ADir = répertoire racine de l'arborescence surveillée,
// IFSubTree = true pour surveiller des modifs dans l'arborescence à partir de ADir, false pour
// ne surveiller les modif que dans le répertoire ADir
// Retourne False si la surveillance est active
// Exemple ('c:\', true, [lrj_ts_FileName, lrj_ts_DirName, lrj_ts_Attrib, lrj_ts_Size,
// lrj_ts_LastWrite, lrj_ts_Security]) pour surveiller toutes les modifs dans le lecteur C
procedure ClearDirs;
function Activate: boolean;
procedure Desactivate;
property Activated: boolean read GetActivated;
property WaitTimeOut: DWORD read GetWaitTimeOut write SetWaitTimeOut;
property OnChange: LRJ_TTCD_OnChange read MOOnChange write MOOnChange;
property OnTerminateWait: LRJ_TTCD_OnTerminateWait read MOOnTerminateThread write MOOnTerminateThread;
end;//-----------FIN--------------------------
|
Application de démonstration

Il faut choisir un répertoire ou un lecteur à surveiller en cliquant sur "Parcourir".
Une fois le répertoire ou lecteur à surveiller choisi, cliquer sur "Begin track" pour
lancer la surveillance et "End track" pour stopper la surveillance.
Lorsqu'une modification se produit dans l'arborescence à partir du répertoire ou
lecteur choisi, une nouvelle ligne s'inscrit dans le memo.
Exemples d'utilisations
Codes de l'application de démonstration
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,
LRJ_WinBrowseDialog,
LRJ_WinTrackChangeDir;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Memo1: TMemo;
Label1: TLabel;
Edit1: TEdit;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
MOTrack: LRJ_TTrackChangesDir;
procedure OnTrackNotif(const ADir: string; const TypeSurveil: LRJ_TSefOfTypeSurveil);
procedure ClearTrack;
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{--------------------------------------------------------------}
procedure TForm1.Button1Click(Sender: TObject);
begin
If not assigned(MOTrack) then
begin
MOTrack := LRJ_TTrackChangesDir.Create;
MOTrack.AddDir(Edit1.Text, true, [lrj_ts_FileName]);
MOTrack.AddDir(Edit1.Text, true, [lrj_ts_DirName]);
MOTrack.AddDir(Edit1.Text, true, [lrj_ts_Attrib]);
MOTrack.AddDir(Edit1.Text, true, [lrj_ts_Size]);
MOTrack.AddDir(Edit1.Text, true, [lrj_ts_LastWrite]);
MOTrack.AddDir(Edit1.Text, true, [lrj_ts_Security]);
MOTrack.OnChange := OnTrackNotif;
MOTrack.Activate;
end;
end;
{--------------------------------------------------------------}
procedure TForm1.OnTrackNotif(const ADir: string; const TypeSurveil: LRJ_TSefOfTypeSurveil);
var
zMsg: string;
begin
zMsg := ADir;
if (lrj_ts_FileName in TypeSurveil) then zMsg := zMsg + ' FileName ';
if (lrj_ts_DirName in TypeSurveil) then zMsg := zMsg + ' DirName ';
if (lrj_ts_Attrib in TypeSurveil) then zMsg := zMsg + ' Attrib ';
if (lrj_ts_Size in TypeSurveil) then zMsg := zMsg + ' Size ';
if (lrj_ts_LastWrite in TypeSurveil) then zMsg := zMsg + ' LastWrite ';
if (lrj_ts_Security in TypeSurveil) then zMsg := zMsg + ' Security ';
Memo1.lines.add(zMsg);
end;
{--------------------------------------------------------------}
procedure TForm1.ClearTrack;
begin
if assigned(MOTrack) then
begin
MOTrack.Desactivate;
MOTrack.Free;
MOTrack := nil;
end;
end;
{--------------------------------------------------------------}
procedure TForm1.Button2Click(Sender: TObject);
begin
ClearTrack;
end;
{--------------------------------------------------------------}
procedure TForm1.FormCreate(Sender: TObject);
begin
MOTrack := nil;
end;
{--------------------------------------------------------------}
procedure TForm1.FormDestroy(Sender: TObject);
begin
ClearTrack;
end;
{--------------------------------------------------------------}
procedure TForm1.Button3Click(Sender: TObject);
var
zBrowse: LRJ_TBrowseForFolder;
begin
zBrowse := LRJ_TBrowseForFolder.Create;
if zBrowse.Browse then
begin
Edit1.Text := zBrowse.GetSelectFolder;
end;
zBrowse.Free;
end;
{--------------------------------------------------------------}
end.
|
Vous n'avez pas trouvé d'exemple répondant à votre problématique ?
Cliquez sur ce lien.
|
|
 |
 | |  |
|
|