delphi - 将文件复制到剪贴板然后将其粘贴到原始文件夹中不起作用

Question

我遇到了一个令人困惑的情况。我在 Delphi 中使用以下代码将文件列表复制到剪贴板；

procedure TfMain.CopyFilesToClipboard(FileList: string);
const
  C_UNABLE_TO_ALLOCATE_MEMORY = 'Unable to allocate memory.';
  C_UNABLE_TO_ACCESS_MEMORY = 'Unable to access allocated memory.';
var
  DropFiles: PDropFiles;
  hGlobal: THandle;
  iLen: Integer;
begin
  iLen := Length(FileList);
  hGlobal := GlobalAlloc(GMEM_SHARE or GMEM_MOVEABLE or
  GMEM_ZEROINIT, SizeOf(TDropFiles) + ((iLen + 2) * SizeOf(Char)));
  if (hGlobal = 0) then
    raise Exception.Create(C_UNABLE_TO_ALLOCATE_MEMORY);
  try DropFiles := GlobalLock(hGlobal);
    if (DropFiles = nil) then raise Exception.Create(C_UNABLE_TO_ACCESS_MEMORY);
    try
      DropFiles^.pFiles := SizeOf(TDropFiles);
      DropFiles^.fWide := True;
      if FileList <> '' then
        Move(FileList[1], (PByte(DropFiles) + SizeOf(TDropFiles))^,
      iLen * SizeOf(Char));
    finally
      GlobalUnlock(hGlobal);
    end;
    Clipboard.SetAsHandle(CF_HDROP, hGlobal);
  except
    GlobalFree(hGlobal);
  end;
end;

(这似乎是互联网上流行的一段代码)

使用我的应用程序，将文件复制到剪贴板后，我可以使用 Windows 资源管理器将它们粘贴到每个其他文件夹中，除了文件最初所在的文件夹!我期望它的行为就像普通的 Windows 副本一样(即在粘贴时它应该创建一个后缀为“-Copy”的文件)，但这似乎不起作用。有什么线索吗？

Answer 1

当唯一可用的剪贴板格式是 CF_HDROP 时，我无法将 Windows 资源管理器粘贴到源文件夹中。但是，如果在 IDataObject 中提供文件名，则可以正常工作。

如果所有文件都来自同一源文件夹，您可以检索源文件夹的 IShellFolder 并查询其中各个文件的子 PIDL，然后使用 IShellFolder.GetUIObjectOf () 获取表示文件的 IDataObject。然后使用 OleSetClipboard() 将该对象放入剪贴板。例如:

uses
  System.Classes, Winapi.Windows, Winapi.ActiveX, Winapi.Shlobj, Winapi.ShellAPI, System.Win.ComObj;

procedure CopyFilesToClipboard(const Folder: string; FileNames: TStrings);
var
  SF: IShellFolder;
  PidlFolder: PItemIDList;
  PidlChildren: array of PItemIDList;
  Eaten: UINT;
  Attrs: DWORD;
  Obj: IDataObject;
  I: Integer;
begin
  if (Folder = '') or (FileNames = nil) or (FileNames.Count = 0) then Exit;
  OleCheck(SHParseDisplayName(PChar(Folder), nil, PidlFolder, 0, Attrs));
  try
    OleCheck(SHBindToObject(nil, PidlFolder, nil, IShellFolder, Pointer(SF)));
  finally
    CoTaskMemFree(PidlFolder);
  end;
  SetLength(PidlChildren, FileNames.Count);
  for I := Low(PidlChildren) to High(PidlChildren) do
    PidlChildren[i] := nil;
  try
    for I := 0 to FileNames.Count-1 do
      OleCheck(SF.ParseDisplayName(0, nil, PChar(FileNames[i]), Eaten, PidlChildren[i], Attrs));
    OleCheck(SF.GetUIObjectOf(0, FileNames.Count, PIdlChildren[0], IDataObject, nil, obj));
  finally
    for I := Low(PidlChildren) to High(PidlChildren) do
    begin
      if PidlChildren[i] <> nil then
        CoTaskMemFree(PidlChildren[i]);
    end;
  end;
  OleCheck(OleSetClipboard(obj));
  OleCheck(OleFlushClipboard);
end;

更新:如果文件位于不同的源文件夹中，您可以使用CFSTR_SHELLIDLIST格式:

uses
  System.Classes, System.SysUtils, Winapi.Windows, Winapi.ActiveX, Winapi.Shlobj, Winapi.ShellAPI, System.Win.ComObj, Vcl.Clipbrd;

