我正在使用下面的代码在 Windows 7 中进行文件复制操作,但它不起作用并且在运行或调试时没有任何错误,当应用程序调用 CoGetObject 时它会崩溃并且无法返回任何 Hresult错误,我只知道错误发生在这一行 ->result := CoGetObject(pWideString(MonikerName), @BindOpts,
ShlObj.IFileOperation, @iFileOperation);
任何人都可以在这段代码中找到任何问题?`
类型
PBindOpts3 = ^TBindOpts3;
{$EXTERNALSYM tagBIND_OPTS3}
tagBIND_OPTS3 = 记录
cbStruct:双字;
grfFlags:双字;
grfMode:双字;
dwTickCountDeadline: DWORD;
dwTrackFlags:双字;
dwClassContext: DWORD;
语言环境:LCID;
pServerInfo:指针;
hwnd: hwnd;
结尾;
TBindOpts3 = tagBIND_OPTS3;
{$EXTERNALSYM BIND_OPTS3}
BIND_OPTS3 = TBindOpts3;
function CopyItem(const aSrcItem, aDest, aNewName: string): HResult;
常量
CLSID_FileOp: TGUID = '{3ad05575-8857-4850-9277-11b85bdb8e09}';
无功
lFileOperation:ShlObj.IFileOperation;
psiFrom: IShellItem;
psiTo: IShellItem;
我的文件:文本文件;
BindOpts:TBindOpts3;
MonikerName:WideString;
回复:HResult;
开始
尝试
begin
Run Code Online (Sandbox Code Playgroud)
结果:= CoInitialize(nil);
如果成功(结果)那么
开始
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;
Run Code Online (Sandbox Code Playgroud)
除了
在 d: 例外做
开始
showmessage(d.tostring());
end;
Run Code Online (Sandbox Code Playgroud)
结尾;
结尾;
`
HRESULTCoGetObject() 实际返回什么值?
调用 COM 函数时不要将 WideString 强制转换为 pWideString。按原样传递它,让 Delphi 为您处理编组细节。
并且在调用 CoGetObject() 之后不需要再调用 CoCreateInstance()。CoGetObject() 已经将所需的 COM 对象返回给您。按原样使用它。
尝试这个:
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;
Run Code Online (Sandbox Code Playgroud)