Fórum Monitorar arquivo e pasta #318930

11/04/2006

0

Delphi

Olá!

Será que alguém sabe de alguma maneira de se monitorar um arquivo dentro de uma pasta.

O que eu quero fazer é criar um arquivo dentro de uma pasta e quando ele for criado, o programa que estiver monitorando irá executar uma ação e depois irá excluí-lo e ficar monitorando até que outro arquivo seja criado.

Desde já agradeço a ajuda que puderem me dar.


Joao_schroeder

Joao_schroeder

Responder

Posts

11/04/2006

Aroldo Zanela

Colega,

Dependendo da versão do Delphi, você tem na paleta SAMPLES o componente ShellChangeNotifier. Caso sua versão não o tenha, este algoritmo está disponível pela WEB.


Responder

Gostei + 0

11/04/2006

Ricardo_engsoft

Fuçando na minha biblioteca de ClubeDelphi achei este componente aqui, que estou usando como base no meu projeto:

unit MonitoraDiretorio;

interface

uses
  Windows, Messages, SysUtils, Classes;

type

EDiretorioInvalido  =  class(Exception);

TMonitoraThread = class(TThread)
  private
    { Private declarations }
    FHandle : THandle;
    FOwner : TComponent;
  protected
    procedure Execute; override;
  public
    constructor Create(AOwner : TComponent; CreateSuspended: Boolean; 
        Diretorio : String); reintroduce;
    destructor Destroy; override;
  end;

  TArquivoAlterado = procedure (Sender : TObject; Arquivo : String) 
     of object;
  TMonitoraDiretorio = class(TComponent)
  private
    { Private declarations }
    FLista : TStringList;
    FMonitoraThread : TMonitoraThread;
    FAtivo: Boolean;
    FDiretorio: String;
    FOnArquivoExcluido: TArquivoAlterado;
    FOnArquivoAlterado: TArquivoAlterado;
    FOnArquivoIncluido: TArquivoAlterado;
    procedure CriaLista(var Lista : TStringList);
    procedure AtuaDiretorio;
    procedure SetAtivo(const Value: Boolean);
    procedure SetDiretorio(const Value: String);
    procedure SetOnArquivoAlterado(const Value: TArquivoAlterado);
    procedure SetOnArquivoExcluido(const Value: TArquivoAlterado);
    procedure SetOnArquivoIncluido(const Value: TArquivoAlterado);
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property Ativo : Boolean read FAtivo write SetAtivo;
    property Diretorio : String read FDiretorio write SetDiretorio;
    property OnArquivoIncluido : TArquivoAlterado read FOnArquivoIncluido write SetOnArquivoIncluido;
    property OnArquivoExcluido : TArquivoAlterado read FOnArquivoExcluido write SetOnArquivoExcluido;
    property OnArquivoAlterado : TArquivoAlterado read FOnArquivoAlterado write SetOnArquivoAlterado;
  end;


procedure Register;

implementation

procedure Register;
begin
  RegisterComponents(´Samples´, [TMonitoraDiretorio]);
end;

{ TMonitoraDiretorio }

procedure TMonitoraDiretorio.CriaLista(var Lista : TStringList);
var
  SRec : TSearchRec;
  Done : Integer;
begin
// carrega o nome dos arquivos do diretório selecionado na lista
  Lista.Sorted := True;
  Done := FindFirst(IncludeTrailingPathDelimiter(Diretorio)+´*.*´, 0, SRec);
  while Done = 0 do begin
    Lista.AddObject(Srec.Name, TObject(SRec.Time));
    Done := FindNext(SRec);
  end;
  FindClose(SRec);
end;

procedure TMonitoraDiretorio.AtuaDiretorio;
var
  NovaLista : TStringList;
  IndVelha,IndNova : Integer;
begin
  NovaLista := TStringList.Create;
  CriaLista(NovaLista);
  IndVelha := 0;
  IndNova := 0;
  while (IndVelha < FLista.Count) and (IndNova < NovaLista.Count) do begin
    if FLista[IndVelha] > NovaLista[IndNova] then begin
// Arquivo criado
      if Assigned(FOnArquivoIncluido) then
        FOnArquivoIncluido(Self, NovaLista[IndNova]);
      Inc(IndNova);
    end
    else if FLista[IndVelha] < NovaLista[IndNova] then begin
