Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Rhinorhino on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

How do I set shell events and receive their notifications?

How To

How do I set shell events and receive their notifications?

by  Glenn9999  Posted    (Edited  )
This is a component I came up with in writing something which I thought might be useful to someone. What it does is enable the registration of Windows shell events along with the reception of those events. You'll have to experiment to see what you can do with it, overall.

The Unit
Code: 
unit shellevents;
  // a component to set and receive shell events.  Written by Glenn9999 @ tek-tips.com
interface
  uses shellapi, shlobj, activex, windows, classes, messages, sysutils,
       controls, forms;

// all constants are related to shell api calls added in this unit.
const
  SCHNE_RENAMEITEM = $01;
  SCHNE_CREATE = $02;
  SCHNE_DELETE = $04;
  SCHNE_MKDIR = $08;
  SCHNE_RMDIR = $10;
  SCHNE_MEDIAINSERTED = $20;
  SCHNE_MEDIAREMOVED = $40;
  SCHNE_DRIVEREMOVED = $80;
  SCHNE_DRIVEADD = $100;
  SCHNE_NETSHARE = $200;
  SCHNE_NETUNSHARE = $400;
  SCHNE_ATTRIBUTES = $800;
  SCHNE_UPDATEDIR = $1000;
  SCHNE_UPDATEITEM = $2000;
  SCHNE_SERVERDISCONNECT = $4000;
  SCHNE_UPDATEIMAGE = $8000;
  SCHNE_DRIVEADDGUI = $10000;
  SCHNE_RENAMEFOLDER = $20000;
  SCHNE_FREESPACE = $40000;
  SCHNE_EXTENDED_EVENT = $04000000;
  SHCNE_ASSOCCHANGED =   $08000000;
  SCHNE_DISKEVENTS =     $0002381F;
  SCHNE_GLOBALEVENTS =   $0C0581E0;
  SCHNE_ALLEVENTS =      $7FFFFFFF;
  SCHNE_INTERRUPT =      $80000000;
  SHCNRF_INTERRUPTLEVEL = $0001;
  SHCNRF_SHELLLEVEL = $0002;
  SHCNRF_RECURSIVEINTERRUPT = $1000;
  SHCNRF_NEWDELIVERY = $8000;

type
  // declarations related to shell api calls added to this unit.
  TSHNotifyStruct = packed record
    dw1: PItemIDList;
    dw2: PItemIDList;
  end;
  PSHNotifyStruct = ^TSHNotifyStruct;
  TSHChangeNotifyEntry = record
    pidl: PItemIdList;
    fRecursive: BOOL;
  end;

  // declarations related to the shell events component here.
  TShellEvent = (seRenameItem, seCreate, seDelete, seMkDir, seRmDir,
         seMediaInserted, seMediaRemoved, seDriveRemoved, seDriveAdd,
         seNetShare, seNetUnShare, seAttributes, seUpdateDir, seUpdateItem,
         seServerDisconnect, seUpdateImage, seDriveAddGUI, seRenameFolder,
         seFreeSpace, seExtendedEvent, seAssocChanged);
  TShellEventSet = set of TShellEvent;
  TShellNotifyEvent = procedure (Sender: TObject; LEvent: TShellEvent;
                      pidl1: PItemIDList; pidl2:PItemIDList) of object;
  TShellNotifyHandler = class(TComponent)
  private
    FWndProc: TWndMethod;
    FShellMsg: DWord;
    FOnShellNotify: TShellNotifyEvent;
    FEvents: TShellEventSet;
    FRecursive: Boolean;

    function IsTwoParmEvent(LEvent: Longint): boolean;
    function IsItemNotificationEvent(lEvent: Longint): boolean;
    function EventSetToDWord(FEvents: TShellEventSet): DWord;
    function DWordToShellEvent(FEvent: DWord): TShellEvent;
  public
    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;
    function ShellEventString(inevent: TShellEvent): String;
    function RegisterPIDL(FHWnd: HWnd; pidl: PitemIDList):THandle;
    function Deregister(MonitorHandle: THandle): boolean;
    procedure WindowProc(Var msg: TMessage);
  published
    property Events: TShellEventSet read FEvents write FEvents;
    property Recursive: Boolean read FRecursive write FRecursive;
    property ShellMsg: DWord read FShellMsg write FShellMsg;
    property OnShellNotify: TShellNotifyEvent read FOnShellNotify write FOnShellNotify;
  end;

function SHChangeNotifyRegister(OwnerHwnd: HWnd; fSources: integer;
         fEvents: Dword; wmsg: UINT; cEntries: Integer;
         var pshcne: TSHChangeNotifyEntry): HResult; stdcall;

function SHChangeNotifyDeRegister(ulID: DWord): BOOL; stdcall;

function SHChangeNotification_Lock(hChangeNotification: THandle; dwProcessID: DWord;
         out pppidl: PSHNotifyStruct; out plEvent: Longint): THandle; stdcall;

function SHChangeNotification_Unlock(hLock: THandle): Boolean; stdcall;

procedure Register;

implementation

function SHChangeNotifyRegister; external shell32 name 'SHChangeNotifyRegister';

function SHChangeNotifyDeRegister; external shell32 name 'SHChangeNotifyDeregister';

function SHChangeNotification_Lock;
                        external shell32 name 'SHChangeNotification_Lock';

function SHChangeNotification_Unlock;
                        external shell32 name 'SHChangeNotification_Unlock';

function TShellNotifyHandler.IsTwoParmEvent(LEvent: Longint): boolean;
// takes an event type and returns whether two parms are expected or not
  var
    flagval: Longint;
  begin
    // SCHNE_ASSOCCHANGED is listed in this function and the one below, which is it?
    flagval := (lEvent and ({SHCNE_ASSOCCHANGED or }SHCNE_RENAMEFOLDER
                or SHCNE_RENAMEITEM));
    Result := (flagval > 0);
  end;

function TShellNotifyHandler.IsItemNotificationEvent(lEvent: Longint): boolean;
// takes event type and returns whether event has no parms.
  var
    flagval: Longint;
  begin
    flagval := (lEvent and (SCHNE_UPDATEIMAGE or SHCNE_ASSOCCHANGED
                or SHCNE_EXTENDED_EVENT or SHCNE_FREESPACE
                or SHCNE_DRIVEADDGUI or SHCNE_SERVERDISCONNECT));
    Result := (flagval > 0);
  end;

procedure TShellNotifyHandler.WindowProc(Var msg: TMessage);
// event processing proc for the form.
var
  hNotifyLock: THandle;
  lEvent: Longint;
  pgpidl: PSHNotifyStruct;
begin
  if Msg.Msg = FShellMsg then
    begin
      hNotifyLock := SHChangeNotification_Lock(THandle(Msg.WParam),DWord(Msg.LParam),
                     pgpidl, lEvent);
      if (hNotifyLock <> 0) then
        begin
          if Assigned(FOnShellNotify) then
            begin
              if IsItemNotificationEvent(Levent) then
                 FOnShellNotify(Self, DWordToShellEvent(LEvent), nil, nil)
              else
              if IsTwoParmEvent(Levent) then
                 FOnShellNotify(Self, DWordToShellEvent(LEvent), pgpidl^.dw1, pgpidl^.dw2)
              else
                 FOnShellNotify(Self, DWordToShellEvent(LEvent), pgpidl^.dw1, nil);
            end;
          SHChangeNotification_Unlock(hNotifyLock);
        end;
    end
  else
    FWndProc(Msg);
end;

Constructor TShellNotifyHandler.Create(AOwner: TComponent);
  begin
    FWndProc := TForm(AOwner).WindowProc;
    TForm(AOwner).WindowProc := WindowProc;
    inherited create(aowner);
  end;

Destructor TShellNotifyHandler.Destroy;
  begin
    Inherited;
  end;

function TShellNotifyHandler.ShellEventString(inevent: TShellEvent): String;
  // takes TShellEvent type and returns string representation of the value
  begin
    case inevent of
      seRenameItem: Result := 'seRenameItem';
      seCreate: Result := 'seCreate';
      seDelete: Result := 'seDelete';
      seMkDir: Result := 'seMkDir';
      seRmDir: Result := 'seRmDir';
      seMediaInserted: Result := 'seMediaInserted';
      seMediaRemoved: Result := 'seMediaRemoved';
      seDriveRemoved: Result := 'seDriveRemoved';
      seDriveAdd: Result := 'seDriveAdd';
      seNetShare: Result := 'seNetShare';
      seNetUnshare: Result := 'seNetUnshare';
      seAttributes: Result := 'seAttributes';
      seUpdateDir: Result := 'seUpdateDir';
      seUpdateItem: Result := 'seUpdateItem';
      seServerDisconnect: Result := 'seServerDisconnect';
      seUpdateImage: Result := 'seUpdateImage';
      seDriveAddGUI: Result := 'seDriveAddGUI';
      seRenameFolder: Result := 'seRenameFolder';
      seFreeSpace: Result := 'seFreeSpace';
      seExtendedEvent: Result := 'seExtendedEvent';
      seAssocChanged: Result := 'seAssocChanged';
    else
      Result := 'UnknownEvent';
    end;
  end;

