|
Вопрос # 6 359/ вопрос открыт / |
|
Здравствуйте!
Имеется данный ниже код. Служит для отслеживания событий.
Создал и подключил данный Unit.
Подскажите пожалуйста как использовать данный код. Т.е. как установить слежение за созданием файлов в файловой системе и как снять. например по щелчку по кнопке.
Приложение: Переключить в обычный режим- {$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 }
-
- procedure Register;
- begin
- RegisterComponents('FPiette', [ TShellNotification]);
- end;
-
- 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
- SHGetSpecialFolderLocation(Handle,CSIDL_DRIVES,Pidl);
- 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.
-
 |
Вопрос задал: Demosha (статус: Посетитель)
Вопрос отправлен: 14 января 2013, 11:38
Состояние вопроса: открыт, ответов: 0.
|
Мини-форум вопроса
Всего сообщений: 5; последнее сообщение — 12 февраля 2013, 01:32; участников в обсуждении: 3.
|
Ed (статус: 1-ый класс), 16 января 2013, 15:59 [#1]:
Создал (?) и подключил данный Unit...
...как использовать данный код(!!!)
Как то не логично, не?
|
|
Demosha (статус: Посетитель), 16 января 2013, 18:04 [#2]:
что тебя так стесняет?!
|
|
Demosha (статус: Посетитель), 6 февраля 2013, 00:21 [#4]:
у меня был код, а не unit, конечно же можно догадаться, что если бы я и код написал, то не стал бы просить помощи в нем разобраться. спасибо bugmenot, выручил
|
|
bugmenot (статус: 3-ий класс), 12 февраля 2013, 01:32 [#5]:
Цитата (Demosha):
можно узнать как искал?
Да элементарно. Выделил код, поискал в Гугле, среди результатов выбрал тот, где копирайты не вытерты.
виконання програми розпочинається з того самого мiсця, де призупинилося.
|
Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
|