// Arquivo excluído
      if Assigned(FOnArquivoExcluido) then
        FOnArquivoExcluido(Self, FLista[IndVelha]);
      Inc(IndVelha);
    end
    else begin
// Arquivos iguais
      if (FLista.Objects[IndVelha] <> NovaLista.Objects[IndNova]) and
        Assigned(FOnArquivoAlterado) then
          FOnArquivoAlterado(Self, FLista[IndVelha]);
      Inc(IndVelha);
      Inc(IndNova);
    end;
  end;
// Processa o final das listas
  while (IndVelha < FLista.Count)  do begin
    if Assigned(FOnArquivoExcluido) then
      FOnArquivoExcluido(Self, FLista[IndVelha]);
    Inc(IndVelha);
  end;
  while (IndNova < NovaLista.Count) do begin
    if Assigned(FOnArquivoIncluido) then
      FOnArquivoIncluido(Self, NovaLista[IndNova]);
    Inc(IndNova);
  end;
  FLista.Assign(NovaLista);
  NovaLista.Free;
end;


constructor TMonitoraDiretorio.Create(AOwner: TComponent);
begin
  inherited;

end;

destructor TMonitoraDiretorio.Destroy;
begin

  inherited;
end;

procedure TMonitoraDiretorio.SetAtivo(const Value: Boolean);
begin
  FAtivo := Value;
// Termina thread anterior
  if Assigned(FMonitoraThread) then
    FMonitoraThread.Terminate;
// Limpa lista arquivos
  FLista.Clear;
  if FAtivo then begin
// Cria nova lista e thread
    if FDiretorio = ´´ then
      raise EDiretorioInvalido.Create(
           ´Diretório não pode estar em branco´);
    CriaLista(FLista);
    FMonitoraThread := TMonitoraThread.Create(Self,False,FDiretorio);
  end;

end;

procedure TMonitoraDiretorio.SetDiretorio(const Value: String);
begin
  FDiretorio := Value;
end;

procedure TMonitoraDiretorio.SetOnArquivoAlterado(
  const Value: TArquivoAlterado);
begin
  FOnArquivoAlterado := Value;
end;

procedure TMonitoraDiretorio.SetOnArquivoExcluido(
  const Value: TArquivoAlterado);
begin
  FOnArquivoExcluido := Value;
end;

procedure TMonitoraDiretorio.SetOnArquivoIncluido(
  const Value: TArquivoAlterado);
begin
  FOnArquivoIncluido := Value;
end;

{ TMonitoraThread }

constructor TMonitoraThread.Create(AOwner: TComponent;
  CreateSuspended: Boolean; Diretorio: String);
begin
 inherited Create(CreateSuspended);
  FOwner := AOwner;
  FreeOnTerminate := True;
  FHandle := FindFirstChangeNotification(PChar(Diretorio),False,
      FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_DIR_NAME or
      FILE_NOTIFY_CHANGE_ATTRIBUTES or FILE_NOTIFY_CHANGE_SIZE or
      FILE_NOTIFY_CHANGE_LAST_WRITE);

end;

destructor TMonitoraThread.Destroy;
begin
if (FHandle <> INVALID_HANDLE_VALUE) then
    FindCloseChangeNotification(FHandle);
  inherited;

end;

procedure TMonitoraThread.Execute;
begin
  inherited;
     if (FHandle <> INVALID_HANDLE_VALUE) then
    while not Terminated do begin
      if WaitForSingleObject(FHandle, 1000) = WAIT_OBJECT_0 then
// houve mudança no diretório
        Synchronize((FOwner as TMonitoraDiretorio).AtuaDiretorio);
      FindNextChangeNotification(FHandle);
    end;

 end;   
end.


Pra exemplificar eu fiz uma aplicação bem simples, se bem que a aplicação que eu estou desenvolvendo usa sockets junto e faz a transferência do arquivo manipulado pra máquina servidora.

Código da aplicação exemplo:

