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;
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;
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;
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.
Talk To Other Members