Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2007.10.28;
Скачать: [xml.tar.bz2];

Вниз

Монитор каталогов+поток+имяфайла   Найти похожие ветки 

 
kukuikar ©   (2007-10-02 11:14) [0]

Добрый день всем.
С сайта http://delphiworld.narod.ru/ взял приложение монитор каталогов. Исходники здесь http://perepetsky.ru/mondir.zip

Приложение мониторит в потоке все изменения в заданном каталоге и при изменениях рапортует об этом. Только не говорит какой файл или каталог изменился. Помогите пожалуйста. Только это... Заранее спасибо всем за помощь...


 
clickmaker ©   (2007-10-02 11:16) [1]

ReadDirectoryChangesW
FILE_NOTIFY_INFORMATION.FileName


 
Anatoly Podgoretsky ©   (2007-10-02 12:02) [2]

> kukuikar  (02.10.2007 11:14:00)  [0]

Ты должен сам сравнивать старое состояние с новым


 
kukuikar ©   (2007-10-02 12:31) [3]

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ExtCtrls, StdCtrls;
type
 PFileNotifyInformation = ^TFileNotifyInformation;
 TFileNotifyInformation = record
   NextEntryOffset: DWORD;
   Action: DWORD;
   FileNameLength: DWORD;
   FileName: array [0..MAX_PATH - 1] of WideChar;
 end;
 
 TForm1 = class(TForm)
   Memo1: TMemo;
   Timer1: TTimer;
   procedure Timer1Timer(Sender: TObject);
   procedure FormCreate(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

const
 Filter =  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 or
           FILE_NOTIFY_CHANGE_LAST_ACCESS or
           FILE_NOTIFY_CHANGE_CREATION or
           FILE_NOTIFY_CHANGE_SECURITY;
var
 Dir: THandle;
 Notify: TFileNotifyInformation;
 BytesReturned: DWORD;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
ReadDirectoryChangesW(Dir, @Notify, SizeOf(TFileNotifyInformation), True, Filter, @BytesReturned, nil, nil);
     case Notify.Action of
       FILE_ACTION_ADDED: Memo1.Lines.Add("Новый" + Notify.FileName);
       FILE_ACTION_REMOVED: Memo1.Lines.Add("DУдаленный" + Notify.FileName);
       FILE_ACTION_MODIFIED: Memo1.Lines.Add("Измененный" + Notify.FileName);
       FILE_ACTION_RENAMED_OLD_NAME: Memo1.Lines.Add("Старое имя" + Notify.FileName);
       FILE_ACTION_RENAMED_NEW_NAME: Memo1.Lines.Add("Новое имя" + Notify.FileName);
     end;
Application.ProcessMessages;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Dir := CreateFile("D:\", GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE, nil, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
end;

end.


Перестает подавать признаки жизни.... Голову сломал...


 
clickmaker ©   (2007-10-02 12:38) [4]

TFileNotifyInformation = packed record
  NextEntryOffset: DWORD;
  Action: DWORD;
  FileNameLength: DWORD;
  FileName: array[0..0] of WideChar;
end;

и неплохо бы

Win32Check(ReadDirectoryChangesW


 
kukuikar ©   (2007-10-02 12:54) [5]


unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ExtCtrls, StdCtrls;
type
 PFileNotifyInformation = ^TFileNotifyInformation;
 TFileNotifyInformation = packed record
 NextEntryOffset: DWORD;
 Action: DWORD;
 FileNameLength: DWORD;
 FileName: array[0..0] of WideChar;
end;
.................

const
 Filter =  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 or
           FILE_NOTIFY_CHANGE_LAST_ACCESS or
           FILE_NOTIFY_CHANGE_CREATION or
           FILE_NOTIFY_CHANGE_SECURITY;
var
 Dir: THandle;
 Notify: TFileNotifyInformation;
 BytesReturned: DWORD;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
ReadDirectoryChangesW(Dir, @Notify, SizeOf(TFileNotifyInformation), True, Filter, @BytesReturned, nil, nil);
   if not ReadDirectoryChangesW(Dir, @Notify, SizeOf(TFileNotifyInformation), True, Filter, @BytesReturned, nil, nil) then
     raise Exception.Create(SysErrorMessage(GetLastError))
   else
     case Notify.Action of
       FILE_ACTION_ADDED: Memo1.Lines.Add("Íîâûé" + Notify.FileName);
       FILE_ACTION_REMOVED: Memo1.Lines.Add("Óäàëåííûé" + Notify.FileName);
       FILE_ACTION_MODIFIED: Memo1.Lines.Add("Èçìåíåííûé" + Notify.FileName);
       FILE_ACTION_RENAMED_OLD_NAME: Memo1.Lines.Add("Ñòàðîå èìÿ" + Notify.FileName);
       FILE_ACTION_RENAMED_NEW_NAME: Memo1.Lines.Add("Íîâîå èìÿ" + Notify.FileName);
     end;
Application.ProcessMessages;
end;

..........

end.



Без изменений, все по старому.


 
Сергей М. ©   (2007-10-02 12:55) [6]


> Application.ProcessMessages;


Это убирай нафих.

К чему вообще тут таймер ?

Задействуй асинхронный режим работы ReadDirectoryChangesW.
После обработки события изменения тут же вновь вызывай ReadDirectoryChangesW.


 
clickmaker ©   (2007-10-02 13:12) [7]

const
 BUFFER_SIZE = 2048;
var
 pNotify: PFileNotifyInformation;

pNotify:= AllocMem(BUFFER_SIZE);
Win32Check(ReadDirectoryChangesW(Dir, pNotify, BUFFER_SIZE, True, Filter, @BytesReturned, nil, nil));



Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2007.10.28;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.47 MB
Время: 0.048 c
15-1190719395
ja
2007-09-25 15:23
2007.10.28
вызываемый номер при создании подключения gprs beeline


6-1163412082
Alexey (AZ)
2006-11-13 13:01
2007.10.28
ServerSocket :: What are differents?


15-1190299649
Nikfel
2007-09-20 18:47
2007.10.28
Драйвер сотового MOTOROLA.


2-1191331842
_volodya
2007-10-02 17:30
2007.10.28
Массивы / TList


3-1182192180
Lavrenty
2007-06-18 22:43
2007.10.28
Не работает сообщение (из триггера)





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский