VPF::Мониторинг папки через таймер

Dobermann

Дата 31.7.2009, 23:40 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 992
Регистрация: 7.1.2008

Репутация: нет
Всего: 0

Кто-нибудь может показать пример как по таймеру (к примеру 20 сек) мониторить определенную папку на наличие новых файлов, и если новый файл появился, то тут же ее в этой папке заархивировать...
Сорри...от делфи я далек...но очень нужно...с меня +++ smile

Keeper89

Дата 31.7.2009, 23:48 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: 20
Всего: 58

Не нужно использовать для этого таймер, правильнее воспользоваться одним из следующих компонентов: http://www.torry.net/pages.php?id=252

--------------------

Cogito, ergo sum

Keeper's blog
CnWizards Downloads

user posted image

Dobermann

Дата 1.8.2009, 00:10 (ссылка)

(голосов:1)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 992
Регистрация: 7.1.2008

Репутация: нет
Всего: 0

Что мне эти компоненты?!! Я CoolTrayIcon пол дня ставил, остальные пол дня искал код чтобы прогу в трей спрятать! Говорю же не шарю я в делфи!
Мне пример нужен, а не ссылка! Я и так уже пол гугла переконапатил!
Пытался сделать через FindFirst - не получилось... Как можно реализовать мою задачу хотя бы стандартными компонентами?!

Добавлено через 3 минуты и 15 секунд
Папка локальная...после архивирования файл надо удалить, но это я уже сделал:

Код


