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

我有一个令人费解的情况。我在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;

过程TfMain.CopyFilesToClipboard（文件列表：字符串）；
常数
C_UNABLE_TO_ALLOCATE_MEMORY='无法分配内存'；
C_canable_TO_ACCESS_MEMORY='无法访问分配的内存'；
变量
DropFiles:PDropFiles；
hGlobal:THandle；
iLen：整数；
开始
iLen:=长度（文件列表）；
hGlobal:=GlobalAlloc（GMEM_共享或GMEM_可移动或
GMEM_zeronit，SizeOf（TDropFiles）+（iLen+2）*SizeOf（Char））；
如果（hGlobal=0），则
引发异常。创建（C\u无法\u分配\u内存）；
try DropFiles:=GlobalLock（hGlobal）；
如果（DropFiles=nil），则引发异常。创建（C\u无法\u访问\u内存）；
尝试
DropFiles^.pFiles:=SizeOf（TDropFiles）；
DropFiles^.fWide:=True；
如果文件列表为“”，则
移动（文件列表[1]，（PByte（DropFiles）+SizeOf（TDropFiles））^，
iLen*SizeOf（Char））；
最后
GlobalUnlock（hGlobal）；
结束；
剪贴板.SetAsHandle（CF_HDROP，hGlobal）；
除了
GlobalFree（hGlobal）；
结束；
结束；

（这似乎是互联网上流行的一段代码）

---

使用我的应用程序，文件复制到剪贴板后，我可以使用Windows资源管理器将它们粘贴到除文件最初来源的文件夹之外的其他每个文件夹中！我原以为它会像普通的Windows拷贝一样工作（即粘贴时它会创建一个后缀为“-copy”的文件），但这似乎不起作用。有什么线索吗？

当唯一可用的剪贴板格式是

CF\u 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;

或者：

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的建议：

包含尽可能多的格式。您通常不知道数据对象将被丢弃到哪里。这种做法提高了数据对象包含drop目标可以接受的格式的可能性

---

你也可以分享你的“粘贴”代码吗？复制代码似乎还可以。@mg30rg:没有“粘贴”代码，因为他正在使用资源管理器粘贴文件？@whosrdaddy-我真的不明白他的代码有什么意义。我以为他正在使用Explorer作为一个现实检查设备，以查看文件列表是否被复制。@dudeinmoon-那么你想使用Explorer粘贴你的文件？如果你是，但它失败了，它到底是怎么失败的？它是否抛出错误/异常消息？是否粘贴同时手动删除的文件？如果您不提供详细信息，我们将无能为力。@mg30rg-您好，是的，我正在使用Windows资源管理器粘贴文件（我正在尝试创建一个简单的剪贴板文件管理器）。它的失败之处在于，当您转到文件夹并右键单击“粘贴”时，什么也没有发生。如果我转到另一个文件夹并右键单击“粘贴”，它会起作用。对不起，我还想添加一点，即正在复制的文件集合可以来自多个源文件夹。@dude-普通Windows副本不会这样做。@SertacAkyuz:用户不能同时从不同文件夹中选择多个文件，但应用程序可以，而且Windows资源管理器能够粘贴来自多个源的文件。感谢Remy，这非常有效。我还没有遇到任何权限问题（可能是因为我的应用程序有一个清单来请求管理员权限？）。不管怎样，我会留意的。非常感谢你的帮助。

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;