Пример показывает, как можно отслеживать практически все события происходящий в Вашей оболочке. Код находится в процессе разработки, но уже содержит в себе большое количество возможностей.
(Источник: «Delphi X-Files» «)
<-------------- Begin UNIT code ---------------------------->
{$IFNDEF VER80} {$IFNDEF VER90} {$IFNDEF VER93}
{$DEFINE Delphi3orHigher}
{$ENDIF} {$ENDIF} {$ENDIF}
unit ShellNotify;
interface
uses Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs,
{$IFNDEF Delphi3orHigher} OLE2, {$ELSE} ActiveX, ComObj, {$ENDIF}
ShlObj;
type
NOTIFYREGISTER = record
pidlPath : PItemIDList;
bWatchSubtree : boolean;
end;
PNOTIFYREGISTER = ^NOTIFYREGISTER;
const
SNM_SHELLNOTIFICATION = WM_USER +1;
SHCNF_ACCEPT_INTERRUPTS = $0001;
SHCNF_ACCEPT_NON_INTERRUPTS = $0002;
SHCNF_NO_PROXY = $8000;
type
TNotificationEvent = (neAssociationChange, neAttributesChange,
neFileChange, neFileCreate, neFileDelete, neFileRename,
neDriveAdd, neDriveRemove, neShellDriveAdd, neDriveSpaceChange,
neMediaInsert, neMediaRemove, neFolderCreate, neFolderDelete,
neFolderRename, neFolderUpdate, neNetShare, neNetUnShare,
neServerDisconnect, neImageListChange);
TNotificationEvents = set of TNotificationEvent;
TShellNotificationEvent1 = procedure(Sender: TObject;
Path: String)of Object;
TShellNotificationEvent2 = procedure(Sender: TObject;
path1, path2: String) of Object;
// TShellNotificationAttributesEvent = procedure(Sender: TObject;
// OldAttribs, NewAttribs: Integer) of Object;
TShellNotification = class( TComponent )
private
fWatchEvents: TNotificationEvents;
fPath: String;
fActive, fWatch: Boolean;
prevPath1, prevPath2: String;
PrevEvent: Integer;
Handle, NotifyHandle: HWND;
fOnAssociationChange: TNotifyEvent;
fOnAttribChange: TShellNotificationEvent2;
FOnCreate: TShellNotificationEvent1;
FOnDelete: TShellNotificationEvent1;
FOnDriveAdd: TShellNotificationEvent1;
FOnDriveAddGui: TShellNotificationEvent1;
FOnDriveRemove: TShellNotificationEvent1;
FOnMediaInsert: TShellNotificationEvent1;
FOnMediaRemove: TShellNotificationEvent1;
FOnDirCreate: TShellNotificationEvent1;
FOnNetShare: TShellNotificationEvent1;
FOnNetUnShare: TShellNotificationEvent1;
FOnRenameFolder: TShellNotificationEvent2;
FOnItemRename: TShellNotificationEvent2;
FOnFolderRemove: TShellNotificationEvent1;
FOnServerDisconnect: TShellNotificationEvent1;
FOnFolderUpdate: TShellNotificationEvent1;
function PathFromPidl(Pidl: PItemIDList): String;
procedure SetWatchEvents(const Value: TNotificationEvents);
function GetActive: Boolean;
procedure SetActive(const Value: Boolean);
procedure SetPath(const Value: String);
procedure SetWatch(const Value: Boolean);
protected
procedure ShellNotifyRegister;
procedure ShellNotifyUnregister;
procedure WndProc(var Message: TMessage);
procedure DoAssociationChange; dynamic;
procedure DoAttributesChange(Path1, Path2: String); dynamic;
procedure DoCreateFile(Path: String); dynamic;
procedure DoDeleteFile(Path: String); dynamic;
procedure DoDriveAdd(Path:String); dynamic;
procedure DoDriveAddGui(Path: String); dynamic;
procedure DoDriveRemove(Path: String); dynamic;
procedure DoMediaInsert(Path: String); dynamic;
procedure DoMediaRemove(Path: String); dynamic;
procedure DoDirCreate(Path: String); dynamic;
procedure DoNetShare(Path: String); dynamic;
procedure DoNetUnShare(Path: String); dynamic;
procedure DoRenameFolder(Path1, Path2: String); dynamic;
procedure DoRenameItem(Path1, Path2: String); dynamic;
procedure DoFolderRemove(Path: String); dynamic;
procedure DoServerDisconnect(Path: String); dynamic;
procedure DoDirUpdate(Path: String); dynamic;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Path: String read fPath write SetPath;
property Active: Boolean read GetActive write SetActive;
property WatchSubTree: Boolean read fWatch write SetWatch;
property WatchEvents: TNotificationEvents
read fWatchEvents write SetWatchEvents;
property OnAssociationChange: TNotifyEvent
read fOnAssociationChange write FOnAssociationChange;
property OnAttributesChange: TShellNotificationEvent2
read fOnAttribChange write fOnAttribChange;
property OnFileCreate: TShellNotificationEvent1
read FOnCreate write FOnCreate;
property OnFolderRename: TShellNotificationEvent2
read FOnRenameFolder write FOnRenameFolder;
property OnFolderUpdate: TShellNotificationEvent1
read FOnFolderUpdate write FOnFolderUpdate;
property OnFileDelete: TShellNotificationEvent1
read FOnDelete write FOnDelete;
property OnDriveAdd: TShellNotificationEvent1
read FOnDriveAdd write FOnDriveAdd;
property OnFolderRemove: TShellNotificationEvent1
read FOnFolderRemove write FOnFolderRemove;
property OnItemRename: TShellNotificationEvent2
read FOnItemRename write FOnItemRename;
property OnDriveAddGui: TShellNotificationEvent1
read FOnDriveAddGui write FOnDriveAddGui;
property OnDriveRemove: TShellNotificationEvent1
read FOnDriveRemove write FOnDriveRemove;
property OnMediaInserted: TShellNotificationEvent1
read FOnMediaInsert write FOnMediaInsert;
property OnMediaRemove: TShellNotificationEvent1
read FOnMediaRemove write FOnMediaRemove;
property OnDirCreate: TShellNotificationEvent1
read FOnDirCreate write FOnDirCreate;
property OnNetShare: TShellNotificationEvent1
read FOnNetShare write FOnNetShare;
property OnNetUnShare: TShellNotificationEvent1
read FOnNetUnShare write FOnNetUnShare;
property OnServerDisconnect: TShellNotificationEvent1
read FOnServerDisconnect write FOnServerDisconnect;
end;
function SHChangeNotifyRegister( hWnd: HWND; dwFlags: integer;
wEventMask : cardinal; uMsg: UINT; cItems : integer;
lpItems : PNOTIFYREGISTER) : HWND; stdcall;
function SHChangeNotifyDeregister(hWnd: HWND) : boolean; stdcall;
function SHILCreateFromPath(Path: Pointer; PIDL: PItemIDList;
var Attributes: ULONG):HResult; stdcall;
implementation
const Shell32DLL = ‘shell32.dll’;
function SHChangeNotifyRegister; external Shell32DLL index 2;
function SHChangeNotifyDeregister; external Shell32DLL index 4;
function SHILCreateFromPath; external Shell32DLL index 28;
{ TShellNotification }
constructor TShellNotification.Create(AOwner: TComponent);
begin
inherited Create( AOwner );
if not (csDesigning in ComponentState) then
Handle := AllocateHWnd(WndProc);
end;
destructor TShellNotification.Destroy;
begin
if not (csDesigning in ComponentState) then
Active := False;
if Handle <> 0 then DeallocateHWnd( Handle );
inherited Destroy;
end;
procedure TShellNotification.DoAssociationChange;
begin
if Assigned( fOnAssociationChange ) and (neAssociationChange in fWatchEvents) then
fOnAssociationChange( Self );
end;
procedure TShellNotification.DoAttributesChange;
begin
if Assigned( fOnAttribChange ) then
fOnAttribChange( Self, Path1, Path2 );
end;
procedure TShellNotification.DoCreateFile(Path: String);
begin
if Assigned( fOnCreate ) then
FOnCreate(Self, Path)
end;
procedure TShellNotification.DoDeleteFile(Path: String);
begin
if Assigned( FOnDelete ) then
FOnDelete(Self, Path);
end;
procedure TShellNotification.DoDirCreate(Path: String);
begin
if Assigned( FOnDirCreate ) then
FOnDirCreate( Self, Path );
end;
procedure TShellNotification.DoDirUpdate(Path: String);
begin
if Assigned( FOnFolderUpdate ) then
FOnFolderUpdate(Self, Path);
end;
procedure TShellNotification.DoDriveAdd(Path: String);
begin
if Assigned( FOnDriveAdd ) then
FOnDriveAdd(Self, Path);
end;
procedure TShellNotification.DoDriveAddGui(Path: String);
begin
if Assigned( FOnDriveAddGui ) then
FOnDriveAdd(Self, Path);
end;
procedure TShellNotification.DoDriveRemove(Path: String);
begin
if Assigned( FOnDriveRemove ) then
FOnDriveRemove(Self, Path);
end;
procedure TShellNotification.DoFolderRemove(Path: String);
begin
if Assigned(FOnFolderRemove) then
FOnFolderRemove( Self, Path );
end;
procedure TShellNotification.DoMediaInsert(Path: String);
begin
if Assigned( FOnMediaInsert ) then
FOnMediaInsert(Self, Path);
end;
procedure TShellNotification.DoMediaRemove(Path: String);
begin
if Assigned(FOnMediaRemove) then
FOnMediaRemove(Self, Path);
end;
procedure TShellNotification.DoNetShare(Path: String);
begin
if Assigned(FOnNetShare) then
FOnNetShare(Self, Path);
end;
procedure TShellNotification.DoNetUnShare(Path: String);
begin
if Assigned(FOnNetUnShare) then
FOnNetUnShare(Self, Path);
end;
procedure TShellNotification.DoRenameFolder(Path1, Path2: String);
begin
if Assigned( FOnRenameFolder ) then
FOnRenameFolder(Self, Path1, Path2);
end;
procedure TShellNotification.DoRenameItem(Path1, Path2: String);
begin
if Assigned( FOnItemRename ) then
FonItemRename(Self, Path1, Path2);
end;
procedure TShellNotification.DoServerDisconnect(Path: String);
begin
if Assigned( FOnServerDisconnect ) then
FOnServerDisconnect(Self, Path);
end;
function TShellNotification.GetActive: Boolean;
begin
Result := (NotifyHandle <> 0) and (fActive);
end;
function TShellNotification.PathFromPidl(Pidl: PItemIDList): String;
begin
SetLength(Result, Max_Path);
if not SHGetPathFromIDList(Pidl, PChar(Result)) then Result := »;
if pos(#0, Result) > 0 then
SetLength(Result, pos(#0, Result));
end;
procedure TShellNotification.SetActive(const Value: Boolean);
begin
if (Value <> fActive) then
begin
fActive := Value;
if fActive then ShellNotifyRegister else ShellNotifyUnregister;
end;
end;
procedure TShellNotification.SetPath(const Value: String);
begin
if fPath <> Value then
begin
fPath := Value;
ShellNotifyRegister;
end;
end;
procedure TShellNotification.SetWatch(const Value: Boolean);
begin
if fWatch <> Value then
begin
fWatch := Value;
ShellNotifyRegister;
end;
end;
procedure TShellNotification.SetWatchEvents(
const Value: TNotificationEvents);
begin
if fWatchEvents <> Value then
begin
fWatchEvents := Value;
ShellNotifyRegister;
end;
end;
procedure TShellNotification.ShellNotifyRegister;
var
NotifyRecord: PNOTIFYREGISTER;
Flags: DWORD;
Pidl: PItemIDList;
Attributes: ULONG;
begin
if not (csDesigning in ComponentState) and
not (csLoading in ComponentState) then
begin
SHILCreatefromPath( PChar(fPath), Addr(Pidl), Attributes);
NotifyRecord^.pidlPath := Pidl;
NotifyRecord^.bWatchSubtree := fWatch;
if NotifyHandle <> 0 then ShellNotifyUnregister;
Flags := 0;
if neAssociationChange in FWatchEvents then
Flags := Flags or SHCNE_ASSOCCHANGED;
if neAttributesChange in FWatchEvents then
Flags := Flags or SHCNE_ATTRIBUTES;
if neFileChange in FWatchEvents then
Flags := Flags or SHCNE_UPDATEITEM;
if neFileCreate in FWatchEvents then
Flags := Flags or SHCNE_CREATE;
if neFileDelete in FWatchEvents then
Flags := Flags or SHCNE_DELETE;
if neFileRename in FWatchEvents then
Flags := Flags or SHCNE_RENAMEITEM;
if neDriveAdd in FWatchEvents then
Flags := Flags or SHCNE_DRIVEADD;
if neDriveRemove in FWatchEvents then
Flags := Flags or SHCNE_DRIVEREMOVED;
if neShellDriveAdd in FWatchEvents then
Flags := Flags or SHCNE_DRIVEADDGUI;
if neDriveSpaceChange in FWatchEvents then
Flags := Flags or SHCNE_FREESPACE;
if neMediaInsert in FWatchEvents then
Flags := Flags or SHCNE_MEDIAINSERTED;
if neMediaRemove in FWatchEvents then
Flags := Flags or SHCNE_MEDIAREMOVED;
if neFolderCreate in FWatchEvents then
Flags := Flags or SHCNE_MKDIR;
if neFolderDelete in FWatchEvents then
Flags := Flags or SHCNE_RMDIR;
if neFolderRename in FWatchEvents then
Flags := Flags or SHCNE_RENAMEFOLDER;
if neFolderUpdate in FWatchEvents then
Flags := Flags or SHCNE_UPDATEDIR;
if neNetShare in FWatchEvents then
Flags := Flags or SHCNE_NETSHARE;
if neNetUnShare in FWatchEvents then
Flags := Flags or SHCNE_NETUNSHARE;
if neServerDisconnect in FWatchEvents then
Flags := Flags or SHCNE_SERVERDISCONNECT;
if neImageListChange in FWatchEvents then
Flags := Flags or SHCNE_UPDATEIMAGE;
NotifyHandle := SHChangeNotifyRegister(Handle,
SHCNF_ACCEPT_INTERRUPTS or SHCNF_ACCEPT_NON_INTERRUPTS,
Flags, SNM_SHELLNOTIFICATION, 1, NotifyRecord);
end;
end;
procedure TShellNotification.ShellNotifyUnregister;
begin
if NotifyHandle <> 0 then
SHChangeNotifyDeregister(NotifyHandle);
end;
procedure TShellNotification.WndProc(var Message: TMessage);
type
TPIDLLIST = record
pidlist : array[1..2] of PITEMIDLIST;
end;
PIDARRAY = ^TPIDLLIST;
var
Path1 : string;
Path2 : string;
ptr : PIDARRAY;
repeated : boolean;
event : longint;
begin
case Message.Msg of
SNM_SHELLNOTIFICATION:
begin
event := Message.LParam and ($7FFFFFFF);
Ptr := PIDARRAY(Message.WParam);
Path1 := PathFromPidl( Ptr^.pidlist[1] );
Path2 := PathFromPidl( Ptr^.pidList[2] );
repeated := (PrevEvent = event)
and (uppercase(prevpath1) = uppercase(Path1))
and (uppercase(prevpath2) = uppercase(Path2));
if Repeated then exit;
PrevEvent := Message.Msg;
prevPath1 := Path1;
prevPath2 := Path2;
case event of
SHCNE_ASSOCCHANGED : DoAssociationChange;
SHCNE_ATTRIBUTES : DoAttributesChange( Path1, Path2);
SHCNE_CREATE : DoCreateFile(Path1);
SHCNE_DELETE : DoDeleteFile(Path1);
SHCNE_DRIVEADD : DoDriveAdd(Path1);
SHCNE_DRIVEADDGUI : DoDriveAddGui(path1);
SHCNE_DRIVEREMOVED : DoDriveRemove(Path1);
SHCNE_MEDIAINSERTED : DoMediaInsert(Path1);
SHCNE_MEDIAREMOVED : DoMediaRemove(Path1);
SHCNE_MKDIR : DoDirCreate(Path1);
SHCNE_NETSHARE : DoNetShare(Path1);
SHCNE_NETUNSHARE : DoNetUnShare(Path1);
SHCNE_RENAMEFOLDER : DoRenameFolder(Path1, Path2);
SHCNE_RENAMEITEM : DoRenameItem(Path1, Path2);
SHCNE_RMDIR : DoFolderRemove(Path1);
SHCNE_SERVERDISCONNECT : DoServerDisconnect(Path);
SHCNE_UPDATEDIR : DoDirUpdate(Path);
SHCNE_UPDATEIMAGE : ;
SHCNE_UPDATEITEM : ;
end;//Case event of
end;//SNM_SHELLNOTIFICATION
end; //case
end;
end.
Декабрь
1,
2007
— Filed under: Delphi
Метки: Delphi, Windows, события
Существует такая штука, как сжатие данных. Хорошо, если вы инсталлируете свою программу с компакт-диска. Как правило, в такой ситуации вы не знаете, что ещё записать на эту бездонную болванку и несколько лишних мегабайт вам в данной ситуации совсем не помешают 
Совершенно по другому обстоят дела с дискетами. На дискеты надо помещать сжатую информацию — в этом случае вся ваша программа возможно (только возможно) влезет всего лишь на тридцать четыре дискеты. Вот как делать сжатие — это вопрос.
Я расскажу вам о нескольких методах сжатия данных, которыми вы можете воспользоваться.
Метод номер раз — это сжатие файлов стандартными утилитами, разработанными фирмой Microsoft. Когда-то это была программа compress.exe, сейчас — cabarc.exe.
hInFile := LZOpenFile(PChar(SourcePath), ofInReOpenBuff, OF_READ);
hOutFile := LZOpenFile(PChar(TargetPath), ofOutReOpenBuff, OF_CREATE or OF_WRITE);
iLZError := LZCopy(hInFile, hOutFile);
if iLZError > 0 then
// Операция выполнилась успешно, скопировано iLZError байт
else
// Ошибка номер iLZError
LZClose(hOutFile);
LZClose(hInFile);
Метод номер два — сжатие файлов с помощью библиотеки ZLib, которая поставляется вместе с Delphi (она находится в каталоге \Info\Extras\ZLib оригинального диска с Delphi). Она предоставляет вам два класса, которые являются наследниками TStream. Вы можете воспользоваться кодом функции копирования при помощи TFileStream из предыдущей статьи для того, чтобы реализовать как сжатие, так и распаковку произвольного потока (в том числе и файла).
Ещё один метод — использование динамической библиотеки unrar.dll, разработанной Евгением Рошалом. Существуют и другие библиотеки (даже компоненты), вы можете свободно найти их, если будете достаточно долго шляться по Интернету.
Примечание:
Мне кажется, что менее всего размер вашей инсталляции увеличится, если вы используете методы, предлагаемые Microsoft; ровно потому, что они встроены в Windows и вам не надо записывать их на дискету.
Копирование нескольких файлов представляется достаточно простым, раз уж мы научились копировать один файл. Наиболее просто это делается, если ваши файлы поставляются в одном архиве (.CAB или .RAR). Сложным может показаться копирование файлов по маске (*.*) и копирование вложенных подкаталогов. Ниже приводится исходный текст процедуры, которая составляет список файлов в каталоге и всех вложенных подкаталогах.
procedure ReadTree(Path: String; Strings: TStrings);
procedure ReadFolder(Path: String; Strings: TStrings);
var
SearchRec: TSearchRec;
FindResult: Integer;
begin
FindResult := FindFirst(Path + ‘*.*’, faAnyFile, SearchRec);
while FindResult = 0 do
begin
// Если найден подкаталог, рекурсивно читаем его содержимое
// Не забываем игнорировать подкаталоги ‘.’ и ‘..’
with SearchRec do
if (Name <> ‘.’) and (Name <> ‘..’) then
begin
Strings.Add(Path + Name);
if (Attr and faDirectory <> 0) then
ReadFolder(Path + Name + ‘\’, Strings);
end;
FindResult := FindNext(SearchRec);
end;
FindClose(SearchRec);
end;
begin
// Эта процедура заносит в Strings список файлов во всех вложенных папках
// каталога Path и сами эти папки
Strings.Clear;
if (Length(Path) > 0) and (Path[Length(Path)] <> ‘\’) then
Path := Path + ‘\’;
ReadFolder(Path, Strings);
end;
Отдельно стоит поговорить о тех файлах, которые могут использоваться сразу несколькими программами. Для этих файлов существует даже специальное название — разделяемые (поскольку несколько программ делят их между собой). Обычно они записываются в системный каталог Windows (для Windows 98 это как правило \WINDOWS\SYSTEM, для Windows NT — \WINNT\SYSTEM32). Если системный каталог доступен только для чтения, то эти файлы необходимо записывать в каталог Windows (\WINDOWS и \WINNT соответственно), который всегда доступен для записи.
function GetSysDir: String;
var
szPath: array [0..MAX_PATH - 1] of Char;
I: Integer;
Stream: TStream;
begin
// Получаем системный каталог
GetSystemDirectory(szPath, MAX_PATH);
Result := StrPas(szPath);
// Добавляем обратный слеш в конец пути, если его там нет
if (Length(Result) > 0) and (Result[Length(Result)] <> ‘\’) then
Result := Result + ‘\’;
// Подбираем имя файла вида XXXXXXXX.TMP, где XXXXXXXX —
// шестнадцатиричное число, который не существует в системном каталоге
I := 0;
while FileExists(Result + IntToHex(I, 
+ ‘.TMP’) do
Inc(I);
try
// Создаём файл и удаляем его. Если всё нормально, то каталог доступен
// для записи.
Stream := TFileStream(Result + IntToHex(I, + ‘.TMP’, fmCreate);
Stream.Free;
DeleteFile(Result + IntToHex(I, + ‘.TMP’);
except
// Если создать файл не удалось, в качестве системного каталога будем
// использовать каталог Windows.
GetWindowsDirectory(szPath, MAX_PATH);
Result := StrPas(szPath);
if (Length(Result) > 0) and (Result[Length(Result)] <> ‘\’) then
Result := Result + ‘\’;
end;
end;
Если разделяемый файл уже существует в целевом каталоге, то необходимо сравнить версии, языки и др. характеристики двух файлов и на основании этого сравнения решать — копировать файл или не надо.
При копировании разделяемых файлов требуется уведомить Windows о том, что одним разделением стало больше. Это делается через реестр. При замещении файлов, которые в момент инсталляции используются Windows требуется определённая техника, поскольку перезаписать занятый файл нельзя. Эти вопросы в ближайшее время будут освещены в следующей статье. Поистине, копирование файлов — тема неисчерпаемая
Напоследок, исследуем вопрос о том, куда копировать файлы? В соответствии с рекомендациями Microsoft, каталог вашей программы должен иметь форму \<Название вашей фирмы>\<Название продукта>. Вы можете также включить в название каталога информацию о версии продукта, например C:\Program Files\Borland\Delphi 7, хотя возможен и вариант C:\Program Files\Borland\Delphi\7 (реально фирма Borland использует первый вариант). Бывают и исключения, в частности FAR Евгения Рошала ставится в C:\Program Files\FAR.
Разделяемые файлы следует копировать в системный каталог Windows, а если он защищён от записи — в каталог Windows.
Дальше мы пойдём по реестру…
Ноябрь
6,
2007
— Filed under: Delphi
Метки: FAR, Windows, Копирование
