Monitorear la shell desde delphi

[fide]

Aqui la Unit del componente...

Código Delphi [-]
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...