Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Общие вопросы > Получение уведомления о изменениях


Автор: Гость_Борис 25.8.2004, 14:54
Требуется, чтобы программа получала уведомления о изменениях в файловой системе. Каким способом это можно реализовать?

Автор: Pakshin A. S. 25.8.2004, 22:19
Ох... интересная тема! Когда-то поднимал эту тему, поищи, если не лень.

Автор: Slawanix 27.8.2004, 22:22
Попробуй так (при условии, что ты умеешь обращаться с потоками TThread).
Для организации мониторинга файловой системы нужно использовать три функции — FindFirstChangeNotification, FindNextChangeNotification И FindcioseChangeNotification. Первая из них возвращает дескриптор объекта файлового оповещения, который можно передать в функцию ожидания. Объект активизируется тогда, когда в заданной папке произошли те или иные изменения (создание или уничтожение файла или папки, изменение прав доступа и т. д.). Вторая — готовит объект к реакции на следующее изменение. Наконец, с помощью третьей функции следует закрыть ставший ненужным объект.

Так может выглядеть код метода Execute потока, созданного для мониторинга:

Код

var DirName : string;
procedure TSimpleThread.Execute;
var r: Cardinal;
fn : THandle;
begin
fn := FindFirstChangeNotification(pChar(DirName),
True,FILE_NOTIFY_CHANGE_FILE_NAME);
repeat r := WaitForSingleObject(fn,2000);
if r = WAIT_OBJECT_0 then Forml.UpdateList;
if not FindNextChangeNotification (fn) then break;
until Terminated;
FindCloseChangeNotification(fn);
end;


На главной форме должны находиться компоненты, нужные для выбора обследуемой папки, а также компонент TListBox, в который будут записываться имена файлов:

Код

procedure TFormI.ButtonlClick(Sender:TObject);
var dir : string;
begin
if SelectDirectory(dir,[],0) then begin Editl.Text := dir;
DirName := dir;
end;
end;

procedure TFormI.UpdateList;
var SearchRec: TSearchRec;
begin
ListBoxl.Clear;
FindFirst(Editl.Text+'\\*.*', faAnyFile, SearchRec);
repeat ListBoxl.Items.Add(SearchRec.Name);
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;

Приложение готово. Чтобы оно стало полнофункциональным, предусмотрите в нем механизм перезапуска потока при изменении обследуемой папки.

Автор: Illusion Dolphin 29.8.2004, 11:49
Я с этим намучался сполна и теперь скажу своё слово...
Метод, предложенный Slawanix имеет один ооочень существенный недостаток в случае, если пишется не просто список plug-in'ов, который будет обонвляться при записи нового plug-in'а, а если, как в моём случае, пишется достаточно полноценный проводник. Тогда нелепо из-за переименовании одного файла перегружать все файлы, т.к. это очень медленно.

В этом случае известно не только что что-то изменилось, а что именно изменилось. В своей форма нужно определить процедуру с параметрами как у TNotifyDirectoryChangeW и при вызове нити вызывать её в параметрах. В самой процедуре обрабатывать те данные, которые пришли из потока. При удалении, создании, изменении выдаётся одно имя файла. При переименовании сначала идёт старое имя, потом новое.

Я это делал так (там можно некоторое выкинуть, я долго мудрил со всем этим...):
Некоторый необходимые типы:

Код

type
  _FILE_NOTIFY_INFORMATION = record
  NextEntryOffset : DWORD;
  Action: DWORD;
  FileNameLength: DWORD;
  Filename : array[0..0] of WideChar;
end;

PFileNotifyInformation = ^_FILE_NOTIFY_INFORMATION;

Type
 TNotifyDirectoryChangeW = Procedure(Sender : TObject; SID : string; OldFileName: TArStrings; NewFileName : String; Action : TArInteger) of Object;

TArStrings = array of string;

type
 TExplorerThreadNotifyDirectoryChange = class(TThread)
 private
  FSID : String;
  FDirectory : String;
  FParentSID : Pointer;
  FOnNotifyFile : TNotifyDirectoryChangeW;
  Terminating : Boolean;
  FOldFileName : TArStrings;
  FNewFileName : String;
  FAction : TArInteger;
  protected
   procedure Execute; override;
   procedure NotifyFile;
 public
     constructor Create(CreateSuspennded: Boolean; Directory : string; OnNotify : TNotifyDirectoryChangeW; SID : string; ParentSID : Pointer);
 end;


и сам код потока:

Код

constructor TExplorerThreadNotifyDirectoryChange.Create(CreateSuspennded: Boolean;
 Directory: string; OnNotify: TNotifyDirectoryChangeW; SID: string; ParentSID : Pointer);
begin
Inherited Create(True);
fOnNotifyFile := OnNotify;
fDirectory := Directory;
FormatDir(fDirectory);
fSID := SID;
FParentSID := ParentSID;
Terminating := false;
IF not CreateSuspennded Then Resume;
end;

procedure TExplorerThreadNotifyDirectoryChange.Execute;
var
hDir : THandle;
lpBuf : Pointer;
Ptr   : Pointer;
cbReturn : Cardinal;
FileName : PWideChar;
SFileName : String;

