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;
精彩评论