Delphi World - Получение уведомлений от оболочки (Shell)
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Получение уведомлений от оболочки (Shell)

Автор: maniac_n@hotmail.com

Программер играет в шахматы с компьютером и получает мат на 15 ходу. В сердцах бьет по клавиатуре: - Проклятый виндоз, опять глючит.

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


{$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;
    end;
  end;
end;

end.

Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования