Boa Noite Pessoal,
estou a dias brigando com um modo de monitorar uma pasta expecifica a fim de
me retornar o nome do arquivo que foi criado, para assim poder fazer outra
opeção com esse arquivo,
achei na net varios arquivos e post de foruns sobre o assunto, achei o fonte
de um componente que resolveria meus problemas, mas, ele não esta
funcionando com o D2010, eu consigo criar o componente, instalo ele,
adiciono no meu projeto, modifico as configs, mas quando crio um arquivo
dentro do diretorio que está sendo monitorado o evento não eh acionado.
Abaixo segue o fonte.
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
begin
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;
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;
FAtivo := False;
FDiretorio := 'C:\';
FLista := TStringList.Create;
end;
destructor TMonitoraDiretorio.Destroy;
begin
FLista.Free;
if Assigned(FMonitoraThread) then
FMonitoraThread.Terminate;
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.
Atenciosamente.
----------------------------------------------------------------------
[image:
?ui=2&view=att&th=12492f314f4aed7a&attid=0.1&disp=attd&realattid=ii_12492f314f4aed7a&zw]
Marciano Venter
Email: venter.marci...@gmail.com
Celular: (51) 9672 6093
venter.marci...@gmail.com
marcianoven...@hotmail.com
[image: Twitter] <http://www.twitter.com/ventermarciano>@ventermarciano
[image:
Facebook]<http://www.facebook.com/profile.php?id=100000304177338&ref=profile>
Marciano
Venter
**
[As partes desta mensagem que não continham texto foram removidas]