function TShellNotifyHandler.DWordToShellEvent(FEvent: DWord): TShellEvent;
// puts a single SHChangeNotifyRegister event to TShellEvent;
  begin
    case FEvent of
      SCHNE_RENAMEITEM: Result := seRenameItem;
      SCHNE_CREATE: Result := seCreate;
      SCHNE_DELETE: Result := seDelete;
      SCHNE_MKDIR: Result := seMkDir;
      SCHNE_RMDIR: Result := seRmDir;
      SCHNE_MEDIAINSERTED: Result := seMediaInserted;
      SCHNE_MEDIAREMOVED: Result := seMediaRemoved;
      SCHNE_DRIVEREMOVED: Result := seDriveRemoved;
      SCHNE_DRIVEADD: Result := seDriveAdd;
      SCHNE_NETSHARE: Result := seNetShare;
      SCHNE_NETUNSHARE: Result := seNetUnShare;
      SCHNE_ATTRIBUTES: Result := seAttributes;
      SCHNE_UPDATEDIR: Result := seUpdateDir;
      SCHNE_UPDATEITEM: Result := seUpdateItem;
      SCHNE_SERVERDISCONNECT: Result := seServerDisconnect;
      SCHNE_UPDATEIMAGE: Result := seUpdateImage;
      SCHNE_DRIVEADDGUI: Result := seDriveAddGUI;
      SCHNE_RENAMEFOLDER: Result := seRenameFolder;
      SCHNE_FREESPACE: Result := seFreeSpace;
      SCHNE_EXTENDED_EVENT: Result := seExtendedEvent;
      SHCNE_ASSOCCHANGED: Result := seAssocChanged;
    end;
  end;

function TShellNotifyHandler.EventSetToDWord(FEvents: TShellEventSet): DWord;
  begin
    // convert FEvents to something SHChangeNotifyRegister understands
    Result := 0;
    if seRenameItem in FEvents then
      Result := Result or SCHNE_RENAMEITEM;
    if seCreate in FEvents then
      Result := Result or SCHNE_CREATE;
    if seDelete in FEvents then
      Result := Result or SCHNE_DELETE;
    if seMkDir in FEvents then
      Result := Result or SCHNE_MKDIR;
    if seRmDir in FEvents then
      Result := Result or SCHNE_RMDIR;
    if seMediaInserted in FEvents then
      Result := Result or SCHNE_MEDIAINSERTED;
    if seMediaRemoved in FEvents then
      Result := Result or SCHNE_MEDIAREMOVED;
    if seDriveRemoved in FEvents then
      Result := Result or SCHNE_DRIVEREMOVED;
    if SeDriveAdd in FEvents then
      Result := Result or SCHNE_DRIVEADD;
    if seNetShare in FEvents then
      Result := Result or SCHNE_NETSHARE;
    if seNetUnShare in FEvents then
      Result := Result or SCHNE_NETUNSHARE;
    if seAttributes in FEvents then
      Result := Result or SCHNE_ATTRIBUTES;
    if seUpdateDir in FEvents then
      Result := Result or SCHNE_UPDATEDIR;
    if SeUpdateItem in FEvents then
      Result := Result or SCHNE_UPDATEITEM;
    if SeServerDisconnect in FEvents then
      Result := Result or SCHNE_SERVERDISCONNECT;
    if SeUpdateImage in FEvents then
      Result := Result or SCHNE_UPDATEIMAGE;
    if SeDriveAddGUI in FEvents then
      Result := Result or SCHNE_DRIVEADDGUI;
    if SeRenameFolder in FEvents then
      Result := Result or SCHNE_RENAMEFOLDER;
    if SEFreeSpace in FEvents then
      Result := Result or SCHNE_FREESPACE;
    if seExtendedEvent in FEvents then
      Result := Result or SCHNE_EXTENDED_EVENT;
    if seAssocChanged in FEvents then
      Result := Result or SHCNE_ASSOCCHANGED;
  end;

