Процедура вычисления размера каталога

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Panov

WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****

>> Процедура вычисления размера каталога

Вычисляет размер файлов в каталоге и подкаталогах,

использую функции FindFirst/FindNext/FindClose

Зависимости: Masks;

Автор: panov, panov@hotbox.ru

Copyright: Нет

Дата: 30 марта 2004 г.

***************************************************** }

procedure GetDirSize(const aPath: string; var SizeDir: Int64);

var

SR: TSearchRec;

tPath: string;

begin

tPath := IncludeTrailingBackSlash(aPath);

if FindFirst(tPath ‘*.*’, faAnyFile, SR) = 0 then

begin

try

repeat

if (SR.Name = ‘.’) or (SR.Name = ‘..’) then

Continue;

if (SR.Attr and faDirectory) 0 then

begin

GetDirSize(tPath SR.Name, SizeDir);

Continue;

end;

SizeDir := SizeDir

(SR.FindData.nFileSizeHigh shl 32)

SR.FindData.nFileSizeLow;

until FindNext(SR) 0;

finally

Sysutils.FindClose(SR);

end;

end;

end;

Пример использования:

procedure TForm1.Button1Click(Sender: TObject);

var

SizeDir: Int64;

begin

SizeDir := 0;

GetDirSize(‘c:\winnt’, SizeDir);

ShowMessage(‘Размер каталога ‘ IntToStr(SizeDir));

end;

{/codecitation}

Проверить, расшарена ли папка

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: DeeCo

Автор: http://www.swissdelphicenter.ch

{Following code needs to use ShlObj, ComObj, ActiveX Units}

function TForm1.IfFolderShared(FullFolderPath: string): Boolean;

//Convert TStrRet to string

function StrRetToString(PIDL: PItemIDList; StrRet: TStrRet; Flag: string = »): string;

var

P: PChar;

begin

case StrRet.uType of

STRRET_CSTR:

SetString(Result, StrRet.cStr, lStrLen(StrRet.cStr));

STRRET_OFFSET:

begin

P := @PIDL.mkid.abID[StrRet.uOffset — SizeOf(PIDL.mkid.cb)];

SetString(Result, P, PIDL.mkid.cb — StrRet.uOffset);

end;

STRRET_WSTR:

if Assigned(StrRet.pOleStr) then

Result := StrRet.pOleStr

else

Result := »;

end;

{ This is a hack bug fix to get around Windows Shell Controls returning

spurious «?»s in date/time detail fields }

if (Length(Result) > 1) and (Result[1] = ‘?’) and (Result[2] in [‘0’..’9′]) then

Result := StringReplace(Result, ‘?’, », [rfReplaceAll]);

end;

//Get Desktop’s IShellFolder interface

function DesktopShellFolder: IShellFolder;

begin

OleCheck(SHGetDesktopFolder(Result));

end;

//delete the first ID from IDList

function NextPIDL(IDList: PItemIDList): PItemIDList;

begin

Result := IDList;

Inc(PChar(Result), IDList^.mkid.cb);

end;

//get the length of IDList

function GetPIDLSize(IDList: PItemIDList): Integer;

begin

Result := 0;

if Assigned(IDList) then

begin

Result := SizeOf(IDList^.mkid.cb);

while IDList^.mkid.cb 0 do

begin

Result := Result IDList^.mkid.cb;

IDList := NextPIDL(IDList);

end;

end;

end;

//get ID count from IDList

function GetItemCount(IDList: PItemIDList): Integer;

begin

Result := 0;

while IDList^.mkid.cb 0 do

begin

Inc(Result);

IDList := NextPIDL(IDList);

end;

end;

//create an ItemIDList object

function CreatePIDL(Size: Integer): PItemIDList;

var

Malloc: IMalloc;

begin

OleCheck(SHGetMalloc(Malloc));

Result := Malloc.Alloc(Size);

if Assigned(Result) then

FillChar(Result^, Size, 0);

end;

function CopyPIDL(IDList: PItemIDList): PItemIDList;

var

Size: Integer;

begin

Size := GetPIDLSize(IDList);

Result := CreatePIDL(Size);

if Assigned(Result) then

CopyMemory(Result, IDList, Size);

end;

//get the last ItemID from AbsoluteID

function RelativeFromAbsolute(AbsoluteID: PItemIDList): PItemIDList;

begin

Result := AbsoluteID;

while GetItemCount(Result) > 1 do

Result := NextPIDL(Result);

Result := CopyPIDL(Result);

end;

//remove the last ID from IDList

procedure StripLastID(IDList: PItemIDList);

var

MarkerID: PItemIDList;

begin

MarkerID := IDList;

if Assigned(IDList) then

begin

while IDList.mkid.cb 0 do

begin

MarkerID := IDList;

IDList := NextPIDL(IDList);

end;

MarkerID.mkid.cb := 0;

end;

end;

//if Flag include Element

function IsElement(Element, Flag: Integer): Boolean;

begin

Result := Element and Flag 0;

end;

var

P: Pointer;

NumChars, Flags: LongWord;

ID, NewPIDL, ParentPIDL: PItemIDList;

ParentShellFolder: IShellFolder;

begin

Result := False;

NumChars := Length(FullFolderPath);

P := StringToOleStr(FullFolderPath);

//get the folder’s full ItemIDList

OleCheck(DesktopShellFolder.ParseDisplayName(0, nil, P, NumChars, NewPIDL, Flags));

if NewPIDL nil then

begin

ParentPIDL := CopyPIDL(NewPIDL);

StripLastID(ParentPIDL); //get the folder’s parent object’s ItemIDList

ID := RelativeFromAbsolute(NewPIDL); //get the folder’s relative ItemIDList

//get the folder’s parent object’s IShellFolder interface

OleCheck(DesktopShellFolder.BindToObject(ParentPIDL, nil, IID_IShellFolder,

Pointer(ParentShellFolder)));