unit uMonitor;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, MonitoraDiretorio, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    CheckBox1: TCheckBox;
    ListBox1: TListBox;
    MonitoraDiretorio1: TMonitoraDiretorio;
    procedure MonitoraDiretorio1ArquivoAlterado(Sender: TObject;
      Arquivo: string);
    procedure MonitoraDiretorio1ArquivoExcluido(Sender: TObject;
      Arquivo: string);
    procedure MonitoraDiretorio1ArquivoIncluido(Sender: TObject;
      Arquivo: string);
    procedure CheckBox1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

Procedure TForm1.CheckBox1Click(Sender: TObject);
 Begin
   if (CheckBox1.Checked) then
     MonitoraDiretorio1.Ativo := True
   else
     MonitoraDiretorio1.Ativo := False;
 End;

Procedure TForm1.MonitoraDiretorio1ArquivoIncluido(Sender: TObject;
  Arquivo: string);
 Begin
   ListBox1.Items.Add(´(´ + TimeToStr(Time) + ´) Incluido ´ + Arquivo);
 End;

Procedure TForm1.MonitoraDiretorio1ArquivoExcluido(Sender: TObject;
  Arquivo: string);
 Begin
   ListBox1.Items.Add(´(´ + TimeToStr(Time) + ´) Excluido ´ + Arquivo);
 End;

Procedure TForm1.MonitoraDiretorio1ArquivoAlterado(Sender: TObject;
  Arquivo: string);
 Begin
   ListBox1.Items.Add(´(´ + TimeToStr(Time) + ´) Alterado ´ + Arquivo);
 End;

END.


Espero que seja útil. Se for o caso posso postar alguns trechos da versão que fiz usando sockets


Responder

Gostei + 0

11/04/2006

Ricardo_engsoft

Fuçando na minha biblioteca de ClubeDelphi achei este componente aqui, que estou usando como base no meu projeto:

unit MonitoraDiretorio;

interface

uses
  Windows, Messages, SysUtils, Classes;

type

EDiretorioInvalido  =  class(Exception);

TMonitoraThread = class(TThread)
  private
    { Private declarations }
    FHandle : THandle;
    FOwner : TComponent;
  protected
    procedure Execute; override;
  public
    constructor Create(AOwner : TComponent; CreateSuspended: Boolean; 
        Diretorio : String); reintroduce;
    destructor Destroy; override;
  end;

  TArquivoAlterado = procedure (Sender : TObject; Arquivo : String) 
     of object;
  TMonitoraDiretorio = class(TComponent)
  private
    { Private declarations }
    FLista : TStringList;
    FMonitoraThread : TMonitoraThread;
    FAtivo: Boolean;
    FDiretorio: String;
    FOnArquivoExcluido: TArquivoAlterado;
    FOnArquivoAlterado: TArquivoAlterado;
    FOnArquivoIncluido: TArquivoAlterado;
    procedure CriaLista(var Lista : TStringList);
    procedure AtuaDiretorio;
    procedure SetAtivo(const Value: Boolean);
    procedure SetDiretorio(const Value: String);
    procedure SetOnArquivoAlterado(const Value: TArquivoAlterado);
    procedure SetOnArquivoExcluido(const Value: TArquivoAlterado);
    procedure SetOnArquivoIncluido(const Value: TArquivoAlterado);
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property Ativo : Boolean read FAtivo write SetAtivo;
    property Diretorio : String read FDiretorio write SetDiretorio;
    property OnArquivoIncluido : TArquivoAlterado read FOnArquivoIncluido write SetOnArquivoIncluido;
    property OnArquivoExcluido : TArquivoAlterado read FOnArquivoExcluido write SetOnArquivoExcluido;
    property OnArquivoAlterado : TArquivoAlterado read FOnArquivoAlterado write SetOnArquivoAlterado;
  end;


procedure Register;

implementation

procedure Register;
begin
  RegisterComponents(´Samples´, [TMonitoraDiretorio]);
end;

{ TMonitoraDiretorio }

procedure TMonitoraDiretorio.CriaLista(var Lista : TStringList);
var
  SRec : TSearchRec;
  Done : Integer;
begin
// carrega o nome dos arquivos do diretório selecionado na lista
  Lista.Sorted := True;
  Done := FindFirst(IncludeTrailingPathDelimiter(Diretorio)+´*.*´, 0, SRec);
  while Done = 0 do begin
    Lista.AddObject(Srec.Name, TObject(SRec.Time));
    Done := FindNext(SRec);
  end;
  FindClose(SRec);