function TShellNotifyHandler.RegisterPIDL(FHWnd: HWnd; pidl: PitemIDList):THandle;
// this is used to register a shell event.
  var
    stPIDL: TSHChangeNotifyEntry;
  begin
    stPIDL.pidl := pidl;
    stPIDL.fRecursive := FRecursive;

    Result := SHChangeNotifyRegister(FHWnd,
           SHCNRF_INTERRUPTLEVEL or SHCNRF_SHELLLEVEL
           or SHCNRF_RECURSIVEINTERRUPT or SHCNRF_NEWDELIVERY,
           EventSetToDWord(FEvents),
           FShellMsg, 1, stPIDL);
  end;

function TShellNotifyHandler.Deregister(MonitorHandle: THandle): boolean;
// this is used to unregister a shell event.
begin
  Result := SHChangeNotifyDeregister(MonitorHandle);
end;


procedure Register;
begin
  RegisterComponents('Samples', [TShellNotifyHandler]);
end;

end.

A usage example on a form with the component added to it.
This is out of the project I made this component for. CheckRecycle tests the drive path for the presence of a recycle bin folder.

This registers events necessary for the program to function.
Code: 
procedure TForm1.RegisterRecycleBin;
// registers shell events for all physical directories related to Recycle Bins.
var
  drivestrings: array[1..128] of char;
  PDrive: PChar;

  pidl: PItemIDList;
  isf: IShellFolder;
  ipath: WideString;
  Eaten, attr: DWord;
begin
  // windows message this event is to fire when something occurs
  ShellNotifyHandler1.ShellMsg := WM_SHELLNOTIFY;
  // remove directory, rename folder, delete file, rename file.
  ShellNotifyHandler1.Events := [seRmDir, seRenameFolder, seDelete, seRenameItem];
  ShellNotifyHandler1.Recursive := true;
  GetLogicalDriveStrings(Sizeof(DriveStrings), Pchar(@drivestrings[1]));
  PDrive := @DriveStrings;
  SHGetDesktopFolder(isf);
  notifyrbincount := 1;
  while PDrive^ <> #0 do
    begin
      if GetDriveType(pDrive) in [2..4, 6] then
        begin
          ipath := WideString(checkrecycle(pdrive));
          isf.ParseDisplayName(Form1.Handle, nil, PWideChar(ipath), Eaten, pidl, attr);
           // registers the event.  Generates a DWord Event handle which needs to be unregistered at end.
          NotifyRBin[notifyrbincount] := ShellNotifyHandler1.RegisterPIDL(Form1.Handle, pidl);
          inc(notifyrbincount);
        end;
      Inc(pDrive, 4);
    end;
end;

This unregisters all the events the above procedure creates.
Code: 
procedure TForm1.FormDestroy(Sender: TObject);
var
  i: integer;
begin
  for i := 1 to notifyrbincount do
    ShellNotifyHandler1.Deregister(NotifyRBin[i]);
end;

This is a shell event response. For the code I did this in, only "RefreshScreen;" is required, but I put a memo box on the form to report the kinds of events that are coming into the program.
Code: 
procedure TForm1.ShellNotifyHandler1ShellNotify(Sender: TObject;
  LEvent: TShellEvent; pidl1, pidl2: PItemIDList);
var
  psi1, psi2: array[1..MAX_PATH] of AnsiChar;
  outstr: string;
begin
  // write the event type into words.
  outstr := 'Event received: ' + ShellNotifyHandler1.ShellEventString(LEvent);
{ the events have a number of parms (pidls) depending on the event which indicate what the event is in reference to.  Specific to the event there may be zero, one, or two parms.  If the parm is nil, that means it's not valid for the event in question }
  if (pidl1 <> nil) then
    begin
      SHGetPathFromIDListA(pidl1, @psi1);
      outstr := outstr + ' Parm 1: ' +  string(psi1);
    end;
  if (pidl2 <> nil) then
    begin
      SHGetPathFromIDListA(pidl2, @psi2);
      outstr := outstr + ' Parm 2: ' +  string(psi2);
    end;
  Memo1.Lines.Add(outstr);
  RefreshScreen;
end;

Please let me know in the thread announcing this if there are any issues or questions. Thanks.
Register to add this FAQ to your archive
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top