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;

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

使用我的应用程序,一旦文件被复制到剪贴板,我可以使用Windows资源管理器将它们粘贴到每个其他文件夹,除了文件最初来自的文件夹！我期待它的行为就像一个普通的Windows副本(即粘贴它应该创建一个后缀为’-copy’的文件),但这似乎不起作用.有线索吗？

解决方法

当唯一可用的剪贴板格式为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,Attrs));
  try
    OleCheck(SHBindToObject(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,PChar(FileNames[i]),Eaten,PidlChildren[i],Attrs));
    OleCheck(SF.GetUIObjectOf(0,FileNames.Count,PIdlChildren[0],IDataObject,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,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]),PidlInfo[I].Pidl,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]),Pidls[I],Attrs));
    OleCheck(CIDLData_CreateFromIDArray(nil,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资源管理器粘贴的标准是什么.也许是某种权限问题？

你应该听取微软的建议：

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.