花落谁家，你作主！	盛大widget设计大赛英雄榜

小弟在Delphi版的第一贴：如何编程获得用户对文件的新建、复制、删除等操作！！！

楼主qpl007（蓝色闪电）2003-10-04 00:44:19 在 Delphi / Windows SDK/API 提问

在资源管理器中进行新建文件、删除文件、文件的复制、粘贴等操作后，怎样用程序捕捉其信息！！

如：将 D:\A.txt 复制到 E:\
在 D:\ 下新建文件 B.txt
...

程序捕捉这些信息后在ListView中显示：
**点**分**秒复制文件 D:\A.txt 到 E:\
**点**分**秒新建文件 D:\b.txt
...

小弟第一次在Delphi版中发贴，望各路高手捧场，多谢！！！（最好付源码）
问题点数：100、回复次数：35Top

1 楼huojiehai（海天子）回复于 2003-10-04 00:51:09 得分 5

这个问题不简单，不会！Top

2 楼ly_liuyang（Liu Yang LYSoft http://lysoft.7u7.net）回复于 2003-10-04 00:51:24 得分 20

资源管理器中截获就通过编写外壳扩展就可以了
只是监控使用MS没有公开的WM_ShellNotify = $401;消息

一个Demo

unit CopyMain;

interface

uses Windows, ComObj, ShlObj;

type
TCopyHook = class(TComObject, ICopyHook)
protected
function CopyCallback(Wnd: HWND; wFunc, wFlags: UINT; pszSrcFile: PAnsiChar;
dwSrcAttribs: DWORD; pszDestFile: PAnsiChar; dwDestAttribs: DWORD): UINT; stdcall;
end;

TCopyHookFactory = class(TComObjectFactory)
protected
function GetProgID: string; override;
procedure ApproveShellExtension(Register: Boolean; const ClsID: string); virtual;
public
procedure UpdateRegistry(Register: Boolean); override;
end;

implementation

uses ComServ, SysUtils, Registry;

{ TCopyHook }

// when Windows shell attend to copy files£¬CopyCallBack will be called by explorer

function TCopyHook.CopyCallback(Wnd: HWND; wFunc, wFlags: UINT;
pszSrcFile: PAnsiChar; dwSrcAttribs: DWORD; pszDestFile: PAnsiChar;
dwDestAttribs: DWORD): UINT;
const
FO_COPY = 2;
FO_DELETE = 3;
FO_MOVE = 1;
FO_RENAME = 4;
var
sOp:string;
begin
Case wFunc of
FO_COPY: sOp:=format('Do you want to copy %s to %s ?',[pszSrcFile,pszDestFile]);
FO_DELETE: sOp:=format('Do you want to delete %s ?',[pszSrcFile]);
FO_MOVE: sOp:=format('Do you want to move %s to %s ?',[pszSrcFile,pszDestFile]);
FO_RENAME: sOp:=format('Do you want to rename %s to %s ?',[pszSrcFile,pszDestFile]);
else sOp:=format('Unknown shell folder operation %d',[wFlags]);
end;
// show hint let user deside if continue
Result := MessageBox(Wnd, PChar(sOp),'Shell Folder Operation Notify', MB_YESNOCANCEL);
end;

{ TCopyHookFactory }

function TCopyHookFactory.GetProgID: string;
begin
Result := '';
end;

