Ver Mensaje Individual
  #35  
Antiguo 27-03-2013
Avatar de nlsgarcia
[nlsgarcia] nlsgarcia is offline
Miembro Premium
 
Registrado: feb 2007
Ubicación: Caracas, Venezuela
Posts: 2.206
Reputación: 21
nlsgarcia Tiene un aura espectacularnlsgarcia Tiene un aura espectacular
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
    { Private declarations }
  public
    { Public declarations }
  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:
Cita:
1- ReadDirectoryChangesW function : http://msdn.microsoft.com/en-us/libr...=vs.85%29.aspx

2- WaitForMultipleObjects function : http://msdn.microsoft.com/en-us/libr...=vs.85%29.aspx

3- CreateFile function : http://msdn.microsoft.com/en-us/libr...=vs.85%29.aspx
Espero sea útil

Nelson.

Última edición por nlsgarcia fecha: 27-03-2013 a las 04:08:25.
Responder Con Cita