delphi IFileOperation拷贝复制文件带进度条

uses ActiveX, ComObj, ShlObj,ShellApi;

type

TFileSystemBindData = class (TInterfacedObject, IFileSystemBindData)

fw32fd: TWin32FindData;

function SetFindData(var w32fd: TWin32FindData): HRESULT; stdcall;

function GetFindData(var w32fd: TWin32FindData): HRESULT; stdcall;

end;

function TFileSystemBindData.GetFindData(var w32fd: TWin32FindData): HRESULT;

begin

w32fd:= fw32fd;

Result := S_OK;

end;

function TFileSystemBindData.SetFindData(var w32fd: TWin32FindData): HRESULT;

begin

fw32fd := w32fd;

Result := S_OK;

end;

function CopyFileIFileOperationForceDirectories(const srcFile, destFile : string) : boolean;

//works on Windows >= Vista and 2008 server

var

r : HRESULT;

fileOp: IFileOperation;

siSrcFile: IShellItem;

siDestFolder: IShellItem;

destFileFolder, destFileName : string;

pbc : IBindCtx;

w32fd : TWin32FindData;

ifs : TFileSystemBindData;

begin

result := false;

destFileFolder := ExtractFileDir(destFile);

destFileName := ExtractFileName(destFile);

//init com

r := CoInitializeEx(nil, COINIT_APARTMENTTHREADED or COINIT_DISABLE_OLE1DDE);

if Succeeded(r) then

begin

//create IFileOperation interface

r := CoCreateInstance(CLSID_FileOperation, nil, CLSCTX_ALL, IFileOperation, fileOp);

if Succeeded(r) then

begin

//set operations flags

r := fileOp.SetOperationFlags(FOF_NOCONFIRMATION OR FOFX_NOMINIMIZEBOX);

if Succeeded(r) then

begin

//get source shell item

r := SHCreateItemFromParsingName(PChar(srcFile), nil, IShellItem, siSrcFile);

if Succeeded(r) then

begin

//create binding context to pretend there is a folder there

if NOT DirectoryExists(destFileFolder) then

begin

ZeroMemory(@w32fd, Sizeof(TWin32FindData));

w32fd.dwFileAttributes := FILE_ATTRIBUTE_DIRECTORY;

ifs := TFileSystemBindData.Create;

ifs.SetFindData(w32fd);

r := CreateBindCtx(0, pbc);

r := pbc.RegisterObjectParam(STR_FILE_SYS_BIND_DATA, ifs);

end

else

pbc := nil;

//get destination folder shell item

r := SHCreateItemFromParsingName(PChar(destFileFolder), pbc, IShellItem, siDestFolder);

//add copy operation

if Succeeded(r) then r := fileOp.CopyItem(siSrcFile, siDestFolder, PChar(destFileName), nil);

end;

//execute

if Succeeded(r) then r := fileOp.PerformOperations;

result := Succeeded(r);

OleCheck(r);

end;

CoUninitialize;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

//works even if "d:\f1\f2\f3\" does not exist!

CopyFileIFileOperationForceDirectories('D:\TDDOWNLOAD\最后的尼安德特人.rmvb', 'e:\TDDOWNLOAD\最后的尼安德特人.rmvb');

end;

推荐分享