end;

procedure TMonitoraDiretorio.AtuaDiretorio;
var
  NovaLista : TStringList;
  IndVelha,IndNova : Integer;
begin
  NovaLista := TStringList.Create;
  CriaLista(NovaLista);
  IndVelha := 0;
  IndNova := 0;
  while (IndVelha < FLista.Count) and (IndNova < NovaLista.Count) do begin
    if FLista[IndVelha] > NovaLista[IndNova] then begin
// Arquivo criado
      if Assigned(FOnArquivoIncluido) then
        FOnArquivoIncluido(Self, NovaLista[IndNova]);
      Inc(IndNova);
    end
    else if FLista[IndVelha] < NovaLista[IndNova] then begin
// Arquivo excluído
      if Assigned(FOnArquivoExcluido) then
        FOnArquivoExcluido(Self, FLista[IndVelha]);
      Inc(IndVelha);
    end
    else begin
// Arquivos iguais
      if (FLista.Objects[IndVelha] <> NovaLista.Objects[IndNova]) and
        Assigned(FOnArquivoAlterado) then
          FOnArquivoAlterado(Self, FLista[IndVelha]);
      Inc(IndVelha);
      Inc(IndNova);
    end;
  end;
// Processa o final das listas
  while (IndVelha < FLista.Count)  do begin
    if Assigned(FOnArquivoExcluido) then
      FOnArquivoExcluido(Self, FLista[IndVelha]);
    Inc(IndVelha);
  end;
  while (IndNova < NovaLista.Count) do begin
    if Assigned(FOnArquivoIncluido) then
      FOnArquivoIncluido(Self, NovaLista[IndNova]);
    Inc(IndNova);
  end;
  FLista.Assign(NovaLista);
  NovaLista.Free;
end;


constructor TMonitoraDiretorio.Create(AOwner: TComponent);
begin
  inherited;

end;

destructor TMonitoraDiretorio.Destroy;
begin

  inherited;
end;

procedure TMonitoraDiretorio.SetAtivo(const Value: Boolean);
begin
  FAtivo := Value;
// Termina thread anterior
  if Assigned(FMonitoraThread) then
    FMonitoraThread.Terminate;
// Limpa lista arquivos
  FLista.Clear;
  if FAtivo then begin
// Cria nova lista e thread
    if FDiretorio = ´´ then
      raise EDiretorioInvalido.Create(
           ´Diretório não pode estar em branco´);
    CriaLista(FLista);
    FMonitoraThread := TMonitoraThread.Create(Self,False,FDiretorio);
  end;

end;

procedure TMonitoraDiretorio.SetDiretorio(const Value: String);
begin
  FDiretorio := Value;
end;

procedure TMonitoraDiretorio.SetOnArquivoAlterado(
  const Value: TArquivoAlterado);
begin
  FOnArquivoAlterado := Value;
end;

procedure TMonitoraDiretorio.SetOnArquivoExcluido(
  const Value: TArquivoAlterado);
begin
  FOnArquivoExcluido := Value;
end;

procedure TMonitoraDiretorio.SetOnArquivoIncluido(
  const Value: TArquivoAlterado);
begin
  FOnArquivoIncluido := Value;
end;

{ TMonitoraThread }

constructor TMonitoraThread.Create(AOwner: TComponent;
  CreateSuspended: Boolean; Diretorio: String);
begin
 inherited Create(CreateSuspended);
  FOwner := AOwner;
  FreeOnTerminate := True;
  FHandle := FindFirstChangeNotification(PChar(Diretorio),False,
      FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_DIR_NAME or
      FILE_NOTIFY_CHANGE_ATTRIBUTES or FILE_NOTIFY_CHANGE_SIZE or
      FILE_NOTIFY_CHANGE_LAST_WRITE);

end;

destructor TMonitoraThread.Destroy;
begin
if (FHandle <> INVALID_HANDLE_VALUE) then
    FindCloseChangeNotification(FHandle);
  inherited;

end;

procedure TMonitoraThread.Execute;
begin
  inherited;
     if (FHandle <> INVALID_HANDLE_VALUE) then
    while not Terminated do begin
      if WaitForSingleObject(FHandle, 1000) = WAIT_OBJECT_0 then
