unit Unit2;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, shlobj, activex, StdCtrls, FileCtrl,strUtils;

const
shcne_renameitem = $1;
shcne_create = $2;
shcne_delete = $4;
shcne_mkdir = $8;
shcne_rmdir = $10;
shcne_mediainserted = $20;
shcne_mediaremoved = $40;
shcne_driveremoved = $80;
shcne_driveadd = $100;
shcne_netshare = $200;
shcne_netunshare = $400;
shcne_attributes = $800;
shcne_updatedir = $1000;
shcne_updateitem = $2000;
shcne_serverdisconnect = $4000;
shcne_updateimage = $8000;
shcne_driveaddgui = $10000;
shcne_renamefolder = $20000;
shcne_freespace = $40000;
shcne_assocchanged = $8000000;
shcne_diskevents = $2381F;
shcne_globalevents = $C0581E0;
shcne_allevents = $7FFFFFFF;
shcne_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;
DriveComboBox1: TDriveComboBox;
Label1: TLabel;
Button2: TButton;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
procedure wmshellreg(var message: tmessage); message wm_shnotify;

public
{ Public declarations }
end;

type pshnotifystruct = ^shnotifystruct;
shnotifystruct = record
dwitem1: pitemidlist;
dwitem2: pitemidlist;
end;

type pshfileinfobyte = ^shfileinfobyte;
_shfileinfobyte = record
hicon: integer;
iicon: integer;
dwattributes: integer;
szdisplayname: array[0..259] of char;
sztypename: array[0..79] of char;
end;
shfileinfobyte = _shfileinfobyte;

type pidlstruct = ^idlstruct;
_idlstruct = record
pidl: pitemidlist;
bwatchsubfolders: integer;
end;
idlstruct = _idlstruct;


function shnotify_register(hwnd: integer): bool;
function shnotify_unregister: bool;
function sheventname(strpath1, strpath2: string; lparam: integer): string;

function shchangenotifyderegister(hnotify: integer): integer; stdcall;
external 'shell32.dll' index 4;
function shchangenotifyregister(hwnd, uflags, dweventid, umsg, citems: longword;
lpps: pidlstruct): integer; stdcall; external 'shell32.dll' index 2;
function shgetfileinfopidl(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}

function sheventname(strpath1, strpath2: string; lparam: integer): string;
var
sevent: string;
begin
  case lparam of //根據參數設置提示消息
    shcne_renameitem: sevent := 'rename' + strpath1 + ':' + strpath2;
  shcne_create: sevent := '建立文件 文件名：' + strpath1;
  shcne_delete: sevent := '刪除文件 文件名：' + strpath1;
  shcne_mkdir: sevent := '新建目錄 目錄名：' + strpath1;
  shcne_rmdir: sevent := '刪除目錄 目錄名：' + strpath1;
  shcne_mediainserted: sevent := strpath1 + '中插入可移動存儲介質';
  shcne_mediaremoved: sevent := strpath1 + '中移去可移動存儲介質' + strpath1 + ' ' + strpath2;
  shcne_driveremoved: sevent := '移去驅動器' + strpath1;
  shcne_driveadd: sevent := '添加驅動器' + strpath1;
  shcne_netshare: sevent := '改變目錄' + strpath1 + '的共享屬性';
  
  shcne_attributes: sevent := '改變文件目錄屬性 文件名' + strpath1;
  shcne_updatedir: sevent := '更新目錄' + strpath1;
  shcne_updateitem: sevent := '更新文件 文件名：' + strpath1;
  shcne_serverdisconnect: sevent := '斷開與服務器的連接' + strpath1 + ' ' + strpath2;
  shcne_updateimage: sevent := 'shcne_updateimage';
  shcne_driveaddgui: sevent := 'shcne_driveaddgui';
  shcne_renamefolder: sevent := '重命名文件夾' + strpath1 + '為' + strpath2;
  shcne_freespace: sevent := '磁盤空間大小改變';
  shcne_assocchanged: sevent := '改變文件關聯';
  else
  sevent := '未知操作' + inttostr(lparam);
end;
result := sevent;
end;

function shnotify_register(hwnd: integer): bool;
var
ps: pidlstruct;
begin
  {$R-}
  result := false;
  if m_hshnotify = 0 then begin
    //獲取桌面文件夾的pidl
    if shgetspecialfolderlocation(0, CSIDL_DESKTOP, m_pidldesktop) <> noerror then
    form1.close;
    if boolean(m_pidldesktop) then begin
      new(ps);
      try
        ps.bwatchsubfolders := 1;
        ps.pidl := m_pidldesktop;
        
        // 利用shchangenotifyregister函數注冊系統消息處理
        m_hshnotify := shchangenotifyregister(hwnd, (shcnf_type or shcnf_idlist),
        (shcne_allevents or shcne_interrupt),
        wm_shnotify, 1, ps);
        result := boolean(m_hshnotify);
        finally
          FreeMem(ps);
        end;
      end
      else
      // 如果出現錯誤就使用 cotaskmemfree函數來釋放句柄
      cotaskmemfree(m_pidldesktop);
    end;
    {$R+}
  end;
  
  function shnotify_unregister: bool;
  begin
    result := false;
    if boolean(m_hshnotify) then
    //取消系統消息監視，同時釋放桌面的pidl
    if boolean(shchangenotifyderegister(m_hshnotify)) then begin
      {$R-}
      m_hshnotify := 0;
      cotaskmemfree(m_pidldesktop);
      result := true;
      {$R-}
    end;
  end;
  
  procedure tform1.wmshellreg(var message: tmessage); //系統消息處理函數
var
  strpath1, strpath2: string;
  charpath: array[0..259] of char;
  pidlitem: pshnotifystruct;
  vPath,vFile:string;
  begin
    pidlitem := pshnotifystruct(message.wparam);
    //  獲得系統消息相關得路徑
  shgetpathfromidlist(pidlitem.dwitem1, charpath);
    strpath1 := charpath;
    shgetpathfromidlist(pidlitem.dwitem2, charpath);
    strpath2 := charpath;
    vPath:=ExtractFilePath(strPath1);
    vFile:=ExtractFileName(strPath1);
    if (message.lparam=shcne_create) and (vPath=(Label1.Caption+'/')) then
    begin
      // memo1.lines.add(sheventname(strpath1, strpath2, message.lparam) + chr(13) + chr(10));
    if not AnsiContainsText(Memo1.Lines.Text,vFile) then
      memo1.lines.add(vFile);
    end;
  end;
  
  
  procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  begin
    //在程序退出的同時刪除監視
  if boolean(m_pidldesktop) then
    shnotify_unregister;
    
  end;
  
  procedure TForm1.Button1Click(Sender: TObject);
  begin
    Memo1.Clear;
    m_hshnotify := 0;
    if shnotify_register(form1.handle) then begin //注冊shell監視
    showmessage('shell監視程序成功注冊');
      button1.enabled := false;
    end
    else
    showmessage('shell監視程序注冊失敗');
    
  end;
  
  procedure TForm1.Button2Click(Sender: TObject);
  var
  i:integer;
  begin
    i:=Memo1.Lines.IndexOf(Memo1.SelText);
    Memo1.Lines.Delete(i);
  end;
  
end.