Monitorear la shell desde delphi

[fide]

Hola. Aqui un componente que monitorea la shell y notifica una cantidad de cosas que pueden ser de utilidad...

Aqui les pongo primeramente las explicaciones de la cabecera. Que no entraban en el post:



//*************************************************************
//*************************************************************
// TSHChangeNotify component by Elliott Shevin shevine@aol.com
// vers. 3.0, October 2000
//
// See the README.TXT file for revision history.
//
//*
//* I owe this component to James Holderness, who described the
//* use of the undocumented Windows API calls it depends upon,
//* and Brad Martinez, who coded a similar function in Visual
//* Basic. I quote here from Brad's expression of gratitude to
//* James:
//* Interpretation of the shell's undocumented functions
//* SHChangeNotifyRegister (ordinal 2) and SHChangeNotifyDeregister
//* (ordinal 4) would not have been possible without the
//* assistance of James Holderness. For a complete (and probably
//* more accurate) overview of shell change notifcations,
//* please refer to James' "Shell Notifications" page at
//* http://www.geocities.com/SiliconValley/4942/
//*
//* This component will let you know when selected events
//* occur in the Windows shell, such as files and folders
//* being renamed, added, or deleted. (Moving an item yields
//* the same results as renaming it.) For the complete list
//* of events the component can trap, see Win32 Programmer's
//* reference description of the SHChangeNotify API call.
//*
//* Properties:
//* MessageNo: the Windows message number which will be used to signal
//* a trapped event. The default is WM_USER (1024); you may
//* set it to some other value if you're using WM_USER for
//* any other purpose.
//* TextCase: tcAsIs (default), tcLowercase, or tcUppercase, determines
//* whether and how the Path parameters passed to your event
//* handlers are case-converted.
//* HardDriveOnly: when set to True, the component monitors only local
//* hard drive partitions; when set to False, monitors the
//* entire file system.
//*
//* Methods:
//* Execute: Begin monitoring the selected shell events.
//* Stop: Stop monitoring.
//*
//* Events:
//* The component has an event corresponding to each event it can
//* trap, e.g. OnCreate, OnMediaInsert, etc.
//* Each event handler is passed either three or four parameters--
//* Sender=this component.
//* Flags=the value indentifying the event that triggered the handler,
//* from the constants in the SHChangeNotify help. This parameter
//* allows multiple events to share handlers and still distinguish
//* the reason the handler was triggered.
//* Path1, Path2: strings which are the paths affected by the shell
//* event. Whether both are passed depends on whether the second
//* is needed to describe the event. For example, OnDelete gives
//* only the name of the file (including path) that was deleted;
//* but OnRenameFolder gives the original folder name in Path1
//* and the new name in Path2.
//* In some cases, such as OnAssocChanged, neither Path parameter
//* means anything, and in other cases, I guessed, but we always
//* pass at least one.
//* Each time an event property is changed, the component is reset to
//* trap only those events for which handlers are assigned. So assigning
//* an event handler suffices to indicate your intention to trap the
//* corresponding shell event.
//*
//* There is one more event: OnEndSessionQuery, which has the same
//* parameters as the standard Delphi OnCloseQuery (and can in fact
//* be your OnCloseQuery handler). This component must shut down its
//* interception of shell events when system shutdown is begun, lest
//* the system fail to shut down at the user's request.
//*
//* Setting CanEndSession (same as CanClose) to FALSE in an
//* OnEndSessionQuery will stop the process of shutting down
//* Windows. You would only need this if you need to keep the user
//* from ending his Windows session while your program is running.
//*
//* I'd be honored to hear what you think of this component.
//* You can write me at shevine@aol.com.
//*************************************************************
//*************************************************************

{
********************************************
Zarko Gajic
About.com Guide to Delphi Programming
http://delphi.about.com
email: delphi.guide@about.com
free newsletter: http://delphi.about.com/library/blnewsletter.htm
forum: http://forums.about.com/ab-delphi/start/
********************************************
}

[fide]

Aqui la Unit del componente...


unit SHChangeNotify;
{$IFNDEF VER80} {$IFNDEF VER90} {$IFNDEF VER93}
{$DEFINE Delphi3orHigher}
{$ENDIF} {$ENDIF} {$ENDIF}

interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
{$IFNDEF Delphi3orHigher}
OLE2,
{$ELSE}
ActiveX, ComObj,
{$ENDIF}
ShlObj;
const
SHCNF_ACCEPT_INTERRUPTS = $0001;
SHCNF_ACCEPT_NON_INTERRUPTS = $0002;
SHCNF_NO_PROXY = $8000;
type NOTIFYREGISTER = record
pidlPath : PItemIDList;
bWatchSubtree : boolean;
end;
type PNOTIFYREGISTER = ^NOTIFYREGISTER;
type TTextCase = (tcAsIs,tcUppercase,tcLowercase);
type
TOneParmEvent = procedure(Sender : TObject; Flags : cardinal; Path1 : string) of object;
TTwoParmEvent = procedure(Sender : TObject; Flags : cardinal; Path1, Path2 : string) of object;
TEndSessionQueryEvent = procedure(Sender: TObject; var CanEndSession: Boolean) of object;
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;

type
TSHChangeNotify = class(TComponent)
private
fTextCase : TTextCase;
fHardDriveOnly : boolean;
NotifyCount : integer;
NotifyHandle : hwnd;
NotifyArray : array[1..26] of NOTIFYREGISTER;
AllocInterface : IMalloc;
PrevMsg : integer;
prevpath1 : string;
prevpath2 : string;
fMessageNo : integer;
fAssocChanged : TTwoParmEvent;
fAttributes : TOneParmEvent;
fCreate : TOneParmEvent;
fDelete : TOneParmEvent;
fDriveAdd : TOneParmEvent;
fDriveAddGUI : TOneParmEvent;
fDriveRemoved : TOneParmEvent;
fMediaInserted : TOneParmEvent;
fMediaRemoved : TOneParmEvent;
fMkDir : TOneParmEvent;
fNetShare : TOneParmEvent;
fNetUnshare : TOneParmEvent;
fRenameFolder : TTwoParmEvent;
fRenameItem : TTwoParmEvent;
fRmDir : TOneParmEvent;
fServerDisconnect : TOneParmEvent;
fUpdateDir : TOneParmEvent;
fUpdateImage : TOneParmEvent;
fUpdateItem : TOneParmEvent;
fEndSessionQuery : TEndSessionQueryEvent;
OwnerWindowProc : TWndMethod;
procedure SetMessageNo(value : integer);
procedure WndProc(var msg: TMessage);
protected
procedure QueryEndSession(var msg: TMessage);
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure Execute;
procedure Stop;
published
property MessageNo : integer read fMessageNo write SetMessageNo default WM_USER;
property TextCase : TTextCase read fTextCase write fTextCase default tcAsIs;
property HardDriveOnly : boolean read fHardDriveOnly write fHardDriveOnly default True;
property OnAssocChanged : TTwoParmEvent read fAssocChanged write fAssocChanged;
property OnAttributes : TOneParmEvent read fAttributes write fAttributes;
property OnCreate : TOneParmEvent read fCreate write fCreate;
property OnDelete : TOneParmEvent read fDelete write fDelete;
property OnDriveAdd : TOneParmEvent read fDriveAdd write fDriveAdd;
property OnDriveAddGUI : TOneParmEvent read fDriveAddGUI write fDriveAddGUI;
property OnDriveRemoved : TOneParmEvent read fDriveRemoved write fDriveRemoved;
property OnMediaInserted : TOneParmEvent read fMediaInserted write fMediaInserted;
property OnMediaRemoved : TOneParmEvent read fMediaRemoved write fMediaRemoved;
property OnMkDir : TOneParmEvent read fMkDir write fMkDir;
property OnNetShare : TOneParmEvent read fNetShare write fNetShare;
property OnNetUnshare : TOneParmEvent read fNetUnshare write fNetUnshare;
property OnRenameFolder : TTwoParmEvent read fRenameFolder write fRenameFolder;
property OnRenameItem : TTwoParmEvent read fRenameItem write fRenameItem;
property OnRmDir : TOneParmEvent read fRmDir write fRmDir;
property OnServerDisconnect : TOneParmEvent read fServerDisconnect write fServerDisconnect;
property OnUpdateDir : TOneParmEvent read fUpdateDir write fUpdateDir;
property OnUpdateImage : TOneParmEvent read fUpdateImage write fUpdateImage;
property OnUpdateItem : TOneParmEvent read fUpdateItem write fUpdateItem;
property OnEndSessionQuery : TEndSessionQueryEvent
read fEndSessionQuery write fEndSessionQuery;
{ Published declarations }
end;
procedure Register;
implementation
const Shell32DLL = 'shell32.dll';
function SHChangeNotifyRegister;
external Shell32DLL index 2;
function SHChangeNotifyDeregister;
external Shell32DLL index 4;
function SHILCreateFromPath;
external Shell32DLL index 28;
procedure Register;
begin
RegisterComponents('Custom', [TSHChangeNotify]);
end;
// Set defaults, and ensure NotifyHandle is zero.
constructor TSHChangeNotify.Create (AOwner : TComponent);
begin
inherited Create(AOwner);
fTextCase := tcAsIs;
fHardDriveOnly := true;
fAssocChanged := nil;
fAttributes := nil;
fCreate := nil;
fDelete := nil;
fDriveAdd := nil;
fDriveAddGUI := nil;
fDriveRemoved := nil;
fMediaInserted := nil;
fMediaRemoved := nil;
fMkDir := nil;
fNetShare := nil;
fNetUnshare := nil;
fRenameFolder := nil;
fRenameItem := nil;
fRmDir := nil;
fServerDisconnect := nil;
fUpdateDir := nil;
fUpdateImage := nil;
fUpdateItem := nil;
fEndSessionQuery := nil;
MessageNo := WM_USER;
// If designing, dodge the code that implements messag interception.
if csDesigning in ComponentState
then exit;
// Substitute our window proc for our owner's window proc.
OwnerWindowProc := (Owner as TWinControl).WindowProc;
(Owner as TWinControl).WindowProc := WndProc;
// Get the IMAlloc interface so we can free PIDLs.
SHGetMalloc(AllocInterface);
end;
procedure TSHChangeNotify.SetMessageNo(value : integer);
begin
if (value >= WM_USER)
then fMessageNo := value
else raise Exception.Create
('MessageNo must be greater than or equal to '
+ inttostr(WM_USER));
end;
// Execute unregisters any current notification and registers a new one.
procedure TSHChangeNotify.Execute;
var
EventMask : integer;
driveletter : string;
i : integer;
pidl : PItemIDList;
Attributes : ULONG;
NotifyPtr : PNOTIFYREGISTER;
begin
NotifyCount := 0;
if csDesigning in ComponentState
then exit;
Stop; // Unregister the current notification, if any.
EventMask := 0;
if assigned(fAssocChanged ) then EventMask := (EventMask or SHCNE_ASSOCCHANGED);
if assigned(fAttributes ) then EventMask := (EventMask or SHCNE_ATTRIBUTES);
if assigned(fCreate ) then EventMask := (EventMask or SHCNE_CREATE);
if assigned(fDelete ) then EventMask := (EventMask or SHCNE_DELETE);
if assigned(fDriveAdd ) then EventMask := (EventMask or SHCNE_DRIVEADD);
if assigned(fDriveAddGUI ) then EventMask := (EventMask or SHCNE_DRIVEADDGUI);
if assigned(fDriveRemoved ) then EventMask := (EventMask or SHCNE_DRIVEREMOVED);
if assigned(fMediaInserted ) then EventMask := (EventMask or SHCNE_MEDIAINSERTED);
if assigned(fMediaRemoved ) then EventMask := (EventMask or SHCNE_MEDIAREMOVED);
if assigned(fMkDir ) then EventMask := (EventMask or SHCNE_MKDIR);
if assigned(fNetShare ) then EventMask := (EventMask or SHCNE_NETSHARE);
if assigned(fNetUnshare ) then EventMask := (EventMask or SHCNE_NETUNSHARE);
if assigned(fRenameFolder ) then EventMask := (EventMask or SHCNE_RENAMEFOLDER);
if assigned(fRenameItem ) then EventMask := (EventMask or SHCNE_RENAMEITEM);
if assigned(fRmDir ) then EventMask := (EventMask or SHCNE_RMDIR);
if assigned(fServerDisconnect ) then EventMask := (EventMask or SHCNE_SERVERDISCONNECT);
if assigned(fUpdateDir ) then EventMask := (EventMask or SHCNE_UPDATEDIR);
if assigned(fUpdateImage ) then EventMask := (EventMask or SHCNE_UPDATEIMAGE);
if assigned(fUpdateItem ) then EventMask := (EventMask or SHCNE_UPDATEITEM);
if EventMask = 0 // If there's no event mask
then exit; // then there's no need to set an event.
// If the user requests watches on hard drives only, cycle through
// the list of drive letters and add a NotifyList element for each.
// Otherwise, just set the first element to watch the entire file
// system.
if fHardDriveOnly
then for i := ord('A') to ord('Z') do begin
DriveLetter := char(i) + ':\';
if GetDriveType(pchar(DriveLetter)) = DRIVE_FIXED
then begin
inc(NotifyCount);
with NotifyArray[NotifyCount] do begin
SHILCreateFromPath
(pchar(DriveLetter),
addr(pidl),
Attributes);
pidlPath := pidl;
bWatchSubtree := true;
end;
end;
end
// If the caller requests the entire file system be watched,
// prepare the first NotifyElement accordingly.
else begin
NotifyCount := 1;
with NotifyArray[1] do begin
pidlPath := nil;
bWatchSubtree := true;
end;
end;
NotifyPtr := addr(NotifyArray);
NotifyHandle := SHChangeNotifyRegister(
(Owner as TWinControl).Handle,
SHCNF_ACCEPT_INTERRUPTS +
SHCNF_ACCEPT_NON_INTERRUPTS,
EventMask,
fMessageNo,
NotifyCount,
NotifyPtr);
if NotifyHandle = 0
then begin
Stop;
raise Exception.Create('Could not register SHChangeNotify');
end;
end;
// This procedure unregisters the Change Notification
procedure TSHChangeNotify.Stop;
var
NotifyHandle : hwnd;
i : integer;
pidl : PITEMIDLIST;
begin
if csDesigning in ComponentState
then exit;
// Deregister the shell notification.
if NotifyCount > 0
then SHChangeNotifyDeregister(NotifyHandle);
// Free the PIDLs in NotifyArray.
for i := 1 to NotifyCount do begin
pidl := NotifyArray[i].PidlPath;
if AllocInterface.DidAlloc(pidl) = 1
then AllocInterface.Free(pidl);
end;
NotifyCount := 0;
end;
// This is the procedure that is called when a change notification occurs.
// It interprets the two PIDLs passed to it, and calls the appropriate
// event handler, according to what kind of event occurred.
procedure TSHChangeNotify.WndProc(var msg: TMessage);
type
TPIDLLIST = record
pidlist : array[1..2] of PITEMIDLIST;
end;
PIDARRAY = ^TPIDLLIST;
var
Path1 : string;
Path2 : string;
ptr : PIDARRAY;
p1,p2 : PITEMIDLIST;
repeated : boolean;
p : integer;
event : longint;
parmcount : byte;
OneParmEvent : TOneParmEvent;
TwoParmEvent : TTwoParmEvent;
// The internal function ParsePidl returns the string corresponding
// to a PIDL.
function ParsePidl (Pidl : PITEMIDLIST) : string;
begin
SetLength(result,MAX_PATH);
if not SHGetPathFromIDList(Pidl,pchar(result))
then result := '';
end;
// The actual message handler starts here.
begin
if Msg.Msg = WM_QUERYENDSESSION
then QueryEndSession(Msg);
if Msg.Msg = fMessageNo
then begin
OneParmEvent := nil;
TwoParmEvent := nil;
event := msg.LParam and ($7FFFFFFF);
case event of
SHCNE_ASSOCCHANGED : TwoParmEvent := fAssocChanged;
SHCNE_ATTRIBUTES : OneParmEvent := fAttributes;
SHCNE_CREATE : OneParmEvent := fCreate;
SHCNE_DELETE : OneParmEvent := fDelete;
SHCNE_DRIVEADD : OneParmEvent := fDriveAdd;
SHCNE_DRIVEADDGUI : OneParmEvent := fDriveAddGUI;
SHCNE_DRIVEREMOVED : OneParmEvent := fDriveRemoved;
SHCNE_MEDIAINSERTED : OneParmEvent := fMediaInserted;
SHCNE_MEDIAREMOVED : OneParmEvent := fMediaRemoved;
SHCNE_MKDIR : OneParmEvent := fMkDir;
SHCNE_NETSHARE : OneParmEvent := fNetShare;
SHCNE_NETUNSHARE : OneParmEvent := fNetUnshare;
SHCNE_RENAMEFOLDER : TwoParmEvent := fRenameFolder;
SHCNE_RENAMEITEM : TwoParmEvent := fRenameItem;
SHCNE_RMDIR : OneParmEvent := fRmDir;
SHCNE_SERVERDISCONNECT : OneParmEvent := fServerDisconnect;
SHCNE_UPDATEDIR : OneParmEvent := fUpdateDir;
SHCNE_UPDATEIMAGE : OneParmEvent := fUpdateImage;
SHCNE_UPDATEITEM : OneParmEvent := fUpdateItem;
else begin
OneParmEvent := nil; // Unknown event;
TwoParmEvent := nil;
end;
end;
if (assigned(OneParmEvent)) or (assigned(TwoParmEvent))
then begin
// Assign a pointer to the array of PIDLs sent
// with the message.
ptr := PIDARRAY(msg.wParam);
// Parse the two PIDLs.
p1 := ptr^.pidlist[1];
try
SetLength(Path1,MAX_PATH);
Path1 := ParsePidl(p1);
p := pos(#00,Path1);
if p > 0
then SetLength(Path1,p - 1);
except
Path1 := '';
end;
p2 := ptr^.pidlist[2];
try
SetLength(Path2,MAX_PATH);
Path2 := ParsePidl(p2);
p := pos(#00,Path2);
if p > 0
then SetLength(Path2,p - 1);
except
Path2 := '';
end;
// If this message is the same as the last one (which happens
// a lot), bail out.
try
repeated := (PrevMsg = event)
and (uppercase(prevpath1) = uppercase(Path1))
and (uppercase(prevpath2) = uppercase(Path2))
except
repeated := false;
end;
// Save the elements of this message for comparison next time.
PrevMsg := event;
PrevPath1 := Path1;
PrevPath2 := Path2;
// Convert the case of Path1 and Path2 if desired.
case fTextCase of
tcUppercase : begin
Path1 := uppercase(Path1);
Path2 := uppercase(Path2);
end;
tcLowercase : begin
Path1 := lowercase(Path1);
Path2 := lowercase(Path2);
end;
end;
// Call the event handler according to the number
// of paths we will pass to it.
if not repeated then begin
case event of
SHCNE_ASSOCCHANGED,
SHCNE_RENAMEFOLDER,
SHCNE_RENAMEITEM : parmcount := 2;
else parmcount := 1;
end;
if parmcount = 1
then OneParmEvent(self, event, Path1)
else TwoParmEvent(self, event, Path1, Path2);
end;
end; // if assigned(OneParmEvent)...
end; // if Msg.Msg = fMessageNo...
// Call the original message handler.
OwnerWindowProc(Msg);
end;
procedure TSHChangeNotify.QueryEndSession(var msg: TMessage);
var
CanEndSession : boolean;
begin
CanEndSession := true;
if Assigned(fEndSessionQuery)
then fEndSessionQuery(Self, CanEndSession);
if CanEndSession
then begin
Stop;
Msg.Result := 1;
end
else Msg.Result := 0;
end;
destructor TSHChangeNotify.Destroy;
begin
if not (csDesigning in ComponentState)
then begin
if Assigned(Owner)
then (Owner as TWinControl).WindowProc := OwnerWindowProc;
Stop;
end;
inherited;
end;
end.

[fide]

Espero les sea de utilidad a ustedes aunque sea para saber los games que los chicos les copian a sus discor duros locales jejejeje...

A mi me ha sido de gran utilidad para espiar a los que se sientan en algunas PCs...

[aeff]

Interesante esto fide, creo que con un tiempesito de estudio que le dedique joderé un poco menos aquí en club, je je ej

gracias man!

[fide]

Okas albertico. Si lo deduces como debe de ser, pues entonces me dices todas las cosas que aprendas okas. El echo es que esta bastante bueno este componente...