// houve mudança no diretório
        Synchronize((FOwner as TMonitoraDiretorio).AtuaDiretorio);
      FindNextChangeNotification(FHandle);
    end;

 end;   
end.


Pra exemplificar eu fiz uma aplicação bem simples, se bem que a aplicação que eu estou desenvolvendo usa sockets junto e faz a transferência do arquivo manipulado pra máquina servidora.

Código da aplicação exemplo:

unit uMonitor;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, MonitoraDiretorio, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    CheckBox1: TCheckBox;
    ListBox1: TListBox;
    MonitoraDiretorio1: TMonitoraDiretorio;
    procedure MonitoraDiretorio1ArquivoAlterado(Sender: TObject;
      Arquivo: string);
    procedure MonitoraDiretorio1ArquivoExcluido(Sender: TObject;
      Arquivo: string);
    procedure MonitoraDiretorio1ArquivoIncluido(Sender: TObject;
      Arquivo: string);
    procedure CheckBox1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

Procedure TForm1.CheckBox1Click(Sender: TObject);
 Begin
   if (CheckBox1.Checked) then
     MonitoraDiretorio1.Ativo := True
   else
     MonitoraDiretorio1.Ativo := False;
 End;

Procedure TForm1.MonitoraDiretorio1ArquivoIncluido(Sender: TObject;
  Arquivo: string);
 Begin
   ListBox1.Items.Add(´(´ + TimeToStr(Time) + ´) Incluido ´ + Arquivo);
 End;

Procedure TForm1.MonitoraDiretorio1ArquivoExcluido(Sender: TObject;
  Arquivo: string);
 Begin
   ListBox1.Items.Add(´(´ + TimeToStr(Time) + ´) Excluido ´ + Arquivo);
 End;

Procedure TForm1.MonitoraDiretorio1ArquivoAlterado(Sender: TObject;
  Arquivo: string);
 Begin
   ListBox1.Items.Add(´(´ + TimeToStr(Time) + ´) Alterado ´ + Arquivo);
 End;

END.


Espero que seja útil. Se for o caso posso postar alguns trechos da versão que fiz usando sockets


Responder

Gostei + 0

11/04/2006

Ricardo_engsoft

Fuçando na minha biblioteca de ClubeDelphi achei este componente aqui, que estou usando como base no meu projeto:

unit MonitoraDiretorio;

interface

uses
  Windows, Messages, SysUtils, Classes;

type

EDiretorioInvalido  =  class(Exception);

TMonitoraThread = class(TThread)
  private
    { Private declarations }
    FHandle : THandle;
    FOwner : TComponent;
  protected
    procedure Execute; override;
  public
    constructor Create(AOwner : TComponent; CreateSuspended: Boolean; 
        Diretorio : String); reintroduce;
    destructor Destroy; override;
  end;

  TArquivoAlterado = procedure (Sender : TObject; Arquivo : String) 
     of object;
  TMonitoraDiretorio = class(TComponent)
  private
    { Private declarations }
    FLista : TStringList;
    FMonitoraThread : TMonitoraThread;
    FAtivo: Boolean;
    FDiretorio: String;
    FOnArquivoExcluido: TArquivoAlterado;
    FOnArquivoAlterado: TArquivoAlterado;
    FOnArquivoIncluido: TArquivoAlterado;
    procedure CriaLista(var Lista : TStringList);
    procedure AtuaDiretorio;
    procedure SetAtivo(const Value: Boolean);
    procedure SetDiretorio(const Value: String);
    procedure SetOnArquivoAlterado(const Value: TArquivoAlterado);
    procedure SetOnArquivoExcluido(const Value: TArquivoAlterado);
    procedure SetOnArquivoIncluido(const Value: TArquivoAlterado);
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property Ativo : Boolean read FAtivo write SetAtivo;
    property Diretorio : String read FDiretorio write SetDiretorio;
    property OnArquivoIncluido : TArquivoAlterado read FOnArquivoIncluido write SetOnArquivoIncluido;
    property OnArquivoExcluido : TArquivoAlterado read FOnArquivoExcluido write SetOnArquivoExcluido;
    property OnArquivoAlterado : TArquivoAlterado read FOnArquivoAlterado write SetOnArquivoAlterado;
  end;


procedure Register;

implementation

