uac elevate while using ifileoperation copyitem
I'm using below code to file copy operataion in windows seven,but it doesn't work and there is no any error while running or debugging,When the application goes to calling the CoGetObject it'll crash and can't returning any Hresult error,I just know the error occur in this line -> result := CoGetObject(pWideString(MonikerName), @BindOpts, ShlObj.IFileOperation, @iFileOperation); anyone can find any problem in this code? `
type
PBindOpts3 = ^TBindOpts3;
{$EXTERNALSYM tagBIND_OPTS3}
tagBIND_OPTS3 = record
cbStruct: DWORD;
grfFlags: DWORD;
grfMode: DWORD;
dwTickCountDeadline: DWORD;
dwTrackFlags: DWORD;
dwClassContext: DWORD;
locale: LCID;
pServerInfo: Pointer;
hwnd: hwnd;
end;
TBindOpts3 = tagBIND_OPTS3;
{$EXTERNALSYM BIND_OPTS3}
BIND_OPTS3 = TBindOpts3;
function CopyItem(const aSrcItem, aDest, aNewName: string): HResult;
const
CLSID_FileOp: TGUID = '{3ad05575-8857-4850-9277-11b85bdb8e09}';
var
lFileOperation: ShlObj.IFileOperation;
psiFrom: IShellItem;
psiTo: IShellItem;
myFile: TextFile;
BindOpts: TBindOpts3;
MonikerName: WideString;
Res: HResult;
begin
try
begin
result := CoInitialize(nil); if Succeeded(result) then begin
ZeroMemory(@BindOpts, Sizeof(TBindOpts3));
BindOpts.cbStruct := Sizeof(TBindOpts3);
BindOpts.hwnd := 0;
BindOpts.dwClassContext := CLSCTX_LOCAL_SERVER;
MonikerName := 'Elevation:Administrator!new:' + GUIDToString
(CLSID_FileOp);
result := CoGetObject(pWideString(MonikerName), @BindOpts,
ShlObj.IFileOperation, @lFileOperation);
if Succeeded(result) then
result := CoCreateInstance(CLSID_FileOp, nil,
CLSCTX_LOCAL_SERVER + CLSCTX_INPROC_SERVER + CLSCTX_INPROC_HANDLER,
IFileOperation, lFileOperation);
if Succeeded(result) then
begin
result := lFileOperation.SetOperationFlags
(FOFX_SHOWELEVATIONPROMPT + FOFX_NOCOPYHOOKS +
FOFX_REQUIREELEVATION);
if Succeeded(result) then
begin
result := SHCreateItemFromParsingName
(pchar(aSrcItem), nil, IShellItem, psiFrom);
if Succeeded(result) then
begin
if aDest <> '' then
begin
result := SHCreateItemFromParsingName
(pchar(aDest), nil, IShellItem, psiTo);
end;
if Succeeded(result) then
begin
result := lFileOperation.CopyItem
(psiFrom, psiTo, pchar(aNewName), nil);
psiTo := nil;
end;
psiFrom := nil;
end;
if Succeeded(result) then
begin
result := lFileOperation.PerformOperations;
end;
end;
lFileOperation := nil;
end;
CoUninitialize;
end;
end;
except on d: exception do begin
showmessage(d.tostring());
end;
end;
end;
` What HRESULT value is CoGetObject() actually returning?
Do not cast a WideString to a pWideString when calling a COM function. Pass it in as-is and let Delphi handle the marshalling details for you.
And there is no need to call CoCreateInstance() after calling CoGetObject(). CoGetObject() already returns the required COM object to you. Use it as-is.
Try this:
function CopyItem(const aSrcItem, aDest, aNewName: string): HResult;
const
CLSID_FileOp: TGUID = '{3ad05575-8857-4850-9277-11b85bdb8e09}';
var
lFileOperation: ShlObj.IFileOperation;
psiFrom: IShellItem;
psiTo: IShellItem;
BindOpts: TBindOpts3;
MonikerName: WideString;
begin
try
Result := CoInitialize(nil);
OleCheck(Result);
try
ZeroMemory(@BindOpts, Sizeof(TBindOpts3));
BindOpts.cbStruct := Sizeof(TBindOpts3);
BindOpts.hwnd := 0;
BindOpts.dwClassContext := CLSCTX_LOCAL_SERVER;
MonikerName := 'Elevation:Administrator!new:' + GUIDToString(CLSID_FileOp);
Result := CoGetObject(MonikerName, @BindOpts, ShlObj.IFileOperation, lFileOperation);
OleCheck(Result);
Result := lFileOperation.SetOperationFlags(FOFX_SHOWELEVATIONPROMPT or FOFX_NOCOPYHOOKS or FOFX_REQUIREELEVATION);
OleCheck(Result);
Result := SHCreateItemFromParsingName(PChar(aSrcItem), nil, IShellItem, psiFrom);
OleCheck(Result);
if aDest <> '' then
begin
Result := SHCreateItemFromParsingName(PChar(aDest), nil, IShellItem, psiTo);
OleCheck(Result);
end;
Result := lFileOperation.CopyItem(psiFrom, psiTo, PChar(aNewName), nil);
OleCheck(Result);
Result := lFileOperation.PerformOperations;
OleCheck(Result);
finally
CoUninitialize;
end;
except
on E: Exception do ShowMessage(d.ToString());
end;
end;