Monitor resource manager file changes

UnitUnit2;

Interface

Uses
Windows, messages, sysutils, variants, classes, graphics, controls, forms,
Dialogs, shlobj, ActiveX, stdctrls, filectrl, strutils;

Const
Shcn_renameitem = $1;
Shcn_create = $2;
Shcn_delete = $4;
Shcn_mkdir = $8;
Shcn_rmdir = $10;
Shcn_mediainserted = $20;
Shcn_mediaremoved = $40;
Shcn_driveremoved = $80;
Shcn_driveadd = $100;
Shcn_netshare = $200;
Shcn_netunshare = $400;
Shcn_attributes = $800;
Shcn_updatedir = $1000;
Shcn_updateitem = $2000;
Shcn_serverdisconnect = $4000;
Shcn_updateimage = $8000;
Shcn_driveaddgui = $10000;
Shcn_renamefolder = $20000;
Shcn_freespace = $40000;
Shcn_assocchanged = $8000000;
Shcn_diskevents = $ 2381f;
Shcn_globalevents = $ c0581e0;
Shcn_allevents = $7 fffffff;
Shcn_interrupt = $80000000;

Shcnf_idlist = 0;// Lpitemidlist
Shcnf_patha = $1;// Path name
Shcnf_printera = $2;// Printer friendly name
Shcnf_dword = $3;// DWORD
Shcnf_pathw = $5;// Path name
Shcnf_printerw = $6;// Printer friendly name
Shcnf _Type= $ Ff;

Shcnf_flush = $1000;

Shcnf_flushnowait ==$ 2000;
Shcnf_path = shcnf_pathw;
Shcnf_printer = shcnf_printerw;

Wm_shnotify = $401;
Noerror = 0;

Type
Tform1 =Class(Tform)
Button1: tbutton;
Memo1: tmemo;
Directorylistbox1: tdirectorylistbox;
Drivecombox1: tdrivecombobox;
Label1: tlabel;
Button2: tbutton;
ProcedureFormclose (Sender: tobject;VaRAction: tcloseaction );
ProcedureButton1click (Sender: tobject );
ProcedureButton2click (Sender: tobject );
Private
{Private Declarations}
ProcedureWmshellreg (VaR Message: Tmessage );MessageWm_shnotify;

Public
{Public declarations}
End;

TypePshpolicystruct = ^ shpolicystruct;
Shpolicystruct =Record
Dwitem1: pitemidlist;
Dwitem2: pitemidlist;
End;

TypePshfileinfobyte = ^ shfileinfobyte;
_ Shfileinfobyte =Record
Hicon: integer;
Iicon: integer;
Dwattributes: integer;
Szdisplayname:Array[0 .. 259]OfChar;
Sztypename:Array[0 .. 79]OfChar;
End;
Shfileinfobyte = _ shfileinfobyte;

TypePidlstruct = ^ idlstruct;
_ Idlstruct =Record
Pidl: pitemidlist;
Bwatchsubfolders: integer;
End;
Idlstruct = _ idlstruct;

FunctionShpolicy_register (hwnd: integer): bool;
FunctionShpolicy_unregister: bool;
FunctionSheventname (strpath1, strpath2:String; Lparam: integer ):String;

FunctionShchangenotifyderegister (hnotify: integer): integer; stdcall;
External'Shell32. dll'Index4;
FunctionShchangenotifyregister (hwnd, uflags, dweventid, umsg, citems: longword;
Lpps: pidlstruct): integer; stdcall;External'Shell32. dll'Index2;
FunctionShgetfileinfopidl (pidl: pitemidlist;
Dwfileattributes: integer;
Psfib: pshfileinfobyte;
Cbfileinfo: integer;
Uflags: integer): integer; stdcall;
External'Shell32. dll'Name'Shgetfileinfoa ';

VaR
Form1: tform1;
M_hshnotify: integer;
M_pidldesktop: pitemidlist;

Implementation

{$ R *. DFM}

FunctionSheventname (strpath1, strpath2:String; Lparam: integer ):String;
VaR
Sevent:String;
Begin
CaseLparamOf // Prompt message based on parameter settings
Shcn_renameitem: sevent: = 'rename' + strpath1 + ':' + strpath2;
Shcn_create: sevent: = 'create file name: '+ strpath1;
Shcn_delete: sevent: = 'delete file name: '+ strpath1;
Shcn_mkdir: sevent: = 'new directory name: '+ strpath1;
Shcn_rmdir: sevent: = 'name of the directory to be deleted: '+ strpath1;
Shcn_mediainserted: sevent: = strpath1 + 'insert removable storage media ';
Shcn_mediaremoved: sevent: = strpath1 + 'move in Removable storage media '+ strpath1 + ''+ strpath2;
Shcn_driveremoved: sevent: = 'remove drive '+ strpath1;
Shcn_driveadd: sevent: = 'add driver '+ strpath1;
Shcn_netshare: sevent: = 'change the shared attribute of directory '+ strpath1 + ';

