开发者

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;
0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