複製文件到剪貼板，然後粘貼到他們的原始文件夾不起作用

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資源管理器粘貼。也許某種權限問題？

你應該把微軟的建議是：

Handling Shell Data Transfer Scenarios

包含儘可能多的格式，可以支持。您通常不知道數據對象將放置在何處。這種做法提高了數據對象將包含放置目標可以接受的格式的機率。