Исходники.RU - Информационный сервер для программистов: исходники со всего света.

Получение уведомлений от оболочки (shell)

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

Совместимость Delphi 3 (или выше)

<--------------  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.

<------------------ End Unit Code -------------------------->