uses ActiveX, ComObj, ShlObj;
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
OR FOF_NOCONFIRMMKDIR);
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;
end;
CoUninitialize;
end;
end;