Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом

Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »



Вопрос # 6 359

/ вопрос открыт /

Здравствуйте!
Имеется данный ниже код. Служит для отслеживания событий.
Создал и подключил данный Unit.
Подскажите пожалуйста как использовать данный код. Т.е. как установить слежение за созданием файлов в файловой системе и как снять. например по щелчку по кнопке.

Приложение:
  1. {$IFNDEF VER80} {$IFNDEF VER90} {$IFNDEF VER93}
  2. {$DEFINE Delphi3orHigher}
  3. {$ENDIF} {$ENDIF} {$ENDIF}
  4.  
  5. unit ShellNotify;
  6. interface
  7.  
  8. uses Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs,
  9. {$IFNDEF Delphi3orHigher} OLE2, {$ELSE} ActiveX, ComObj, {$ENDIF}
  10. ShlObj;
  11.  
  12.  
  13. type
  14. NOTIFYREGISTER = record
  15. pidlPath : PItemIDList;
  16. bWatchSubtree : boolean;
  17. end;
  18.  
  19. PNOTIFYREGISTER = ^NOTIFYREGISTER;
  20.  
  21. const
  22. SNM_SHELLNOTIFICATION = WM_USER +1;
  23. SHCNF_ACCEPT_INTERRUPTS = $0001;
  24. SHCNF_ACCEPT_NON_INTERRUPTS = $0002;
  25. SHCNF_NO_PROXY = $8000;
  26.  
  27. type
  28. TNotificationEvent = (neAssociationChange, neAttributesChange,
  29. neFileChange, neFileCreate, neFileDelete, neFileRename,
  30. neDriveAdd, neDriveRemove, neShellDriveAdd, neDriveSpaceChange,
  31. neMediaInsert, neMediaRemove, neFolderCreate, neFolderDelete,
  32. neFolderRename, neFolderUpdate, neNetShare, neNetUnShare,
  33. neServerDisconnect, neImageListChange);
  34. TNotificationEvents = set of TNotificationEvent;
  35.  
  36. TShellNotificationEvent1 = procedure(Sender: TObject;
  37. Path: String)of Object;
  38. TShellNotificationEvent2 = procedure(Sender: TObject;
  39. path1, path2: String) of Object;
  40. // TShellNotificationAttributesEvent = procedure(Sender: TObject;
  41. // OldAttribs, NewAttribs: Integer) of Object;
  42.  
  43. TShellNotification = class( TComponent )
  44. private
  45. fWatchEvents: TNotificationEvents;
  46. fPath: String;
  47. fActive, fWatch: Boolean;
  48.  
  49. prevPath1, prevPath2: String;
  50. PrevEvent: Integer;
  51.  
  52. Handle, NotifyHandle: HWND;
  53.  
  54. fOnAssociationChange: TNotifyEvent;
  55. fOnAttribChange: TShellNotificationEvent2;
  56. FOnCreate: TShellNotificationEvent1;
  57. FOnDelete: TShellNotificationEvent1;
  58. FOnDriveAdd: TShellNotificationEvent1;
  59. FOnDriveAddGui: TShellNotificationEvent1;
  60. FOnDriveRemove: TShellNotificationEvent1;
  61. FOnMediaInsert: TShellNotificationEvent1;
  62. FOnMediaRemove: TShellNotificationEvent1;
  63. FOnDirCreate: TShellNotificationEvent1;
  64. FOnNetShare: TShellNotificationEvent1;
  65. FOnNetUnShare: TShellNotificationEvent1;
  66. FOnRenameFolder: TShellNotificationEvent2;
  67. FOnItemRename: TShellNotificationEvent2;
  68. FOnFolderRemove: TShellNotificationEvent1;
  69. FOnServerDisconnect: TShellNotificationEvent1;
  70. FOnFolderUpdate: TShellNotificationEvent1;
  71.  
  72. function PathFromPidl(Pidl: PItemIDList): String;
  73. procedure SetWatchEvents(const Value: TNotificationEvents);
  74. function GetActive: Boolean;
  75. procedure SetActive(const Value: Boolean);
  76. procedure SetPath(const Value: String);
  77. procedure SetWatch(const Value: Boolean);
  78. protected
  79. procedure ShellNotifyRegister;
  80. procedure ShellNotifyUnregister;
  81. procedure WndProc(var Message: TMessage);
  82.  
  83. procedure DoAssociationChange; dynamic;
  84. procedure DoAttributesChange(Path1, Path2: String); dynamic;
  85. procedure DoCreateFile(Path: String); dynamic;
  86. procedure DoDeleteFile(Path: String); dynamic;
  87. procedure DoDriveAdd(Path:String); dynamic;
  88. procedure DoDriveAddGui(Path: String); dynamic;
  89. procedure DoDriveRemove(Path: String); dynamic;
  90. procedure DoMediaInsert(Path: String); dynamic;
  91. procedure DoMediaRemove(Path: String); dynamic;
  92. procedure DoDirCreate(Path: String); dynamic;
  93. procedure DoNetShare(Path: String); dynamic;
  94. procedure DoNetUnShare(Path: String); dynamic;
  95. procedure DoRenameFolder(Path1, Path2: String); dynamic;
  96. procedure DoRenameItem(Path1, Path2: String); dynamic;
  97. procedure DoFolderRemove(Path: String); dynamic;
  98. procedure DoServerDisconnect(Path: String); dynamic;
  99. procedure DoDirUpdate(Path: String); dynamic;
  100. public
  101. constructor Create(AOwner: TComponent); override;
  102. destructor Destroy; override;
  103. published
  104. property Path: String read fPath write SetPath;
  105. property Active: Boolean read GetActive write SetActive;
  106. property WatchSubTree: Boolean read fWatch write SetWatch;
  107.  
  108. property WatchEvents: TNotificationEvents
  109. read fWatchEvents write SetWatchEvents;
  110.  
  111. property OnAssociationChange: TNotifyEvent
  112. read fOnAssociationChange write FOnAssociationChange;
  113.  
  114. property OnAttributesChange: TShellNotificationEvent2
  115. read fOnAttribChange write fOnAttribChange;
  116.  
  117. property OnFileCreate: TShellNotificationEvent1
  118. read FOnCreate write FOnCreate;
  119.  
  120. property OnFolderRename: TShellNotificationEvent2
  121. read FOnRenameFolder write FOnRenameFolder;
  122.  
  123. property OnFolderUpdate: TShellNotificationEvent1
  124. read FOnFolderUpdate write FOnFolderUpdate;
  125.  
  126. property OnFileDelete: TShellNotificationEvent1
  127. read FOnDelete write FOnDelete;
  128.  
  129. property OnDriveAdd: TShellNotificationEvent1
  130. read FOnDriveAdd write FOnDriveAdd;
  131.  
  132. property OnFolderRemove: TShellNotificationEvent1
  133. read FOnFolderRemove write FOnFolderRemove;
  134.  
  135. property OnItemRename: TShellNotificationEvent2
  136. read FOnItemRename write FOnItemRename;
  137.  
  138. property OnDriveAddGui: TShellNotificationEvent1
  139. read FOnDriveAddGui write FOnDriveAddGui;
  140.  
  141. property OnDriveRemove: TShellNotificationEvent1
  142. read FOnDriveRemove write FOnDriveRemove;
  143.  
  144. property OnMediaInserted: TShellNotificationEvent1
  145. read FOnMediaInsert write FOnMediaInsert;
  146.  
  147. property OnMediaRemove: TShellNotificationEvent1
  148. read FOnMediaRemove write FOnMediaRemove;
  149.  
  150. property OnDirCreate: TShellNotificationEvent1
  151. read FOnDirCreate write FOnDirCreate;
  152.  
  153. property OnNetShare: TShellNotificationEvent1
  154. read FOnNetShare write FOnNetShare;
  155.  
  156. property OnNetUnShare: TShellNotificationEvent1
  157. read FOnNetUnShare write FOnNetUnShare;
  158.  
  159. property OnServerDisconnect: TShellNotificationEvent1
  160. read FOnServerDisconnect write FOnServerDisconnect;
  161. end;
  162.  
  163. function SHChangeNotifyRegister( hWnd: HWND; dwFlags: integer;
  164. wEventMask : cardinal; uMsg: UINT; cItems : integer;
  165. lpItems : PNOTIFYREGISTER) : HWND; stdcall;
  166. function SHChangeNotifyDeregister(hWnd: HWND) : boolean; stdcall;
  167. function SHILCreateFromPath(Path: Pointer; PIDL: PItemIDList;
  168. var Attributes: ULONG):HResult; stdcall;
  169. implementation
  170.  
  171. const Shell32DLL = 'shell32.dll';
  172.  
  173. function SHChangeNotifyRegister; external Shell32DLL index 2;
  174. function SHChangeNotifyDeregister; external Shell32DLL index 4;
  175. function SHILCreateFromPath; external Shell32DLL index 28;
  176.  
  177. { TShellNotification }
  178.  
  179. procedure Register;
  180. begin
  181. RegisterComponents('FPiette', [ TShellNotification]);
  182. end;
  183.  
  184. constructor TShellNotification.Create(AOwner: TComponent);
  185. begin
  186. inherited Create( AOwner );
  187. if not (csDesigning in ComponentState) then
  188. Handle := AllocateHWnd(WndProc);
  189. end;
  190.  
  191. destructor TShellNotification.Destroy;
  192. begin
  193. if not (csDesigning in ComponentState) then
  194. Active := False;
  195. if Handle <> 0 then DeallocateHWnd( Handle );
  196. inherited Destroy;
  197. end;
  198.  
  199. procedure TShellNotification.DoAssociationChange;
  200. begin
  201. if Assigned( fOnAssociationChange ) and (neAssociationChange in fWatchEvents) then
  202. fOnAssociationChange( Self );
  203. end;
  204.  
  205. procedure TShellNotification.DoAttributesChange;
  206. begin
  207. if Assigned( fOnAttribChange ) then
  208. fOnAttribChange( Self, Path1, Path2 );
  209. end;
  210.  
  211. procedure TShellNotification.DoCreateFile(Path: String);
  212. begin
  213. if Assigned( fOnCreate ) then
  214. FOnCreate(Self, Path)
  215. end;
  216.  
  217. procedure TShellNotification.DoDeleteFile(Path: String);
  218. begin
  219. if Assigned( FOnDelete ) then
  220. FOnDelete(Self, Path);
  221. end;
  222.  
  223. procedure TShellNotification.DoDirCreate(Path: String);
  224. begin
  225. if Assigned( FOnDirCreate ) then
  226. FOnDirCreate( Self, Path );
  227. end;
  228.  
  229. procedure TShellNotification.DoDirUpdate(Path: String);
  230. begin
  231. if Assigned( FOnFolderUpdate ) then
  232. FOnFolderUpdate(Self, Path);
  233. end;
  234.  
  235. procedure TShellNotification.DoDriveAdd(Path: String);
  236. begin
  237. if Assigned( FOnDriveAdd ) then
  238. FOnDriveAdd(Self, Path);
  239. end;
  240.  
  241. procedure TShellNotification.DoDriveAddGui(Path: String);
  242. begin
  243. if Assigned( FOnDriveAddGui ) then
  244. FOnDriveAdd(Self, Path);
  245. end;
  246.  
  247. procedure TShellNotification.DoDriveRemove(Path: String);
  248. begin
  249. if Assigned( FOnDriveRemove ) then
  250. FOnDriveRemove(Self, Path);
  251. end;
  252.  
  253. procedure TShellNotification.DoFolderRemove(Path: String);
  254. begin
  255. if Assigned(FOnFolderRemove) then
  256. FOnFolderRemove( Self, Path );
  257. end;
  258.  
  259. procedure TShellNotification.DoMediaInsert(Path: String);
  260. begin
  261. if Assigned( FOnMediaInsert ) then
  262. FOnMediaInsert(Self, Path);
  263. end;
  264.  
  265. procedure TShellNotification.DoMediaRemove(Path: String);
  266. begin
  267. if Assigned(FOnMediaRemove) then
  268. FOnMediaRemove(Self, Path);
  269. end;
  270.  
  271. procedure TShellNotification.DoNetShare(Path: String);
  272. begin
  273. if Assigned(FOnNetShare) then
  274. FOnNetShare(Self, Path);
  275. end;
  276.  
  277. procedure TShellNotification.DoNetUnShare(Path: String);
  278. begin
  279. if Assigned(FOnNetUnShare) then
  280. FOnNetUnShare(Self, Path);
  281. end;
  282.  
  283. procedure TShellNotification.DoRenameFolder(Path1, Path2: String);
  284. begin
  285. if Assigned( FOnRenameFolder ) then
  286. FOnRenameFolder(Self, Path1, Path2);
  287. end;
  288.  
  289. procedure TShellNotification.DoRenameItem(Path1, Path2: String);
  290. begin
  291. if Assigned( FOnItemRename ) then
  292. FonItemRename(Self, Path1, Path2);
  293. end;
  294.  
  295. procedure TShellNotification.DoServerDisconnect(Path: String);
  296. begin
  297. if Assigned( FOnServerDisconnect ) then
  298. FOnServerDisconnect(Self, Path);
  299. end;
  300.  
  301. function TShellNotification.GetActive: Boolean;
  302. begin
  303. Result := (NotifyHandle <> 0) and (fActive);
  304. end;
  305.  
  306. function TShellNotification.PathFromPidl(Pidl: PItemIDList): String;
  307. begin
  308. SetLength(Result, Max_Path);
  309. if not SHGetPathFromIDList(Pidl, PChar(Result)) then Result := '';
  310. if pos(#0, Result) > 0 then
  311. SetLength(Result, pos(#0, Result));
  312. end;
  313.  
  314. procedure TShellNotification.SetActive(const Value: Boolean);
  315. begin
  316. if (Value <> fActive) then
  317. begin
  318. fActive := Value;
  319. if fActive then ShellNotifyRegister else ShellNotifyUnregister;
  320. end;
  321. end;
  322.  
  323. procedure TShellNotification.SetPath(const Value: String);
  324. begin
  325. if fPath <> Value then
  326. begin
  327. fPath := Value;
  328. ShellNotifyRegister;
  329. end;
  330. end;
  331.  
  332. procedure TShellNotification.SetWatch(const Value: Boolean);
  333. begin
  334. if fWatch <> Value then
  335. begin
  336. fWatch := Value;
  337. ShellNotifyRegister;
  338. end;
  339. end;
  340.  
  341. procedure TShellNotification.SetWatchEvents(
  342. const Value: TNotificationEvents);
  343. begin
  344. if fWatchEvents <> Value then
  345. begin
  346. fWatchEvents := Value;
  347. ShellNotifyRegister;
  348. end;
  349. end;
  350.  
  351. procedure TShellNotification.ShellNotifyRegister;
  352. var
  353. NotifyRecord: PNOTIFYREGISTER;
  354. Flags: DWORD;
  355. Pidl: PItemIDList;
  356. Attributes: ULONG;
  357. begin
  358. if not (csDesigning in ComponentState) and
  359. not (csLoading in ComponentState) then
  360. begin
  361. SHGetSpecialFolderLocation(Handle,CSIDL_DRIVES,Pidl);
  362. NotifyRecord^.pidlPath := Pidl;
  363. NotifyRecord^.bWatchSubtree := fWatch;
  364.  
  365. if NotifyHandle <> 0 then ShellNotifyUnregister;
  366. Flags := 0;
  367. if neAssociationChange in FWatchEvents then
  368. Flags := Flags or SHCNE_ASSOCCHANGED;
  369. if neAttributesChange in FWatchEvents then
  370. Flags := Flags or SHCNE_ATTRIBUTES;
  371. if neFileChange in FWatchEvents then
  372. Flags := Flags or SHCNE_UPDATEITEM;
  373. if neFileCreate in FWatchEvents then
  374. Flags := Flags or SHCNE_CREATE;
  375. if neFileDelete in FWatchEvents then
  376. Flags := Flags or SHCNE_DELETE;
  377. if neFileRename in FWatchEvents then
  378. Flags := Flags or SHCNE_RENAMEITEM;
  379. if neDriveAdd in FWatchEvents then
  380. Flags := Flags or SHCNE_DRIVEADD;
  381. if neDriveRemove in FWatchEvents then
  382. Flags := Flags or SHCNE_DRIVEREMOVED;
  383. if neShellDriveAdd in FWatchEvents then
  384. Flags := Flags or SHCNE_DRIVEADDGUI;
  385. if neDriveSpaceChange in FWatchEvents then
  386. Flags := Flags or SHCNE_FREESPACE;
  387. if neMediaInsert in FWatchEvents then
  388. Flags := Flags or SHCNE_MEDIAINSERTED;
  389. if neMediaRemove in FWatchEvents then
  390. Flags := Flags or SHCNE_MEDIAREMOVED;
  391. if neFolderCreate in FWatchEvents then
  392. Flags := Flags or SHCNE_MKDIR;
  393. if neFolderDelete in FWatchEvents then
  394. Flags := Flags or SHCNE_RMDIR;
  395. if neFolderRename in FWatchEvents then
  396. Flags := Flags or SHCNE_RENAMEFOLDER;
  397. if neFolderUpdate in FWatchEvents then
  398. Flags := Flags or SHCNE_UPDATEDIR;
  399. if neNetShare in FWatchEvents then
  400. Flags := Flags or SHCNE_NETSHARE;
  401. if neNetUnShare in FWatchEvents then
  402. Flags := Flags or SHCNE_NETUNSHARE;
  403. if neServerDisconnect in FWatchEvents then
  404. Flags := Flags or SHCNE_SERVERDISCONNECT;
  405. if neImageListChange in FWatchEvents then
  406. Flags := Flags or SHCNE_UPDATEIMAGE;
  407. NotifyHandle := SHChangeNotifyRegister(Handle,
  408. SHCNF_ACCEPT_INTERRUPTS or SHCNF_ACCEPT_NON_INTERRUPTS,
  409. Flags, SNM_SHELLNOTIFICATION, 1, NotifyRecord);
  410. end;
  411. end;
  412.  
  413. procedure TShellNotification.ShellNotifyUnregister;
  414. begin
  415. if NotifyHandle <> 0 then
  416. SHChangeNotifyDeregister(NotifyHandle);
  417. end;
  418.  
  419. procedure TShellNotification.WndProc(var Message: TMessage);
  420. type
  421. TPIDLLIST = record
  422. pidlist : array[1..2] of PITEMIDLIST;
  423. end;
  424. PIDARRAY = ^TPIDLLIST;
  425. var
  426. Path1 : string;
  427. Path2 : string;
  428. ptr : PIDARRAY;
  429. repeated : boolean;
  430. event : longint;
  431.  
  432. begin
  433. case Message.Msg of
  434. SNM_SHELLNOTIFICATION:
  435. begin
  436. event := Message.LParam and ($7FFFFFFF);
  437. Ptr := PIDARRAY(Message.WParam);
  438.  
  439. Path1 := PathFromPidl( Ptr^.pidlist[1] );
  440. Path2 := PathFromPidl( Ptr^.pidList[2] );
  441.  
  442. repeated := (PrevEvent = event)
  443. and (uppercase(prevpath1) = uppercase(Path1))
  444. and (uppercase(prevpath2) = uppercase(Path2));
  445.  
  446. if Repeated then exit;
  447.  
  448. PrevEvent := Message.Msg;
  449. prevPath1 := Path1;
  450. prevPath2 := Path2;
  451.  
  452. case event of
  453. SHCNE_ASSOCCHANGED : DoAssociationChange;
  454. SHCNE_ATTRIBUTES : DoAttributesChange( Path1, Path2);
  455. SHCNE_CREATE : DoCreateFile(Path1);
  456. SHCNE_DELETE : DoDeleteFile(Path1);
  457. SHCNE_DRIVEADD : DoDriveAdd(Path1);
  458. SHCNE_DRIVEADDGUI : DoDriveAddGui(path1);
  459. SHCNE_DRIVEREMOVED : DoDriveRemove(Path1);
  460. SHCNE_MEDIAINSERTED : DoMediaInsert(Path1);
  461. SHCNE_MEDIAREMOVED : DoMediaRemove(Path1);
  462. SHCNE_MKDIR : DoDirCreate(Path1);
  463. SHCNE_NETSHARE : DoNetShare(Path1);
  464. SHCNE_NETUNSHARE : DoNetUnShare(Path1);
  465. SHCNE_RENAMEFOLDER : DoRenameFolder(Path1, Path2);
  466. SHCNE_RENAMEITEM : DoRenameItem(Path1, Path2);
  467. SHCNE_RMDIR : DoFolderRemove(Path1);
  468. SHCNE_SERVERDISCONNECT : DoServerDisconnect(Path);
  469. SHCNE_UPDATEDIR : DoDirUpdate(Path);
  470. SHCNE_UPDATEIMAGE : ;
  471. SHCNE_UPDATEITEM : ;
  472. end;//Case event of
  473. end;//SNM_SHELLNOTIFICATION
  474. end; //case
  475. end;
  476.  
  477.  
  478.  
  479. end.
  480.  


Demosha Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: Demosha (статус: Посетитель)
Вопрос отправлен: 14 января 2013, 11:38
Состояние вопроса: открыт, ответов: 0.


Мини-форум вопроса

Всего сообщений: 5; последнее сообщение — 12 февраля 2013, 01:32; участников в обсуждении: 3.
Ed

Ed (статус: 1-ый класс), 16 января 2013, 15:59 [#1]:

Создал (?) и подключил данный Unit...
...как использовать данный код(!!!)

Как то не логично, не? :-D
Demosha

Demosha (статус: Посетитель), 16 января 2013, 18:04 [#2]:

что тебя так стесняет?!
bugmenot

bugmenot (статус: 3-ий класс), 4 февраля 2013, 19:08 [#3]:

Создал этот юнит некто Elliott Shevin
http://delphi.about.com/library/code/ncaa030403b.htm
виконання програми розпочинається з того самого мiсця, де призупинилося.

Demosha

Demosha (статус: Посетитель), 6 февраля 2013, 00:21 [#4]:

у меня был код, а не unit, конечно же можно догадаться, что если бы я и код написал, то не стал бы просить помощи в нем разобраться. спасибо bugmenot, выручил
bugmenot

bugmenot (статус: 3-ий класс), 12 февраля 2013, 01:32 [#5]:

Цитата (Demosha):

можно узнать как искал?

Да элементарно. Выделил код, поискал в Гугле, среди результатов выбрал тот, где копирайты не вытерты.
виконання програми розпочинається з того самого мiсця, де призупинилося.

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.

Версия движка: 2.6+ (26.01.2011)
Текущее время: 26 мая 2020, 00:33
Выполнено за 0.02 сек.
Рейтинг@Mail.ru