procedure Register;
begin
  RegisterComponents(´Samples´, [TMonitoraDiretorio]);
end;

{ TMonitoraDiretorio }

procedure TMonitoraDiretorio.CriaLista(var Lista : TStringList);
var
  SRec : TSearchRec;
  Done : Integer;
begin
// carrega o nome dos arquivos do diretório selecionado na lista
  Lista.Sorted := True;
  Done := FindFirst(IncludeTrailingPathDelimiter(Diretorio)+´*.*´, 0, SRec);
  while Done = 0 do begin
    Lista.AddObject(Srec.Name, TObject(SRec.Time));
    Done := FindNext(SRec);
  end;
  FindClose(SRec);
end;

procedure TMonitoraDiretorio.AtuaDiretorio;
var
  NovaLista : TStringList;
  IndVelha,IndNova : Integer;
begin
  NovaLista := TStringList.Create;
  CriaLista(NovaLista);
  IndVelha := 0;
  IndNova := 0;
  while (IndVelha < FLista.Count) and (IndNova < NovaLista.Count) do begin
    if FLista[IndVelha] > NovaLista[IndNova] then begin
// Arquivo criado
      if Assigned(FOnArquivoIncluido) then
        FOnArquivoIncluido(Self, NovaLista[IndNova]);
      Inc(IndNova);
    end
    else if FLista[IndVelha] < NovaLista[IndNova] then begin
// Arquivo excluído
      if Assigned(FOnArquivoExcluido) then
        FOnArquivoExcluido(Self, FLista[IndVelha]);
      Inc(IndVelha);
    end
    else begin
// Arquivos iguais
      if (FLista.Objects[IndVelha] <> NovaLista.Objects[IndNova]) and
        Assigned(FOnArquivoAlterado) then
          FOnArquivoAlterado(Self, FLista[IndVelha]);
      Inc(IndVelha);
      Inc(IndNova);
    end;
  end;
// Processa o final das listas
  while (IndVelha < FLista.Count)  do begin
    if Assigned(FOnArquivoExcluido) then
      FOnArquivoExcluido(Self, FLista[IndVelha]);
    Inc(IndVelha);
  end;
  while (IndNova < NovaLista.Count) do begin
    if Assigned(FOnArquivoIncluido) then
      FOnArquivoIncluido(Self, NovaLista[IndNova]);
    Inc(IndNova);
  end;
  FLista.Assign(NovaLista);
  NovaLista.Free;
end;


constructor TMonitoraDiretorio.Create(AOwner: TComponent);
begin
  inherited;

end;

destructor TMonitoraDiretorio.Destroy;
begin

  inherited;
end;

procedure TMonitoraDiretorio.SetAtivo(const Value: Boolean);
begin
  FAtivo := Value;
// Termina thread anterior
  if Assigned(FMonitoraThread) then
    FMonitoraThread.Terminate;
// Limpa lista arquivos
  FLista.Clear;
  if FAtivo then begin
// Cria nova lista e thread
    if FDiretorio = ´´ then
      raise EDiretorioInvalido.Create(
           ´Diretório não pode estar em branco´);
    CriaLista(FLista);
    FMonitoraThread := TMonitoraThread.Create(Self,False,FDiretorio);
  end;

end;

procedure TMonitoraDiretorio.SetDiretorio(const Value: String);
begin
  FDiretorio := Value;
end;

procedure TMonitoraDiretorio.SetOnArquivoAlterado(
  const Value: TArquivoAlterado);
begin
  FOnArquivoAlterado := Value;
end;

procedure TMonitoraDiretorio.SetOnArquivoExcluido(
  const Value: TArquivoAlterado);
begin
  FOnArquivoExcluido := Value;
end;

procedure TMonitoraDiretorio.SetOnArquivoIncluido(
  const Value: TArquivoAlterado);
begin
  FOnArquivoIncluido := Value;
end;

{ TMonitoraThread }

constructor TMonitoraThread.Create(AOwner: TComponent;
  CreateSuspended: Boolean; Diretorio: String);
begin
 inherited Create(CreateSuspended);
  FOwner := AOwner;
  FreeOnTerminate := True;
  FHandle := FindFirstChangeNotification(PChar(Diretorio),False,
      FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_DIR_NAME or
      FILE_NOTIFY_CHANGE_ATTRIBUTES or FILE_NOTIFY_CHANGE_SIZE or
      FILE_NOTIFY_CHANGE_LAST_WRITE);