Function FileInDir(Directory, FileName : String) : Boolean;
begin
 FormatDir(Directory);
 UnFormatDir(FileName);
 FileName:=GetDirectory(FileName);
 if AnsiLowerCase(FileName)=AnsiLowerCase(Directory) then
 result:=true else Result:=false;
end;

Const
BUF_SIZE = 65535;
begin
inherited;
FreeOnTerminate:=true;
fNewFileName:='';
hDir := CreateFile (Pchar(FDirectory),GENERIC_READ,FILE_SHARE_READ or FILE_SHARE_WRITE
or FILE_SHARE_DELETE,nil,OPEN_EXISTING,FILE_FLAG_BACKUP_SEMANTICS,0);
if hDir = INVALID_HANDLE_VALUE then exit;
GetMem(lpBuf,BUF_SIZE);
repeat
 SetLength(fOldFileName,0);
 SetLength(FAction,0);
 If Terminating then break;
 ZeroMemory(lpBuf,BUF_SIZE);
 if not ReadDirectoryChangesW(hDir,lpBuf,BUF_SIZE,false,FILE_NOTIFY_CHANGE_FILE_NAME+FILE_NOTIFY_CHANGE_DIR_NAME +FILE_NOTIFY_CHANGE_CREATION,@cbReturn,nil,nil) then Break;
 Ptr:=lpBuf;
 repeat
  GetMem(FileName,PFileNotifyInformation(Ptr).FileNameLength+2);
  ZeroMemory(FileName,PFileNotifyInformation(Ptr).FileNameLength+2);
  lstrcpynW(FileName,PFileNotifyInformation(Ptr).FileName, PFileNotifyInformation(Ptr).FileNameLength div 2+1);

  case PFileNotifyInformation(Ptr).Action of
    FILE_ACTION_ADDED,FILE_ACTION_REMOVED,FILE_ACTION_MODIFIED,FILE_ACTION_RENAMED_OLD_NAME:
     begin
      SetLength(fOldFileName,Length(fOldFileName)+1);
      fOldFileName[Length(fOldFileName)-1]:= fDirectory+FileName;//WideCharLenToString(FileName,PFileNotifyInformation(Ptr).FileNameLength div 2);
      SetLength(FAction,Length(FAction)+1);
      FAction[Length(FAction)-1]:= PFileNotifyInformation(Ptr).Action;
     end;

    FILE_ACTION_RENAMED_NEW_NAME:
     begin

       SetLength(fOldFileName,Length(fOldFileName)+1);
       fOldFileName[Length(fOldFileName)-1]:= fDirectory+FileName;//WideCharLenToString(FileName,PFileNotifyInformation(Ptr).FileNameLength div 2);

       fNewFileName := fDirectory+FileName;
       SetLength(FAction,Length(FAction)+1);
       FAction[Length(FAction)-1]:=PFileNotifyInformation(Ptr).Action;
     end;
  end;

  FreeMem(FileName);

  if PFileNotifyInformation(Ptr).NextEntryOffset=0  then Break
  else Inc(Cardinal(Ptr),PFileNotifyInformation(Ptr).NextEntryOffset);

 until false;

 Synchronize(NotifyFile);
until false;
FreeMem(lpBuf);
end;

procedure TExplorerThreadNotifyDirectoryChange.NotifyFile;
Var
 S : String;
 Name : String;
begin
S:=String(fParentSID^);
If S <> fSID then
Terminating:=true else
If Assigned(FOnNotifyFile) then FOnNotifyFile(self,FSID,fOldFileName,fNewFileName,FAction);
SetLength(fOldFileName,0);
SetLength(FAction,0);
end;


В самой форме где-то так:

Код

Procedure TExplorerForm.DirectoryChanged(Sender : TObject; SID : string; OldFileName: TArStrings; NewFileName : String; Action : TArInteger);
Var
 i, k: Integer;
 FileName, FOldFileName : String;
begin
For k:=0 to length(OldFileName)-1 do
Case Action[k] of
FILE_ACTION_ADDED:
 begin

  end;
FILE_ACTION_REMOVED:
 begin

  end;
FILE_ACTION_MODIFIED:
 begin

 end;
FILE_ACTION_RENAMED_NEW_NAME:
 begin
 end;
end;  
end;


Если что-то непонятно или я не всё дал (это вырезка из огромного исходника) или дал лишнее - спрашивайте, поправлюсь.
Добавлено @ 11:52
Да, ещё о параметре SID, который у меня объявлен. В самой форме необходимо сделать строковую константу, куда заноситьслучайную строку (с достаточной степенью уникальности) и при изменении текущей директории менять эту строковую константу, а в нить кидать указатель на эту строку.

Автор: Slawanix 29.8.2004, 14:13
Цитата
Метод, предложенный Slawanix имеет один ооочень существенный недостаток

Привет, Illusion Dolphin, просто этот метод был призван более-менее продемонстрировать
работу функций, и конечно, полноценной ее не назовешь. smile.gif
С уважением, Slawanix.

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)