if ParentShellFolder nil then

begin

Flags := SFGAO_SHARE;

//get the folder’s attributes

OleCheck(ParentShellFolder.GetAttributesOf(1, ID, Flags));

if IsElement(SFGAO_SHARE, Flags) then Result := True;

end;

end;

end;

{How to use the function?

The parameter in is the full path of a folder}

procedure TForm1.Button1Click(Sender: TObject);

begin

if IfFolderShared(‘C:\My Documents\WinPopup’) then ShowMessage(‘shared’)

else

ShowMessage(‘not shared’);

end;

{/codecitation}

Приложение Монитор каталогов

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Александр Панов

Сидит мужик за компом. Вдруг разбивает окно камень обернутый бумажкой, пролетает по комнате, попадает в монитор, монитор вдребезги. Мужик берет камень разворачивает бумажку, видит объявление: «Продам новый монитор!»

Часть 1. (создаем класс – потомок TThread)

1. Введение.

Уважаемые программисты!

Для начала хочу выразить искреннюю благодарность создателю замечательного сайта в интернете “Мастера DELPHI” (http://delphi.mastak.ru/), конференции для программистов — Алексею (Merlin). Я думаю, что со мной согласятся многие, если скажу, что конференции помогли и помогают многим программистам в их нелегком труде. До сих пор не встречал такого живого форума и такой атмосферы взаимопомощи на просторах интернета. Конференции стали неплохим подспорьем программистам в их деятельности. Постоянно посещая форум, я заметил, что некоторые вопросы довольно часто повторяются. Желание помочь коллегам и позволило появиться в свет этой статье. Надеюсь, что некоторые приемы, описанные ниже, будут полезны и профессионалам. Версии Windows ниже 98 безвозвратно уходят в прошлое, поэтому особенности программирования для них мы рассматривать не будем. Так как некоторые приемы, описанные в статье, в разных версиях Windows могут существенно отличаться, в некоторых случаях мы рассмотрим альтернативные решения. Здесь я не касаюсь осо

бенностей программирования в Delphi6, так как до сих пор у меня не было возможности опробовать эту систему.В первой статье цикла хочу на примере программы «Монитор каталогов» показать приемы работы с файлами (поиск/чтение/запись) и потоками (TThread). Эта статья ни в коем случае не претендует на исключительность и «истину в последней инстанции». В статье я не буду придерживаться предельной точности в определении терминов, а сделаю упор на «понятность» изложения материала. Как мне кажется, для начинающих программистов, более важно ухватить сначала суть, и лишь затем углубляться во внутренности процессов, проходящих внутри Windows. Я буду благодарен всем, кто пришлет отзывы, замечания и пожелания по материалам статьи, сообщения о найденных в ней ошибках, а также алгоритмы и другие реализации решений, отличные от тех, что описаны на этих страницах по адресу panov@hotbox.ru. Благодарю за ценные замечания и предложения при подготовке статьи:

Ю. Зотова,

Голованова Михайла aka Mike Goblin.

Особая благодарность – Петрову Алексею за консультации по тонкостям работы с потоками.

При подготовке к статье использовались следующие источники:

Конференции и статьи сайта «Мастера DELPHI» (http://delphi.mastak.ru/)

Конференции сайта «Королевство дельфи» (http://delphi.vitpc.com/)

Windows SDK

А теперь приступим к практическим занятиям.

Приложение «Монитор каталогов»

2. Создаем основную форму и наводим на ней красоту.

Давайте вместе создадим программу, которая будет непрерывно проверять каталог на предмет изменения содержимого (появление нового файла, удаление файла, переименование и изменение файла).

Добавим в нашу программу возможность ведения протокола изменений в проверяемом каталоге и функции динамической настройки этого списка.

После написания программы добавим еще одно “ удобное” свойство – спрячем программу в SysTray (для тех, кто не знает – это место на панели задач справа рядом с часами).

Введем также еще условие: программа не должна блокировать работу с основной формой. Для этого будем использовать класс TThread.

Здесь я сделаю небольшое отступление, и кратко расскажу, что такое «Процесс», «поток», и зачем они нужны.

Рекомендую также почитать статью Подмогова Михаила, расположенную по адресу (http://delphi.mastak.ru/articles/winexec/index.html) и статью Николая Кариха (http://delphi.mastak.ru/articles/thread/index.html)

Процессом в Windows называется любое выполняющееся приложение. Каждый процесс имеет свой уникальный идентификатор – целое число, назначаемое операционной системой при создании процесса. Поток – это последовательность машинных команд, которые выполняются процессором (часто потоки называют «нитями»). При запуске программы в Windows создается процесс, в котором описано, чем владеет этот процесс, и первичный или основной (главный) поток, в котором начинается выполнение программы. Важное свойство процесса – для него может быть создано несколько потоков, причем выполнение каждого потока может, как зависеть, так и не зависеть от выполнения других потоков. Для однопроцессорных систем справедливо также следующее: — в каждый момент времени выполняется, только один поток, поскольку для выполнения любой команды требуется занять время процессора. Но операционная система выделяет каждому потоку по очереди промежуток времени (называется он «квант времени») для выполнения, причем этот квант времени очень мал. Поэтому создае

тся впечатление, что все задачи в системе выполняются одновременно.

Учитывая это, будет естественно применить возможности потоков в нашей программе. В Delphi работы с потоками предусмотрен специальный класс – TThread, о методах и свойствах которого я расскажу немного позже. Теперь приступим к созданию приложения.

2.1. Начало.

Откроем новый проект, поменяем имя формы c Form1 на fMonDirMain, заголовок формы на «Сканер каталогов».

Сохраним проект в отдельном каталоге, при сохранении назовем Unit с формой ufMain, а проект – MonDir.

Устанавливаем свойства для формы fMonDirMain:

Width – 600

Height – 400

Position — poScreenCenter

Далее добавим на форму следующие объекты:

TMainMenu (имя mm),

TStatusBar (имя sbMain),

TTimer (имя tmDate),

TListBox (имя lbLog).

Выбрав sbMain, в инспекторе объектов отредактируем список панелей (Panels).

Добавим в список 3 панели.

для первой панели выбираем ширину (поле Width) 110,

для второй панели выбираем ширину 150.

Панели будем использовать для отображения текущего времени и состояния сканера («Активен»/«Отключен»).

Для lbLog устанавливаем свойство Align в alClient.

Для tmTimer определяем процедуру обработки события OnTimer

procedure TfMonDirMain.tmDateTimer(Sender: TObject);

begin

// На первой панели отображаем текущие дату и время

sbMain.Panels[0].Text := FormatDateTime(‘dd.mm.yyyy hh.nn.ss’,now);

end;

и устанавливаем свойство Interval в 1000 мс (1 секунда), а Enabled в True.

Для формы создадим процедуру обработки события OnCreate:

procedure TfMonDirMain.FormCreate(Sender: TObject);

begin

// Обновляем панели статуса.

tmDateTimer(Self);

sbMain.Panels[1].Text := ‘Отключен’;

// Здесь добавим заголовок для нашего приложения.

Application.Title := ‘Монитор каталогов’;

// Такой заголовок будет у свернутого на панель задач (TaskBar) нашего приложения.

// На самом деле заголовок приложения можно указать сразу при разработке приложения.

// Для этого откройте в меню DelphiaProjectaOptions и на закладке Application

// исправьте поле Title

end;

Обратите внимание на строку tmDateTimer(Self). Процедуру обработки события OnTimer при создании формы мы вызываем для того, чтобы на панели статуса сразу же отобразились бы текущие дата и время. Если этот код не выполнить при создании формы, то при ее появлении на экране дата и время начнут отображаться только через одну секунду.

Дважды кликнув на значок TMainMenu, отредактируем наше меню.

Добавим 2 пункта: “Монитор” и “Выход”:

“Выход” – для освобождения ресурсов и выхода из программы.

В пункт меню «Монитор» добавим:

“Старт” – запуск потока для сканирования.

“Стоп” – остановка потока.

Назовем созданные пункты меню:

для “Старт” – mmStart,

для “Стоп” – mmStop,

для “Выход” – mmExit;

Свойство пункта Enabled для меню “Стоп” установим в False.

Создадим для меню “Выход” процедуру – обработчик, в коде напишем:

procedure TfMonDirMain.mmExitClick(Sender: TObject);

begin

Close;

end;

“Каркас” нашей программы готов.

2.2. Создание класса для обработки изменений каталога.

В Delphi работа с потоками инкапсулирована в класс TThread, с помощью которого и ведется вся работа в потоках.

Предлагаю Вашему вниманию краткий обзор свойств и методов класса TThread.

Свойство/ Метод/ Событие Тип Описание Значения

FreeOnTerminateBooleanСвойство, определяющее, вызывается ли процедура уничтожения потока (destructor) автоматически по окончании выполнения процедуры Execute, или нет.True: деструктор потока вызывается автоматически.

False: для вызова деструктора и уничтожения потока необходимо воспользоваться методом Terminate.

Handle, ThreadIdTHandleИдентификатор потока, используется различными функциями Windows API.Целое число. Назначается операционной системой.

Priority

TThreadPriorityПриоритет потока. Используется для указания, насколько выше/ниже приоритет потока относительно основного (главного) потока.tpIdle – поток работает в то время, когда процессор не занят выполнением других задач. (Наинизший приоритет из возможных)

tpLowest — поток имеет приоритет на 2 пункта ниже нормального tpNormal. (Очень низкий приоритет)

tpLower — поток имеет приоритет на 1 пункт ниже нормального tpNormal. (Низкий приоритет)

tpNormal – приоритет по умолчанию. Используемый большинством потоков операционной системы. (Нормальный приоритет)

tpHigher — поток имеет приоритет на 1 пункт выше нормального tpNormal. (Высокий приоритет)

tpHighest — поток имеет приоритет на 2 пункта выше нормального tpNormal. (Очень высокий приоритет)

tpTimeCritical – поток работает в режиме реального времени. Необходимо пользоваться с большой осторожностью, так как поток займет все время процессора. (Наивысший приоритет из возможных)

ReturnValueIntegerЗначение, которое возвращает поток при своем завершении.Значение ReturnValue можно получить при использованиии метода WaitFor.

SuspendedBooleanСвойство, показывающее, в каком состоянии находится поток.

Поток может находиться в двух состояниях:

— активный

— приостановлен

В приостановленном состоянии поток не выполняет никакой работы.

Для завершения потока, который находится в состоянии «приостановлен» необходимо сначала выдать для него команду ResumeTrue — поток находится в приостановленном состоянии

False – поток находится в активном состоянии

TerminatedBooleanСвойство показывает, получена ли потоком команда на завершение Terminate.True – получена команда Terminate завершить работу.

False – команда Terminate не получена.

OnTerminateсобытиеСобытие, возникающее после окончания работы процедуры Execute, но до вызова деструктора потока.

CreateМетодКонструктор потока.

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

DestroyМетодДеструктор потока. Вызывается при завершении выполнения потока автоматически.

Примечание: Destroy

будет вызван автоматически если

FreeOnTerminate = True

и

Suspended = False

DoTerminateМетодГенерирует событие OnTerminate. Выполняется код из процедуры-обработчика события OnTerminate, но не вызывает завершения потока.

ExecuteМетодВыполняется после создания потока конструктором Create. Начинает работу немедленно после Create, если поток создан с опцией CreateSuspended = False

ResumeМетодЗаставляет приостановленный поток продолжить работу.

SuspendМетодПриостанавливает работу потока.

SynchronizeМетодВыполняет процедуру, определенную пользователем как метод потока. Используется для выполнения кода процедуры, определенной пользователем, в основном потоке.

TerminateМетодВызывается для завершения потока.

WaitForМетодИспользуется для получения значения, которое возвращает поток после своего завершения. Вызывается в основном потоке.

Поясню некоторые методы и свойства подробнее.

Create

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

Например:

type

MyThread := class(TThread)

private

FFirstPar: String;

FNextPar: String;

FCounter: Integer;

public

constructor Create(const FirstParameter, NextParameter: String);

end;

А при реализации конструктора можно использовать эти параметры:

constructor Create(const FirstParameter, NextParameter: String);

begin

inherited Create(True); // Вызов конструктора родительского класса

FFirstPar := FirstParameter; // Инициализация параметров

FNextPar := NextParameter;

FCounter := 0;

Resume; // Переводим поток в состояние «Активный»

// Далее в процедуре Execute используем эти полученные параметры.

end;

Обратите внимание на выделенные строки:

inherited Create(True);

В этой строке вызывается конструктор родительского класса TThread.

Внимание! После выполнения этой строки немедленно начнет выполняться метод Execute, если поток создать с флагом CreateSuspended = False. Поэтому, если Вы хотите инициализировать здесь переменные, которые будут использоваться в Execute, используйте конструкцию, приведенную выше.

Execute.

В Execute должен выполняться весь код, который должен выполняться «параллельно» основному потоку. Как правило, если поток предназначен для выполнения многократно повторяющегося кода (цикла), то в Execute используется конструкция следующего вида:

while not Terminated do

begin

// В этом месте выполняется весь необходимый код.

// Если здесь необходимо обновлять некоторые данные в основном потоке,

// то здесь используйте метод Synchronize.

Synchronize(MyUpdateProcedure);

// Процедуру MyUpdateProcedure определяем в описании нашего класса.

end;

Synchronize

Так как процедура, вызываемая в методе Synchronize выполняется в основном потоке, то на время выполнения Synchronize главная форма будет блокирована для ввода, обновления информации, как это происходит при длительных операциях в основном потоке.

Поэтому этот метод надо вызывать по возможности реже.

Простейший пример таймера:

procedure MyThread.MyUpdateProcedure;

begin

FormMain.LabelCounter.Caption := IntToStr(FCounter);

end;

procedure MyThread.Execute;

begin

while not Terminated do

begin

Inc(FCounter);

Synchronize(MyUpdateProcedure);

Sleep(1000);

end;

end;

Если Вам необходимо из потока обновлять переменные и объекты, которые используются вне этого потока, всегда пользуйтесь методом Synchronize. Результат обновления прямо из Execute или других процедур, определенных в потоке, может быть непредсказуемым, вплоть до возникновения исключительной ситуации(Exception)

Теперь вернемся к разработке нашего приложения.

В меню Delphi File выберем NewaThread Object и введем имя класса TMonDirThread.

Сохраним новый модуль с именем uMonThread.pas.

Исходный вид модуля uMonThread.pas приведен ниже:

unit uMonThread;

interface

uses

Classes;

type

TMonDirThread = class(TThread)

private

{ Private declarations }

protected

procedure Execute; override;

end;

implementation

{ Important: Methods and properties of objects in VCL can only be used in a

method called using Synchronize, for example,

Synchronize(UpdateCaption);

and UpdateCaption could look like,

procedure TMonDirThread.UpdateCaption;

begin

Form1.Caption := ‘Updated in a thread’;

end; }

{ TMonDirThread }

procedure TMonDirThread.Execute;

begin

{ Place thread code here }

end;

end.

При написании кода будем исходить из того, что наш поток должен:

Начинать работать сразу после создания.

Извещать основную форму об изменениях в сканируемом каталоге.

Прекращать работу по «инициативе» основного потока.

2.3. Создание конструктора потока.

Добавим в определение нашего класса секцию public и напишем код:

public

constructor TMonDirThread.Create(aPath: String);

destructor Destroy; override;

В секцию implementation добавим код нашего конструктора:

constructor TMonDirThread.Create(aPath: String);

begin

inherited Create(True); // Поток создаем в состоянии «Приостановлен»

FreeOnTerminate := True; // Поток освободит ресурсы при окончании работы

FPath := aPath; // Проверяемый каталог

Self.Priority := tpHighest; // Стартуем с высоким приоритетом

Resume; // Переводим поток в состояние «Активен»

end;

Подробнее о параметре Self.Priority := tpHighest;

Для нашего потока устанавливаем один из самых высоких приоритетов в системе для того, чтобы поток успевал обрабатывать изменения в каталоге.

Т.к. в потоке не используется ресурсоемких конструкций, то для каждого цикла обработки в процедуре Execute (напишем этот код ниже) будет затрачиваться минимальное процессорное время.

Переходим к кодированию основной процедуры нашего потока – Execute.

2.4. Создание процедуры Execute.

Для проверки изменений в Windows есть специальные функции:

FindFirstChangeNotification/FindNextChangeNotification/FindCloseChangeNotification;

ReadDirectoryChangesW (только в Windows NT и более поздних версиях)

FindFirst/FindNext/FindClose;

Самой удобной для наших целей является функция ReadDirectoryChangesW, так как, используя ее, можно сразу определить, какой тип изменений произошел в каталоге (создание/удаление/модификация файла) и узнать имя файла, который вызвал изменение.

Но, к великому моему сожалению, эта функция не работает в версиях Windows9x.

При использовании этих функций (Find___ChangeNotification) мы не сможем определять имя файла, вызвавшего изменения, но узнаем, какое изменение произошло в каталоге, и, что не менее важно, они работают во всех версиях Windows.

Мы воспользуемся для сканирования функциями Find___ChangeNotification.

К сожалению, мы не сможем использовать оба этих метода для сканирования каталогов, находящихся на сетевых дисках, так как отслеживание изменений производится на уровне операционной системы, и эти функции лишь используют заложенные в Windows возможности.

Метод с использованием функций FindFirst/FindNext/FindClose будет работать во всех версиях Windows и может обеспечить сканирование сетевых каталогов, но у него есть один существенный недостаток – он довольно медлителен в сравнении с первым и вторым методами, а также требует для работы значительно больше ресурсов.

Третий метод я опишу во второй части статьи.

Для понимания следующего материала необходимо пояснить еще, что такое «объекты синхронизации» Windows.

Работа Windows как операционной системы была бы невозможна без механизма синхронизации потоков в системе. Для решения этих задач в Windows существуют так называемые «объекты синхронизации».

«Объектом синхронизации» может выступать любой объект ядра Windows.

Перечислю некоторые из них: Event, Mutex, Semaphore, Timer.

В их число также входит и объект, который будем использовать мы — ”find change notification object». Далее я буду называть его “Объект”.

Все такие объекты имеют Handle – дескриптор (тип Integer), Handle назначается объекту при создании операционной системой и используется для идентификации в различных процедурах и функциях Windows.

В приложениях эти объекты используется для извещения потоков о каком-либо происшедшем событии в системе.

Все подобные объекты имеют свойство «состояние» — «включен/выключен».

В состоянии «Включен» объект сигнализирует о том, что некоторое событие произошло.

«Выключен» означает, что объект ожидает, пока произойдет некоторое событие.

Для проверки состояния объектов используется несколько похожих функций. В нашем приложении мы будем использовать функцию WaitForSingleObject.

Рассмотрим подробнее функции

FindFirstChangeNotification

FindNextChangeNotification

FindCloseChangeNotification

WaitForSingleObject

HANDLE FindFirstChangeNotification

Создает сигнализирующий объект find change notification object для сканирования каталога.

Параметры:

LPCTSTR lpPathName, — Указатель на строку, которая содержит путь к проверяемому каталогу.

BOOL bWatchSubtree, — Флаг, указывающий, нужно ли проверять подкаталоги.

DWORD dwNotifyFilter — О каких изменениях в каталоге сигнализировать.

dwNotifyFilter

Определяет, о каких типах изменений будет сигнализировать объект

Возможные значения:

FILE_NOTIFY_CHANGE_FILE_NAME

Сигнализировать о создании, удалении и переименовании файла.

FILE_NOTIFY_CHANGE_DIR_NAME

Сигнализировать о создании, удалении, переименовании подкаталогов.

FILE_NOTIFY_CHANGE_ATTRIBUTES

Сигнализировать об изменении атрибутов файлов или подкаталогов.

FILE_NOTIFY_CHANGE_SIZE

Сигнализировать об изменении размеров файлов. Операционная система определяет, что размер файла изменился, только если он закрыт.

FILE_NOTIFY_CHANGE_LAST_WRITE

Сигнализировать о смене даты последнего изменения файла. Операционная система определяет, что дата изменения файла сменилась, только если он закрыт.

FILE_NOTIFY_CHANGE_SECURITY

Сигнализировать об изменениях дескриптора защиты.

В случае успешного выполнения функция возвращает Handle созданного сигнализирующего объекта.

BOOL FindNextChangeNotification

Функция запрашивает операционную систему, изменилось ли состояние сигнализирующего объекта.

Параметры:

HANDLE hChangeHandle // Handle сигнализирующего объекта

BOOL FindCloseChangeNotification

Удаляет сигнализирующий объект.

DWORD WaitForSingleObject

Функция завершается в том случае, если при проверке состояния сигнализирующего объекта происходит одно из событий:

· Состояние объекта изменилось на «Включен»

· Время ожидания, определенного при вызове функции, истекло.

Параметры:

HANDLE hHandle, // Handle сигнализирующего объекта

DWORD dwMilliseconds // Время ожидания в миллисекундах

dwMilliseconds

Может принимать следующие значения:

— время ожидания в миллисекундах

— INFINITE, в этом случае время ожидания не ограничено.

Функция WaitForSingleObject возвращает следующие значения:

WAIT_OBJECT_0 – Состояние объекта изменилось на «Включен»

WAIT_TIMEOUT — Истекло время ожидания.

Если при выполнении функции возникли ошибки, WaitForSingleObject возвращает код WAIT_FAILED. Если состояние объекта изменяется до истечения времени dwMilliseconds, то функция завершает работу немедленно с кодом WAIT_OBJECT_0.

————-

Примечание: При возникновении ошибки во время выполнения этих функций

код ошибки можно получить, вызвав функцию GetLastError.

————-

За более подробной информацией по этим и другим функциям обращайтесь к

Windows SDK.

————-

Для синхронизации (обновления) данных формы будем использовать три процедуры – UpdateLog, ThreadStart и ThreadStop которые будут использоваться в методе Synchronize.

procedure TMonDirThread.UpdateLog;

begin

fMonDirMain.lbLog.Items.Add(TimeToStr(time) ‘: изменение!’);

if fMonDirMain.lbLog.Items.Count > 200 then // Показываем только 200 записей

fMonDirMain.lbLog.Items.Delete(0);

fMonDirMain.lbLog.ItemIndex := fMonDirMain.lbLog.Items.Count-1;

end;

procedure TMonDirThread.ThreadStart;

begin

fMonDirMain.sbMain.Panels[1].Text := ‘Активен’;

fMonDirMain.lbLog.Items.Add(TimeToStr(time) ‘: монитор запущен’);

end;

procedure TMonDirThread.ThreadStop;

begin

fMonDirMain.sbMain.Panels[1].Text := ‘Отключен’;

fMonDirMain.lbLog.Items.Add(TimeToStr(time) ‘: монитор остановлен’);

fMonDirMain.mmStart.Enabled := True; // Отключаем кнопку mmStart

fMonDirMain.mmStop.Enabled := False; // Включаем кнопку mmStop

end;

Далее опишу алгоритм работы процедуры Execute

Для начала сканирования каталога вызовем функцию

FindFirstChangeNotification, которая создаст сигнализирующий объект:

var

HandleChange: THandle; // Handle создаваемого объекта

begin

HandleChange :=

FindFirstChangeNotification(

PChar(FPath), // Проверяемый каталог

False, // Подкаталоги не проверяются

FILE_NOTIFY_CHANGE_FILE_NAME // флаг изменений

FILE_NOTIFY_CHANGE_ATTRIBUTES );

В случае ошибки создания объекта, выдадим сообщение об ошибке и законцим процедуру Execute:

Win32Check(HandleChange INVALID_HANDLE_VALUE);

При успешном создании синхронизирующего объекта вызовем процедуру ThreadStart для обновления главной формы:

Synchronize(ThreadStart); // Сообщение о старте потока

Далее, в цикле продолжаем проверку изменений содержимого каталога.

В секцию реализации(implementation) добавляем процедуру

procedure TMonDirThread.Execute;

var

HandleChange: THandle; // Handle создаваемого объекта для ожидания события

begin

// — Создаем объект для ожидания события

HandleChange :=

FindFirstChangeNotification(

PChar(FPath), // Проверяемый каталог

False, // Подкаталоги не проверяются

FILE_NOTIFY_CHANGE_FILE_NAME // Проверка создания/удаления/

FILE_NOTIFY_CHANGE_ATTRIBUTES); // переименования/изменения файлов

// — При ошибке Win32Check выводит сообщение и прерывает Execute.

Win32Check(HandleChange INVALID_HANDLE_VALUE);

Synchronize(ThreadStart); // Сообщение о старте потока

try

// — Цикл, пока для потока не будет выдана команда Terminate

while not Terminated do

begin

case WaitForSingleObject(HandleChange,1000) of

WAIT_FAILED: Terminate; // Ошибка, завершаем поток

WAIT_OBJECT_0: Synchronize(UpdateLog); // Сообщаем об изменении

end;

FindNextChangeNotification(HandleChange);

end;

finally

FindCloseChangeNotification(HandleChange);

end;

Synchronize(ThreadStop); // Сообщаем о завершении потока

end;

Не забудьте добавить в секцию interface ссылку на следующие модули:

uses

Classes, Windows, SysUtils;

2.5. Последний штрих.

В обработчики пунктов меню «Старт» и «Стоп» добавим следующие строки:

procedure TfMonDirMain.mmStartClick(Sender: TObject);

begin

fMonDirMain.Tag := Integer(TMonDirThread.Create(‘c:\temp’));

mmStart.Enabled := False; // Отключаем кнопку mmStart

mmStop.Enabled := True; // Включаем кнопку mmStop

end;

procedure TfMonDirMain.mmStopClick(Sender: TObject);

begin

if Assigned(TMonDirThread(fMonDirMain.Tag)) then

TMonDirThread(fMonDirMain.Tag).Terminate;

fMonDirMain.Tag := 0;

end;

Обратите внимание на строки, выделенные жирным шрифтом.

Вместо того, чтобы создавать дополнительно переменную типа TMonDirThread, мы присвоили свойству формы Tag ссылку на созданный объект-поток, воспользовавшись явным приведением типа Integer(), так как любой указатель можно преобразовать к типу Integer.

При создании потока (TMonDirThread.Create(‘c:\temp’)) мы передаем в качестве параметра имя проверяемого каталога.

Теперь у нас все готово для первого старта нашего приложения.

Подведем итоги.

Мы написали простейшее приложение, имеющие следующие возможности:

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

Уведомлять основной поток(главную форму) об изменениях.

Вести простейший протокол своей работы.

Для сканирования нескольких каталогов параллельно в нашем приложении нужно просто стартовать несколько потоков с необходимыми параметрами.

Для практики предлагаю самостоятельно реализовать возможность сканирования нескольких каталогов, а также изменить реализацию потока так, чтобы он извещал основной поток о каждом типе изменений в отдельности.

Каких возможностей не имеет приложение?

Сканировать сетевые диски.

Определять имя изменившегося файла.

Вести протокол работы в некотором файле.

Сворачиваться в виде иконки в SysTray.

Все эти возможности мы реализуем во второй части статьи.

Хочу также привести реализацию потока, предложенную Юрием Зотовым:

unit ThreadUnit;

interface

uses

Windows, Classes;

type

TDirMonThread = class(TThread)

private

FNotifier: THandle;

procedure UpdateLog;

protected

procedure Execute; override;

public

// Поле FNotifier должно быть недоступно для изиенения извне.

property Notifier: THandle read FNotifier;

end;

implementation

uses

SysUtils, MainUnit;

{ TDirMonThread }

procedure TDirMonThread.Execute;

begin

FNotifier := FindFirstChangeNotification(‘C:\’, False,

FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_ATTRIBUTES or

FILE_NOTIFY_CHANGE_LAST_WRITE);

// При ошибке Win32Check выводит сообщение и прерывает Execute.

Win32Check(FNotifier INVALID_HANDLE_VALUE);

while WaitForSingleObject(FNotifier, INFINITE) = WAIT_OBJECT_0 do

begin

// Поскольку стоит INFINITE, поток берет минимум процессорного времени,

// несмотря на высокий приоритет

Synchronize(UpdateLog);

FindNextChangeNotification(FNotifier)

end // FindCloseChangeNotification будет вызвана в обработчике OnTerminate.

end;

procedure TDirMonThread.UpdateLog;

begin

frmMain.lbLog.Items.Add(‘Changed at ‘ TimeToStr(Time))

end;

end.

Пример можно взять здесь

На этом хочу закончить первую часть статьи, и пожелать всем научиться писать такой же компактный, красивый и емкий код, приведенный выше!

{/codecitation}

Получить путь к директории Program Files

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: DeeCo

Автор: http://www.swissdelphicenter.ch

uses

Registry;

function GetProgramFilesDir: string;

var

reg: TRegistry;

begin

reg := TRegistry.Create;

try

reg.RootKey := HKEY_LOCAL_MACHINE;

reg.OpenKey(‘SOFTWARE\Microsoft\Windows\CurrentVersion’, False);

Result := reg.ReadString(‘ProgramFilesDir’);

finally

reg.Free;

end;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

// Shows something like c:\Program files

// zeigt «c:\Programme» (oder ahnlich)

ShowMessage(GetProgramFilesDir);

end;

{/codecitation}

Получить пути специальных папок

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

{

Constants:

CSIDL_DESKTOP

CSIDL_INTERNET

CSIDL_PROGRAMS

CSIDL_CONTROLS

CSIDL_PRINTERS

CSIDL_PERSONAL

CSIDL_FAVORITES

CSIDL_STARTUP

CSIDL_RECENT

CSIDL_SENDTO

CSIDL_BITBUCKET

CSIDL_STARTMENU

CSIDL_DESKTOPDIRECTORY

CSIDL_DRIVES

CSIDL_NETWORK

CSIDL_NETHOOD

CSIDL_FONTS

CSIDL_TEMPLATES

CSIDL_COMMON_STARTMENU

CSIDL_COMMON_PROGRAMS

CSIDL_COMMON_STARTUP

CSIDL_COMMON_DESKTOPDIRECTORY

CSIDL_APPDATA

CSIDL_PRINTHOOD

CSIDL_ALTSTARTUP

CSIDL_COMMON_ALTSTARTUP

CSIDL_COMMON_FAVORITES

CSIDL_INTERNET_CACHE

CSIDL_COOKIES

CSIDL_HISTORY

}

uses

ActiveX, ShlObj;

procedure TForm1.Button1Click(Sender: TObject);

// Replace CSIDL_HISTORY with the constants above

var

Allocator: IMalloc;

SpecialDir: PItemIdList;

FBuf: array[0..MAX_PATH] of Char;

PerDir: string;

begin

if SHGetMalloc(Allocator) = NOERROR then

begin

SHGetSpecialFolderLocation(Form1.Handle, CSIDL_HISTORY, SpecialDir);

SHGetPathFromIDList(SpecialDir, @FBuf[0]);

Allocator.Free(SpecialDir);

ShowMessage(string(FBuf));

end;

end;

// With Windows Me/2000, the SHGetSpecialFolderLocation function

// is superseded by ShGetFolderLocation.

// function to get the desktop folder location:

function GetDeskTopPath : string;

var

shellMalloc: IMalloc;

ppidl: PItemIdList;

PerDir: string;

begin

ppidl := nil;

try

if SHGetMalloc(shellMalloc) = NOERROR then

begin

SHGetSpecialFolderLocation(Form1.Handle, CSIDL_DESKTOP, ppidl);

SetLength(Result, MAX_PATH);

if not SHGetPathFromIDList(ppidl, PChar(Result)) then

raise exception.create(‘SHGetPathFromIDList failed : invalid pidl’);

SetLength(Result, lStrLen(PChar(Result)));

end;

finally

if ppidl nil then

shellMalloc.free(ppidl);

end;

end;

{/codecitation}

Получить пути папок в Моем Компьютере

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: DeeCo

Автор: http://www.swissdelphicenter.ch

uses

ActiveX, ShlObj;

procedure TForm1.Button1Click(Sender: TObject);

var

pShell, ShellFolder: IShellFolder;

pidl: PITEMIDLIST;

PMalloc: IMalloc;

sName: string;

EnumIDList: IEnumIDList;

pceltFetched: ULONG;

lpName: TStrRet;

slDirectories: TStringList;

begin

slDirectories := TStringList.Create;

try

SHGetDesktopFolder(ShellFolder);

SHGetSpecialFolderLocation(0,CSIDL_DRIVES, pidl);

SHGetMalloc(PMalloc);

ShellFolder.BindToObject(pidl, nil, IID_IShellFolder, Pointer(pShell));

pShell.EnumObjects(0,SHCONTF_FOLDERS, EnumIDList);

while EnumIDList.Next(1,pidl, pceltFetched) = S_ok do

begin

pceltFetched := 0;

lpName.uType := 0;

pShell.GetDisplayNameOf(pidl, SHGDN_FORPARSING, lpName);

sName := lpName.pOleStr;

slDirectories.Add(sName);

end;

ListBox1.Items.Assign(sldirectories);

finally

pMalloc._Release;

pMalloc := nil;

slDirectories.Free;

end;

{/codecitation}

Получить или установить дату для директории

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: DeeCo

Автор: http://www.swissdelphicenter.ch

function GetFolderDate(Folder: string): TDateTime;

var

Rec: TSearchRec;

Found: Integer;

Date: TDateTime;

begin

if Folder[Length(folder)] = ‘\’ then

Delete(Folder, Length(folder), 1);

Result := 0;

Found := FindFirst(Folder, faDirectory, Rec);

try

if Found = 0 then

begin

Date := FileDateToDateTime(Rec.Time);

Result := Date;

end;

finally

FindClose(Rec);

end;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

d: TDateTime;

begin

d := GetFolderDate(‘C:\WINNT’);

ShowMessage(FormatDateTime(‘dddd, d. mmmm yyyy, hh:mm:ss’, d));

end;

{ Sets the time for both files and directories }

{ for NT }

function NT_SetDateTime(FileName: string; dtCreation, dtLastAccessTime, dtLastWriteTime: TDateTime): Boolean;

// by Nicholas Robinson

var

hDir: THandle;

ftCreation: TFiletime;

ftLastAccessTime: TFiletime;

ftLastWriteTime: TFiletime;

function DTtoFT(dt: TDateTime): TFiletime;

var

dwft: DWORD;

ft: TFiletime;

begin

dwft := DateTimeToFileDate(dt);

DosDateTimeToFileTime(LongRec(dwft).Hi, LongRec(dwft).Lo, ft);

LocalFileTimeToFileTime(ft, Result);

end;

begin

hDir := CreateFile(PChar(FileName),

GENERIC_READ or GENERIC_WRITE,

0,

nil,

OPEN_EXISTING,

FILE_FLAG_BACKUP_SEMANTICS,

0);

if hDir INVALID_HANDLE_VALUE then

begin

try

ftCreation := DTtoFT(dtCreation);

ftLastAccessTime := DTtoFT(dtLastAccessTime);

ftLastWriteTime := DTtoFT(dtLastWriteTime);

Result := SetFileTime(hDir, @ftCreation, @ftLastAccessTime, @ftLastWriteTime);

finally

CloseHandle(hDir);

end;

end

else

Result := False;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

NT_SetDateTime(‘c:\temp\MyFolder’, now, now, now);

end;

{/codecitation}

Получить все поддиректории указанной директории

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: DeeCo

Автор: http://www.swissdelphicenter.ch

procedure GetSubDirs(const sRootDir: string; slt: TStrings);

var

srSearch: TSearchRec;

sSearchPath: string;

sltSub: TStrings;

i: Integer;

begin

sltSub := TStringList.Create;

slt.BeginUpdate;

try

sSearchPath := AddDirSeparator(sRootDir);

if FindFirst(sSearchPath ‘*’, faDirectory, srSearch) = 0 then

repeat

if ((srSearch.Attr and faDirectory) = faDirectory) and

(srSearch.Name ‘.’) and

(srSearch.Name ‘..’) then

begin

slt.Add(sSearchPath srSearch.Name);

sltSub.Add(sSearchPath srSearch.Name);

end;

until (FindNext(srSearch) 0);

FindClose(srSearch);

for i := 0 to sltSub.Count — 1 do

GetSubDirs(sltSub.Strings[i], slt);

finally

slt.EndUpdate;

FreeAndNil(sltSub);

end;

end;

{/codecitation}

Получение списка вложенных каталогов

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Samsonov Aleksandr

WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****

>> Получение списка вложенных каталогов

Процедура служит ля получения списка каталогов вложенных в указанный каталог.

Полезно ее использовать для построения дерева каталогов.

Полученные в OutPaper данные можно передать процедуре

Радионова Алексейя которая по ним построит дерево.

Зависимости: sysutils, classes, StdCtrls, UDBF.FillTreeViewWithFiles

Автор: Samsonov Aleksandr, s002156@mail.ru, Tver

Copyright: s002156Shurik

Дата: 19 сентября 2002 г.

***************************************************** }

procedure GetTreeDirs(Root: string; OutPaper: TStringList);

var

i: Integer;

s: string;

procedure InsDirs(s: string; ind: Integer; Path: string; OPaper: TStringList);

var {Вставляет в Memo список вложенных директорий}

sr: TSearchRec;

attr: Integer;

begin

attr := 0;

attr := faAnyFile;

if DirectoryExists(Path) then

if FindFirst(IncludeTrailingBackslash(Path) ‘*.*’, attr, SR) = 0 then

begin

repeat

if (sr.Attr = faDirectory) and (sr.Name[Length(sr.Name)] ‘.’) then

OPaper.Insert(ind, s sr.Name);

until (FindNext(sr) 0);

FindClose(SR);

end

end;

begin

{Проверяем существуетли начальный каталог}

if not DirectoryExists(Root) then

exit;

{Создаем список каталогов первой вложенности}

if root[Length(Root)] ‘\’ then

InsDirs(root ‘\’, OutPaper.Count, Root, OutPaper)

else

InsDirs(root, OutPaper.Count, Root, OutPaper);

i := 0;

repeat

s := OutPaper[i]; //в s получаем путь к уже внесенному в список кат.

// Вставляем сразу за данной директорией в списке,

// список вложенных в нее директорий.

// Тем самым увеличиваем OutPaper.Lines.Count.

// Таким образом катологи в которых поиск еще не производился,

// оказываются ниже и очереь до них еще дойдет.

InsDirs(s ‘\’, i 1, OutPaper[i], OutPaper);

inc(i);

until (i = OutPaper.Count);

end;

Пример использования:

procedure TForm1.Button1Click(Sender: TObject);

var

Strs: TStringList;

begin

Strs := TStringList.Create;

try

GetTreeDirs(‘C:\’, Strs);

FillTreeViewWithFiles(TreeView1, Strs);

finally

Strs.Free;

end;

end;

{/codecitation}

Получение родительской директории указанной папки

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Функция GetParentDir возвращает родительскую директорию папки, путь к которой

задан в параметре StartDirectory. Если папки StartDirectory не существует, то

функция возвратит пустую строку.

Зависимости: system, filectrl, UBPFD.TrimEx

Автор: VID, vidsnap@mail.ru, ICQ:132234868, Махачкала

Copyright: VID

Дата: 25 апреля 2002 г.

***************************************************** }

function GetParentDir(StartDirectory: string): string;

var

x: Integer;

begin

Result := »;

if DirectoryExists(StartDirectory) = False then

exit;

StartDirectory := TrimEx(StartDirectory, ‘\’);

if Length(StartDirectory) = 0 then

EXIT;

X := Length(StartDirectory) 1;

repeat

X := X — 1;

until (StartDirectory[X] = ‘\’) or (X = 1);

Result := Copy(StartDirectory, 1, X);

if Result[Length(Result)] ‘\’ then

Result := Result ‘\’;

if DirectoryExists(Result) = False then

begin

Result := »;

EXIT;

end;

end;

{/codecitation}