复制文件到剪贴板，然后粘贴到它们原来的文件夹中不起作用。

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”的文件），但这似乎不起作用。 有什么线索吗？

- dudeinmoon

---

@mg30rg：他是在使用资源管理器粘贴文件，所以没有“粘贴”代码？ - whosrdaddy

@whosrdaddy - 我真的不明白他的代码有什么意义。我以为他是将Explorer用作现实检查设备，以查看文件列表是否实际复制。 - mg30rg

@dudeinmoon - 所以你希望使用 explorer 来粘贴你的文件？如果你尝试了但失败了，它是怎么失败的呢？ 是否会抛出错误/异常消息？是否会粘贴已经手动删除的文件？如果你不提供更多信息，我们无法给予帮助。 - mg30rg

@mg30rg - 你好，是的，我正在使用Windows资源管理器粘贴文件（我试图创建一个简单的剪贴板文件管理器）。它失败的原因是当你进入文件夹并右键粘贴时，什么也不会发生。但如果我进入另一个文件夹并右键粘贴，它就可以正常工作。 - dudeinmoon

@dudeinmoon - 你看...你无法调试你看不见的错误。 - mg30rg

Answer 1

我无法让Windows资源管理器在剪贴板格式为CF_HDROP时将内容粘贴到源文件夹中。但是，如果文件名以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的建议： 处理Shell数据传输方案 引用如下：

包括尽可能多的格式。通常，您不知道数据对象将被放置在何处。这种做法提高了数据对象包含目标接收器可以接受的格式的几率。

- Remy Lebeau

---

抱歉，我还想补充一下，被复制的文件集合可能来自多个源文件夹。 - dudeinmoon

@dude - 一般的Windows复制不会这样做。 - Sertac Akyuz

@SertacAkyuz：用户无法同时从不同文件夹中选择多个文件，但应用程序可以，并且Windows资源管理器能够从多个来源粘贴文件。 - Remy Lebeau

谢谢Remy, 这个完美地运作了。我还没有遇到任何权限问题（也许是因为我的应用程序有一个清单来请求管理员权限？）。无论如何，我会留意这个问题的。非常感谢您的帮助。 - dudeinmoon