{$POINTERMATH ON}

function HIDA_GetPIDLFolder(pida: PIDA): LPITEMIDLIST;
begin
  Result := LPITEMIDLIST(LPBYTE(pida) + pida.aoffset[0]);
end;

function HIDA_GetPIDLItem(pida: PIDA; idx: Integer): LPITEMIDLIST;
begin
  Result := LPITEMIDLIST(LPBYTE(pida) + (PUINT(@pida.aoffset[0])+(1+idx))^);
end;

var
  CF_SHELLIDLIST: UINT = 0;

type
  CidaPidlInfo = record
    Pidl: PItemIDList;
    PidlOffset: UINT;
    PidlSize: UINT;
  end;

procedure CopyFilesToClipboard(FileNames: TStrings);
var
  PidlInfo: array of CidaPidlInfo;
  Attrs, AllocSize: DWORD;
  gmem: THandle;
  ida: PIDA;
  I: Integer;
begin
  if (FileNames = nil) or (FileNames.Count = 0) or (CF_SHELLIDLIST = 0) then Exit;
  SetLength(PidlInfo, FileNames.Count);
  for I := Low(PidlInfo) to High(PidlInfo) do
    PidlInfo[I].Pidl := nil;
  try
    AllocSize := SizeOf(CIDA)+(SizeOf(UINT)*FileNames.Count)+SizeOf(Word);
    for I := 0 to FileNames.Count-1 do
    begin
      OleCheck(SHParseDisplayName(PChar(FileNames[I]), nil, PidlInfo[I].Pidl, 0, Attrs));
      PidlInfo[I].PidlOffset := AllocSize;
      PidlInfo[I].PidlSize := ILGetSize(PidlInfo[I].Pidl);
      Inc(AllocSize, PidlInfo[I].PidlSize);
    end;
    gmem := GlobalAlloc(GMEM_MOVEABLE, AllocSize);
    if gmem = 0 then RaiseLastOSError;
    try
      ida := PIDA(GlobalLock(gmem));
      if ida = nil then RaiseLastOSError;
      try
        ida.cidl := FileNames.Count;
        ida.aoffset[0] := SizeOf(CIDA)+(SizeOf(UINT)*FileNames.Count);
        HIDA_GetPIDLFolder(ida).mkid.cb := 0;
        for I := 0 to FileNames.Count-1 do
        begin
          ida.aoffset[1+I] := PidlInfo[I].PidlOffset;
          Move(PidlInfo[I].Pidl^, HIDA_GetPIDLItem(ida, I)^, PidlInfo[I].PidlSize);
        end;
      finally
        GlobalUnlock(gmem);
      end;
      Clipboard.SetAsHandle(CF_SHELLIDLIST, gmem);
    except
      GlobalFree(gmem);
      raise;
    end;
  finally
    for I := Low(PidlInfo) to High(PidlInfo) do
      CoTaskMemFree(PidlInfo[I].Pidl);
  end;
end;

initialization
  CF_SHELLIDLIST := RegisterClipboardFormat(CFSTR_SHELLIDLIST);

或者:

procedure CopyFilesToClipboard(FileNames: TStrings);
var
  Pidls: array of PItemIdList;
  Attrs: DWORD;
  I: Integer;
  obj: IDataObject;
begin
  if (FileNames = nil) or (FileNames.Count = 0) then Exit;
  SetLength(Pidls, FileNames.Count);
  for I := Low(Pidls) to High(Pidls) do
    Pidls[I] := nil;
  try
    for I := 0 to FileNames.Count-1 do
      OleCheck(SHParseDisplayName(PChar(FileNames[I]), nil, Pidls[I], 0, Attrs));
    OleCheck(CIDLData_CreateFromIDArray(nil, FileNames.Count, PItemIDList(Pidls), obj));
  finally
    for I := Low(Pidls) to High(Pidls) do
      CoTaskMemFree(Pidls[I]);
  end;
  OleCheck(OleSetClipboard(obj));
  OleCheck(OleFlushClipboard);
end;

但是，我发现 Windows 资源管理器有时(但并非总是)允许将 CFSTR_SHELLIDLIST 粘贴到引用文件的源文件夹中。我不知道什么标准阻止 Windows 资源管理器粘贴。也许存在某种权限问题？

您应该听取 Microsoft 的建议:

Handling Shell Data Transfer Scenarios

Include as many formats as you can support. You generally do not know where the data object will be dropped. This practice improves the odds that the data object will contain a format that the drop target can accept.