ShellExecute(Application.Handle, nil, pchar('winrar'), pchar('a c:\'+sl+' c:\'+ss), nil, sw_hide);

Код


DeleteFile('c:\'+ss);

Так как папку мониторить то???

Keeper89

Дата 1.8.2009, 00:32 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: 20
Всего: 58

Вот готовые примеры: http://forum.sources.ru/index.php?showtopic=96280 - один для таймера, другой без него.

--------------------

Cogito, ergo sum

Keeper's blog
CnWizards Downloads

user posted image

Dobermann

Дата 1.8.2009, 00:37 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 992
Регистрация: 7.1.2008

Репутация: нет
Всего: 0

Слушай, а ты бы тогда не мог сделать небольшие комменты к строчкам кода чтобы я хоть чуть-чуть понял где-о чем говорится:

Код


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;
    procedure FormCreate(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
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;
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);
  if Dir <> INVALID_HANDLE_VALUE then
  try
    if not ReadDirectoryChangesW(Dir, @Notify, SizeOf(TFileNotifyInformation),
      False, Filter, @BytesReturned, nil, nil) then
      raise Exception.Create(SysErrorMessage(GetLastError))
    else
      case Notify.Action of
        FILE_ACTION_ADDED: ShowMessage('New file' + Notify.FileName);
        FILE_ACTION_REMOVED: ShowMessage('Delete file' + Notify.FileName);
        FILE_ACTION_MODIFIED: ShowMessage('Modify file' + Notify.FileName);
        FILE_ACTION_RENAMED_OLD_NAME: ShowMessage('Old Name file' + Notify.FileName);
        FILE_ACTION_RENAMED_NEW_NAME: ShowMessage('New Name file' + Notify.FileName);
      end;
  finally
    CloseHandle(Dir);
  end;
end;

Добавлено через 2 минуты и 16 секунд
Надеюсь у меня хотя бы получится все это в свой код воткнуть smile

Keeper89

Дата 1.8.2009, 00:49 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: 20
Всего: 58

Только по основному коду:

Код


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;
    procedure FormCreate(Sender: TObject);
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
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;
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);
  // Проверка на ошибки
  if Dir <> INVALID_HANDLE_VALUE then
  try
    // Теперь мы будем ждать пока чего-нибудь в выбранном каталоге
    // изменится или произойдет ошибка
    // Filter - это список флагов, наша константа
    if not ReadDirectoryChangesW(Dir, @Notify, SizeOf(TFileNotifyInformation),
      False, Filter, @BytesReturned, nil, nil) then
      raise Exception.Create(SysErrorMessage(GetLastError))
    else
      // Определяем тип события и выводим соответствующее сообщение
      case Notify.Action of
        FILE_ACTION_ADDED: ShowMessage('New file' + Notify.FileName);
        FILE_ACTION_REMOVED: ShowMessage('Delete file' + Notify.FileName);
        FILE_ACTION_MODIFIED: ShowMessage('Modify file' + Notify.FileName);
        FILE_ACTION_RENAMED_OLD_NAME: ShowMessage('Old Name file' + Notify.FileName);
        FILE_ACTION_RENAMED_NEW_NAME: ShowMessage('New Name file' + Notify.FileName);
      end;
  finally
    CloseHandle(Dir);
  end;
end;

--------------------

Cogito, ergo sum

Keeper's blog
CnWizards Downloads

user posted image

Данкинг

Дата 1.8.2009, 01:48 (ссылка)

(нет голосов)

Загрузка ...

Yersinia pestis

Профиль
Группа: Завсегдатай
Сообщений: 8302
Регистрация: 7.11.2006
Где: მოსკოვი

Репутация: 9
Всего: 130

Цитата(Dobermann @ 1.8.2009, 01:10

)

Я CoolTrayIcon пол дня ставил

Цитата(Dobermann @ 1.8.2009, 01:10

)

Говорю же не шарю я в делфи!

А зачем пишешь на Дельфи, а не на том языке, который знаешь?

Более по теме: мне представляется FileListBox, по которому мы проходим, и если видим, что расширение данного файла не .RAR (или какой там архив нужен), то тут же его, родимого, и архивируем. smile

--------------------

There's nothing left but silent epitaphs.

VanHelsing

Дата 1.8.2009, 06:23 (ссылка)

(нет голосов)

Загрузка ...

ХОЧУ ВСЕ ЗНАТЬ!!!

Награды: 1

Профиль
Группа: Участник
Сообщений: 288
Регистрация: 3.1.2008
Где: Екатеринбург

Репутация: 1
Всего: 6

Проверять добавились ли в папку новые файлы можно просто подсчитывая их количество:

Код


Function GetFileCount(Dir:string):integer;    
var fs:TSearchRec;   
begin  
  Result:=0;   
  if FindFirst(Dir+'\*.htm',faAnyFile-faDirectory-faVolumeID, fs)=0 then  
    repeat  
      inc(Result);   
    until FindNext(fs)<>0;   
  FindClose(fs);   
end;

--------------------

Мой блог.
Specialist

Dobermann

Дата 1.8.2009, 17:58 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 992
Регистрация: 7.1.2008

Репутация: нет
Всего: 0

Цитата(Данкинг @ 1.8.2009, 02:48

)

А зачем пишешь на Дельфи, а не на том языке, который знаешь?

Да меня на практику сунули по делфи...вот и горбачусь...отчет защищать придется ведь =(

Dobermann

Дата 1.8.2009, 20:58 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 992
Регистрация: 7.1.2008

Репутация: нет
Всего: 0

Цитата(VanHelsing @ 1.8.2009, 07:23)

Проверять добавились ли в папку новые файлы можно просто подсчитывая их количество:

Код


Function GetFileCount(Dir:string):integer;    
var fs:TSearchRec;   
begin  
  Result:=0;   
  if FindFirst(Dir+'\*.htm',faAnyFile-faDirectory-faVolumeID, fs)=0 then  
    repeat  
      inc(Result);   
    until FindNext(fs)<>0;   
  FindClose(fs);   
end;

А как выдирать имена файлов (чтобы архивировать)?

Keeper89

Дата 1.8.2009, 21:16 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: 20
Всего: 58

fs.Name будет имя файла.

--------------------

Cogito, ergo sum

Keeper's blog
CnWizards Downloads

user posted image

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »