将文件复制到剪贴板,然后将它们粘贴到原始文件夹中不起作用

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

当唯一可用的剪贴板格式是,我无法将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资源管理器粘贴的标准是什么.也许是某种权限问题？

你应该听取微软的建议:

处理Shell数据传输方案

包括尽可能多的格式,您可以支持.您通常不知道数据对象将被删除的位置.这种做法提高了数据对象包含放置目标可以接受的格式的几率.