end;

destructor TMonitoraThread.Destroy;
begin
if (FHandle <> INVALID_HANDLE_VALUE) then
    FindCloseChangeNotification(FHandle);
  inherited;

end;

procedure TMonitoraThread.Execute;
begin
  inherited;
     if (FHandle <> INVALID_HANDLE_VALUE) then
    while not Terminated do begin
      if WaitForSingleObject(FHandle, 1000) = WAIT_OBJECT_0 then
// houve mudança no diretório
        Synchronize((FOwner as TMonitoraDiretorio).AtuaDiretorio);
      FindNextChangeNotification(FHandle);
    end;

 end;   
end.


Pra exemplificar eu fiz uma aplicação bem simples, se bem que a aplicação que eu estou desenvolvendo usa sockets junto e faz a transferência do arquivo manipulado pra máquina servidora.

Código da aplicação exemplo:

unit uMonitor;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, MonitoraDiretorio, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    CheckBox1: TCheckBox;
    ListBox1: TListBox;
    MonitoraDiretorio1: TMonitoraDiretorio;
    procedure MonitoraDiretorio1ArquivoAlterado(Sender: TObject;
      Arquivo: string);
    procedure MonitoraDiretorio1ArquivoExcluido(Sender: TObject;
      Arquivo: string);
    procedure MonitoraDiretorio1ArquivoIncluido(Sender: TObject;
      Arquivo: string);
    procedure CheckBox1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

Procedure TForm1.CheckBox1Click(Sender: TObject);
 Begin
   if (CheckBox1.Checked) then
     MonitoraDiretorio1.Ativo := True
   else
     MonitoraDiretorio1.Ativo := False;
 End;

Procedure TForm1.MonitoraDiretorio1ArquivoIncluido(Sender: TObject;
  Arquivo: string);
 Begin
   ListBox1.Items.Add(´(´ + TimeToStr(Time) + ´) Incluido ´ + Arquivo);
 End;

Procedure TForm1.MonitoraDiretorio1ArquivoExcluido(Sender: TObject;
  Arquivo: string);
 Begin
   ListBox1.Items.Add(´(´ + TimeToStr(Time) + ´) Excluido ´ + Arquivo);
 End;

Procedure TForm1.MonitoraDiretorio1ArquivoAlterado(Sender: TObject;
  Arquivo: string);
 Begin
   ListBox1.Items.Add(´(´ + TimeToStr(Time) + ´) Alterado ´ + Arquivo);
 End;

END.


Espero que seja útil. Se for o caso posso postar alguns trechos da versão que fiz usando sockets


Responder

Gostei + 0

16/05/2006

Joao_schroeder

Olá Aroldo!

Tudo bem?

Segui a tua dica de usar o componente ShellChangeNotifier, mas ficou um problema. Às vezes acontece de executar o comando somente uma vez, mas na maioria das vezes ele está executando o comando geralmente duas ou três vezes.


Segue abaixo o código que estou usando.


procedure TF_monitor.ShellChangeNotifier1Change;
begin
  if FileExists(´IMPRIMIR.TXT´) then
  begin
    DeleteFile(´IMPRIMIR.TXT´);

*.1
    WinExec(´command.com /c LISTMON.exe´,sw_ShowNormal);

*.2
//    WinExec(´command.com /c type LISTNF.TXT >lpt1´,sw_ShowNormal);
//    DeleteFile(´LISTNF.TXT´);
  end;
end;


*.1 O programa LISTMON.exe se encarrega de imprimir e deletar o arquivo LISTNF.TXT após a impressão.

*.2 Se usar o delete, não vai nem chegar a imprimir.

O *.1 é o que eu quero usar.
O *.2 eu fiz somente para teste.


Uma coisa que eu pensei agora. Será que quanto mais rápido for o computador, mais vezes ele irá executar o programa?

Se o Aroldo ou qualquer outro colega puder me dar alguma dica, fico desde já agradecido.


Responder

Gostei + 0

Utilizamos cookies para fornecer uma melhor experiência para nossos usuários, consulte nossa política de privacidade.

Aceitar