procedure TCopyHookFactory.UpdateRegistry(Register: Boolean);
var
ClsID: string;
begin
ClsID := GUIDToString(ClassID);
inherited UpdateRegistry(Register);
ApproveShellExtension(Register, ClsID);
if Register then
// add clsid to registry "CopyHookHandlers"
CreateRegKey('directory\shellex\CopyHookHandlers\' + ClassName, '', ClsID)
else DeleteRegKey('directory\shellex\CopyHookHandlers\' + ClassName);
end;

procedure TCopyHookFactory.ApproveShellExtension(Register: Boolean; const ClsID: string);
const
SApproveKey = 'SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved';
begin
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
if not OpenKey(SApproveKey, True) then Exit;
if Register
then WriteString(ClsID, Description)
else DeleteValue(ClsID);
finally
Free;
end;
end;

const
CLSID_CopyHook: TGUID = '{66CD5F60-A044-11D0-A9BF-00A024E3867F}';
LIBID_CopyHook: TGUID = '{D2F531A0-0861-11D2-AE5C-74640BC10000}';
initialization
TCopyHookFactory.Create(ComServer, TCopyHook, CLSID_CopyHook,
'CR_CopyHook', 'Shell Folder Operation Notify',ciMultiInstance, tmApartment);
end.Top

3 楼ly_liuyang（Liu Yang LYSoft http://lysoft.7u7.net）回复于 2003-10-04 00:54:00 得分 0

消息监控的部分接口，详细的网上可以下载Code的

type
pshnotifystruct=^shnotifystruct;
shnotifystruct=record
dwitem1,dwitem2:PItemIDList;
end;
type
PSHFileInfoByte=^SHFileInfoByte;
_SHFileInfoByte=record
hIcon,iIcon,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;
IDLStruvt=_IDLStruct;

function SHChangeNotifyDeregister(hNotify:integer):integer;stdcall; external 'Shell32.DLL' index 4;
function SHChangeNotifyRegister(hWnd,uFlags,dwEvenID,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 'SHGetHileInfoA';

注意的是，只对Explorer，我的电脑有效，程序建立的文件无法知道
如果想监控所有的，必须使用驱动实现，例如File Monitor等Top

4 楼qpl007（蓝色闪电）回复于 2003-10-04 00:57:00 得分 0

多谢两位，试试先Top

5 楼qpl007（蓝色闪电）回复于 2003-10-04 01:01:44 得分 0

能给个下载地址吗？
或发到我的油箱 kingboy001@163.net
小弟对Delphi不熟，望各路高手指点。Top

6 楼qpl007（蓝色闪电）回复于 2003-10-04 12:20:24 得分 0

自己顶一下Top

7 楼Eastunfail（龍子龍孫)　(Serpent's Embrace）回复于 2003-10-05 18:00:19 得分 5

Sample控件页里面有TShellNotification(好像是这样写)控件可以直接使用，呵呵Top

8 楼qpl007（蓝色闪电）回复于 2003-10-05 18:15:11 得分 0

能给个例子吗？
小弟在此谢过了！！！Top

9 楼gf109（good good study）回复于 2003-10-08 22:00:13 得分 5

Delphi中实现文件拷贝的三种方法
1．调用API函数
procedure CopyFile(FromFileName,ToFileName:string);
var
f1,f2:file;
Begin
AssignFile(f1,FromFileName); //指定源文件名
AssignFile(f2,ToFileName); //指定目标文件名
Reset(f1);
Try
Rewrite(f2);
Try
If Lzcopy(TfileRec(f1).handle,TfileRec(f2).Handle)<0
Then
Raise EinoutError.creat('文件复制错误')
Finally
CloseFile(f2); //关闭 f2
End;
Finally
Until length(sLine)<=0;
End;
End;
2.文件流
procedure copyfile;
var f1,f2: tfilestream ;
begin
f1:=Tfilestream.Create(sourcefilename,fmopenread);
try
f2:=Tfilestream.Create(targetfilename,fmopenwrite or fmcreate);
try
f2.CopyFrom(f1,f1.size);
finally
f2.Free;
end;
finally
f1.Free;
end;
end;

3．利用内存块读写buffer实现
Procudure FileCopy(const Fromfile,Tofile:string);
Var
F1,F2:file;
NumRead,Numwritten:word;
Buf:array [1..2048] of char;
Begin
AssignFile(F1,Fromfile);
Reset(F1,1);
AssignFile(F2,Tofile);
Rewrite(F2,1);
Repeat
BlockRead(F1,buf,sizeof(buf),NumRead);
BlockWrite(F2,buf,Numread,NumWritten);
Until (NumRead=0) or (NumWritten<>NumRead);
CloseFile(F1);
CloseFile(F2);
EndTop

10 楼qpl007（蓝色闪电）回复于 2003-10-08 23:40:08 得分 0

楼上的兄弟~
我是要监控啊Top

11 楼cow8063（天涯远不远？不远！人在天涯，天涯怎会远）回复于 2003-10-09 17:21:50 得分 5

我也不会Top

12 楼foxmx（夜之狐）回复于 2003-10-10 19:26:22 得分 0

消息处理!Top

13 楼qpl007（蓝色闪电）回复于 2003-10-22 17:43:11 得分 0

谁会Top

14 楼l0f（凌风）回复于 2003-10-23 16:24:58 得分 0

有难度，没做过！Top

15 楼hongqi162（失踪的月亮）回复于 2003-10-23 17:00:24 得分 0

upTop

16 楼poweruser（Loading......）回复于 2003-10-24 21:08:00 得分 10

二楼兄弟说的CopyHook就可以实现

但和你的要求不太相同，copyhook只能监控文件（文件夹）复制、删除、移动和重命名这样几种操作
对“新建”操作不能监控
Top

17 楼poweruser（Loading......）回复于 2003-10-24 21:12:23 得分 20

SHELL32.DLL中的SHChangeNotifyRegister可以监视对文件的操作

但SHChangeNotifyRegister函数是MS未公开的API，所以需要动态获取他的地址
然后用这个函数注册一个回调函数，当有文件操作的时候就可以在这个回调函数中得到通知

这个函数的缺点就是只能监视不能控制：（

祝你好运！Top

18 楼poweruser（Loading......）回复于 2003-10-24 21:13:24 得分 0

这个函数的定义如下：
typedef WINSHELLAPI HANDLE (WINAPI *pfSHChangeNotifyRegister)(
HWND hWnd,
DWORD dwFlags,
LONG wEventMask,
UINT uMsg,
DWORD cItems,
LPPIDLSTRUCT *lpItems);

我是用VC的，你自己转成pascal语法就可以啦：）
Top

19 楼qpl007（蓝色闪电）回复于 2003-10-25 02:17:49 得分 0

能监视就OK啦!Top

20 楼qpl007（蓝色闪电）回复于 2003-10-26 00:21:40 得分 0

谁能给个CopyHook的完整例子？Top

21 楼cash2000（赚钱赚钱拼命赚钱）回复于 2003-10-26 11:50:44 得分 5

你看李伟的书深入windows内核编程，里面有现成的例子。Top

22 楼qpl007（蓝色闪电）回复于 2003-10-27 09:16:06 得分 0

谢谢各位的关心！
我去看看！Top

23 楼ThenLong（完美组合=Delphi/C++）回复于 2003-10-27 13:02:55 得分 5

_SHFILEOPSTRUCTA = packed record
Wnd: HWND;
wFunc: UINT;
pFrom: PAnsiChar;
pTo: PAnsiChar;
fFlags: FILEOP_FLAGS;
fAnyOperationsAborted: BOOL;
hNameMappings: Pointer;
lpszProgressTitle: PAnsiChar; { only used if FOF_SIMPLEPROGRESS }
end;Top

24 楼qpl007（蓝色闪电）回复于 2003-10-28 11:21:59 得分 0

李伟的书《深入windows内核编程》我找不到啊！！Top

25 楼fu_qi_ming（）回复于 2003-10-29 18:39:38 得分 0

用钩子了?(我不会)Top

26 楼DongXF（孔雀东南飞）回复于 2003-11-01 09:18:18 得分 5

Sample控件页里面有TShellChangeNotifier控件可以直接使用，呵呵
Top

27 楼cuiang（天外化石）回复于 2003-11-01 14:09:55 得分 0

哇~~~好多高手啊！！楼上甘多位，我一地都看唔明啊！！！Top

28 楼prettysky（浪际天涯）回复于 2003-11-01 15:29:12 得分 0

刚学Delphi就做这个。。太难了Top

29 楼angelface（§<@#$&^%$>§）回复于 2003-11-02 20:21:16 得分 0

呵呵，没想到这个问题这么难解决Top

30 楼shasure520（ぐ南南·安娜→ヤ相愛①辈子）回复于 2003-11-02 20:25:07 得分 5

挂接APITop

31 楼qpl007（蓝色闪电）回复于 2003-11-02 21:46:48 得分 0

各位高手能给个完整的例子吗Top

32 楼jxc163（一寒）回复于 2003-11-04 08:33:15 得分 0

学习Top

33 楼missj（ashan）回复于 2003-11-14 03:04:05 得分 0

up
Top

34 楼sweetch（龙の吻ж龙文）回复于 2003-12-14 20:12:06 得分 10

unit UFileOpertion;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,FileCtrl,ShellAPI, StdCtrls;

type
TForm1 = class(TForm)
StaticText1: TStaticText;
StaticText2: TStaticText;
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button4Click(Sender: TObject);
var
Dir:String;
begin
Dir:='D:';
if SelectDirectory(Dir,[sdAllowCreate,sdperformCreate,sdPrompt],0) then
//sdAllowCreate 允许创建目录
//sdPerformCreate 执行创建目录
//sdPrompt 显示提示信息
//函数执行成功
Self.Edit1.Text:=Dir;
end;

procedure TForm1.Button5Click(Sender: TObject);
var
Dir:string;
begin
Dir:='D:';
if SelectDirectory(Dir,[sdAllowCreate,sdPerformCreate,sdPrompt],0) then
Self.Edit2.Text:=Dir;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
OpStruc:TSHFileOpStruct;
FromBuf,ToBuf:Array[0..128] of Char;
begin
//用0初始化数组 FromBuf和ToBuf
FillChar(FromBuf,Sizeof(FromBuf),0);
FillChar(ToBuf,SizeOf(ToBuf),0);
//分别在数组FromBuf和ToBuf填入操作的源目录及目标目录
StrPCopy(FromBuf,PChar(Edit1.Text));
StrPCopy(ToBuf,Pchar(Edit2.Text));
//开始填充OpStruc记录
with OpStruc do
begin
Wnd:=Handle;
//复制操作
wFunc:=FO_COPY;
pFrom:=@FromBuf;
pTo:=@ToBuf;
fFlags:=FOF_noconfirmation or FOF_RENAMEONCOLLISION;
fAnyOperationsAborted:=false;
hNameMappings:=nil;
lpszProgressTitle:=nil;
end;
if SHFIleOperation(OpStruc)=0 then
//函数执行成功
MessageBox(Handle,'复制完毕。','复制信息',MB_OK+MB_ICONINFORMATION);

end;

//单击“移动”按钮执行的操作

procedure TForm1.Button2Click(Sender: TObject);
var
OpStruc:TSHFileOpStruct;
FromBuf,ToBuf:Array[0..128] of Char;
begin
FillChar(FromBuf,SizeOf(FromBuf),0);
FillChar(ToBuf,SizeOf(ToBuf),0);
StrPCopy(FromBuf,Pchar(Edit1.Text));
StrPcopy(ToBuf,Pchar(Edit2.Text));
//开始填充OPStruc记录
with OpStruc do
begin
Wnd:=Handle;
//移动操作
wFunc:=FO_MOVE;
pFrom:=@FromBuf;
pTo:=@ToBuf;
fFlags:=FOF_NOCONFIRMATION or fof_renameoncollision;
fAnyOperationSaborted:=False;
hNameMappings:=nil;
lpszProgressTitle:='正在文件';
end;
if shfileoperation(opstruc)=0 then
MessageBox(Handle,'移动完毕','移动信息',MB_OK+MB_iconinformation);
end;
//下面执行删除操作
procedure TForm1.Button3Click(Sender: TObject);
var
OpStruc:TshfileOpstruct;
FromBuf:Array[0..128] of Char;
begin
fillchar(FromBuf,Sizeof(FromBuf),0);
StrPcopy(FromBuf,pchar(Edit1.Text));
//开始填充OpStruc记录
with Opstruc do
begin
Wnd:=Handle;
wFunc:=FO_DELETE;
pFrom:=@fromBuf;
pTo:=nil;
fFlags:=FOF_noconfirmation;
lpszProgressTitle:='正在删除';
end;
if shfileoperation(opstruc)=0 then
MessageBox(Handle,'删除完毕','删除信息',MB_OK+MB_iconinformation);
Self.Edit1.Text:='';
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
Close;
end;

end.Top

35 楼laiguorong（Win Lai）回复于 2003-12-27 10:25:33 得分 0