Shcn_attributes: sevent: = 'change file directory attribute filename '+ strpath1;
Shcn_updatedir: sevent: = 'Update directory' + strpath1;
Shcn_updateitem: sevent: = 'Update file name: '+ strpath1;
Shcn_serverdisconnect: sevent: = 'disconnect from the server '+ strpath1 + ''+ strpath2;
Shcn_updateimage: sevent: = 'shcne _ updateimage ';
Shcn_driveaddgui: sevent: = 'shcne _ driveaddgu ';
Shcn_renamefolder: sevent: = 'rename the folder '+ strpath1 +' to '+ strpath2;
Shcn_freespace: sevent: = 'disk space size changed ';
Shcn_assocchanged: sevent: = 'change file association ';
Else
Sevent: = 'unknown operation' + inttostr (lparam );
End;
Result: = sevent;
End;

FunctionShpolicy_register (hwnd: integer): bool;
VaR
PS: pidlstruct;
Begin
{$ R -}
Result: =False;
IfM_hshnotify = 0Then Begin
// Obtain the pidl of the Desktop Folder
IfShgetspecialfolderlocation (0, csidl_desktop, m_pidldesktop) <> noerrorThen
Form1.close;
IfBoolean (m_pidldesktop)Then Begin
New (PS );
Try
PS. bwatchsubfolders: = 1;
PS. pidl: = m_pidldesktop;

// Use the shchangenotifyregister function to register the system for Message Processing
M_hshnotify: = shchangenotifyregister (hwnd, (shcnf _Type OrShcnf_idlist ),
(Shcn_alleventsOrShcn_interrupt ),
Wm_shnotify, 1, PS );
Result: = Boolean (m_hshnotify );
Finally
Freemem (PS );
End;
End
Else
// Use the cotaskmemfree function to release the handle if an error occurs.
Cotaskmemfree (m_pidldesktop );
End;
{$ R +}
End;

FunctionShpolicy_unregister: bool;
Begin
Result: =False;
IfBoolean (m_hshnotify)Then
// Cancel system message monitoring and release pidl of the desktop
IfBoolean (shchangenotifyderegister (m_hshnotify ))Then Begin
{$ R -}
M_hshnotify: = 0;
Cotaskmemfree (m_pidldesktop );
Result: =True;
{$ R -}
End;
End;

ProcedureTform1.wmshellreg (VaR Message: Tmessage );// System message processing function
VaR
Strpath1, strpath2:String;
Charpath:Array[0 .. 259]OfChar;
Pidlitem: pshpolicystruct;
Vpath, vfile:String;
Begin
Pidlitem: = pshpolicystruct (message. wparam );
// Obtain the path related to the system message
Shgetpathfromidlist (pidlitem. dwitem1, charpath );
Strpath1: = charpath;
Shgetpathfromidlist (pidlitem. dwitem2, charpath );
Strpath2: = charpath;
Vpath: = extractfilepath (strpath1 );
Vfile: = extractfilename (strpath1 );
If(Message. lparam = shwn_create)And(Vpath = (label1.caption + '/'))Then
Begin
// Memo1.lines. Add (sheventname (strpath1, strpath2, message. lparam) + CHR (13) + CHR (10 ));
If NotAnsicontainstext (memo1.lines. Text, vfile)Then
Memo1.lines. Add (vfile );
End;
End;


ProcedureTform1.formclose (Sender: tobject;VaRAction: tcloseaction );
Begin
// Delete monitoring when the program exits
IfBoolean (m_pidldesktop)Then
Shpolicy_unregister;

End;

ProcedureTform1.button1click (Sender: tobject );
Begin
Memo1.clear;
M_hshnotify: = 0;
IfShpolicy_register (form1.handle)Then Begin // Register shell monitoring
Showmessage ('Shell monitoring program successfully registered ');
Button1.enabled: =False;
End
Else
Showmessage ('Shell monitoring program registration failed ');

End;

ProcedureTform1.button2click (Sender: tobject );
VaR
I: integer;
Begin
I: = memo1.lines. indexof (memo1.seltext );
Memo1.lines. Delete (I );
End;

End.