paquechu,
Cita:
Empezado por paquechu
...Acabo de hacer pruebas con el "notificador" que tiene la api de windows y creo que tampoco soluciona el problema de los cambios sufridos por un archivo en tiempo real...
|
Revisa este código:
Código Delphi
[-]
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, FileCtrl;
type
TForm1 = class(TForm)
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
Label1: TLabel;
ListBox1: TListBox;
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
public
end;
TDirectoryMonitor = class(TThread)
public
DirectoryToMonitor : String;
MsgMonitor : String;
protected
procedure StatusOn;
procedure StatusOff;
procedure MsgError;
procedure EventMonitor;
procedure Execute; override;
end;
var
Form1: TForm1;
DirectoryMonitor : TDirectoryMonitor;
implementation
{$R *.dfm}
procedure TDirectoryMonitor.StatusOn;
begin
with form1 do
begin
label1.Font.Color := clBlue;
Label1.Caption := 'Thread On';
end;
end;
procedure TDirectoryMonitor.StatusOff;
begin
with form1 do
begin
label1.Font.Color := clRed;
Label1.Caption := 'Thread Off';
end;
end;
procedure TDirectoryMonitor.MsgError;
begin
MessageDlg('Error en la Ruta de Monitoreo', mtInformation, [mbOK],0);
end;
procedure TDirectoryMonitor.EventMonitor;
begin
with Form1 do
begin
ListBox1.Items.Add(DirectoryMonitor.MsgMonitor);
if ListBox1.ScrollWidth < ListBox1.Canvas.TextWidth(DirectoryMonitor.MsgMonitor) then
ListBox1.ScrollWidth := ListBox1.Canvas.TextWidth(DirectoryMonitor.MsgMonitor) + 120;
end;
end;
procedure TDirectoryMonitor.Execute;
type
PFileNotifyInformation = ^TFileNotifyInformation;
TFileNotifyInformation = record
NextEntryOffset: DWORD;
Action: DWORD;
FileNameLength: DWORD;
FileName: WideChar;
end;
const
FILE_LIST_DIRECTORY = 1;
BufferLength = 65536;
var
H: THandle;
fDirHandle: THandle;
fChangeHandle: THandle;
Filter, BytesRead: DWORD;
Offset, NextOffset: DWORD;
Buffer: array[0..BufferLength - 1] of byte;
Overlap: TOverlapped;
WaitResult: DWORD;
FileName : String;
InfoPointer: PFileNotifyInformation;
Action : string;
Attrs : Integer;
begin
FreeOnTerminate := True;
fDirHandle := CreateFile(PChar(DirectoryToMonitor),
FILE_LIST_DIRECTORY or GENERIC_READ,
FILE_SHARE_READ or FILE_SHARE_WRITE or
FILE_SHARE_DELETE, nil, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS or
FILE_FLAG_OVERLAPPED, 0);
if (fDirHandle = INVALID_HANDLE_VALUE) or (FileExists(DirectoryToMonitor)) then
begin
Synchronize(MsgError);
Exit;
end;
fChangeHandle := CreateEvent(nil, FALSE, FALSE, nil);
FillChar(Overlap, SizeOf(TOverlapped), 0);
Overlap.hEvent := fChangeHandle;
Filter := FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_DIR_NAME
or FILE_NOTIFY_CHANGE_SIZE or FILE_NOTIFY_CHANGE_LAST_WRITE;
Synchronize(StatusOn);
while not Terminated do
begin
if ReadDirectoryChangesW(fDirHandle, @Buffer[0], BufferLength, TRUE, Filter,
@BytesRead, @Overlap, nil)
then
begin
WaitResult := WaitForMultipleObjects(1, @fChangeHandle, FALSE, 100);
if (WaitResult = WAIT_OBJECT_0) and (WaitResult <> WAIT_TIMEOUT) then
begin
InfoPointer := @Buffer[0];
repeat
NextOffset := InfoPointer.NextEntryOffset;
FileName := WideCharToString(@InfoPointer.FileName);
Attrs := FileGetAttr(DirectoryToMonitor + '\' + FileName);
if Attrs and faDirectory = faDirectory then
Action := 'DIRECTORY_';
if Attrs and faArchive = faArchive then
Action := 'FILE_';
if InfoPointer.Action = 1 then Action := Action + 'ACTION_ADDED';
if InfoPointer.Action = 2 then Action := 'FILE_DIRECTORY_ACTION_REMOVED';
if InfoPointer.Action = 3 then Action := Action + 'ACTION_MODIFIED';
if InfoPointer.Action = 4 then Action := Action + 'ACTION_RENAMED_OLD_NAME';
if InfoPointer.Action = 5 then Action := Action + 'ACTION_RENAMED_NEW_NAME';
MsgMonitor := Action + ': ' + FileName;
PByte(InfoPointer) := PByte(DWORD(InfoPointer) + NextOffset);
until NextOffset = 0;
FillChar(Buffer, SizeOf(Buffer), 0);
Synchronize(EventMonitor);
end;
end
else
begin
Break;
end;
end;
if fChangeHandle <> 0 then
CloseHandle(fChangeHandle);
if fDirHandle <> INVALID_HANDLE_VALUE then
CloseHandle(fDirHandle);
Synchronize(StatusOff);
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var
Directory : String;
begin
if SelectDirectory('Selección de Directorio para Monitoreo', 'C:\', Directory) then
begin
ListBox1.Clear;
DirectoryMonitor := TDirectoryMonitor.Create(True);
DirectoryMonitor.DirectoryToMonitor := Directory;
DirectoryMonitor.Resume;
BitBtn1.Enabled := False;
end
else
MessageDlg('No fue Seleccionado Ningún Directorio para Monitoreo', mtInformation, [mbOK],0);
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
if Assigned(DirectoryMonitor) then
begin
DirectoryMonitor.Terminate;
BitBtn1.Enabled := True;
end
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
label1.Font.Color := clRed;
Label1.Caption := 'Thread Off';
end;
end.
El código anterior permite
detectar cambios a nivel de Creación, Modificación y Eliminación de Archivos y Directorios dentro de un
Directorio específico (Directorio objetivo de Monitoreo) y sus subdirectorios por medio de la función
ReadDirectoryChangesW.
Este código fue probado en tres
Máquinas Virtuales con Windows XP Professional x32, Windows 7 Professional x32 y x64 y una
Máquina Física con Windows 7 Professional x32
y en todos los casos funcionó correctamente.
El código esta disponible en el siguiente link:
http://terawiki.clubdelphi.com/Delph...oryMonitor.rar
Nota: Una forma simple de probar el programa
es monitorear el directorio C:\
Revisa estos links:
Espero sea útil
Nelson.