在Delphi中將文件複製到剪貼板中

Question

我想將文件複製到剪貼板。互聯網中的所有例子都是一樣的。我使用的是http://embarcadero.newsgroups.archived.at/public.delphi.nativeapi/200909/0909212186.html，但它不起作用。

我使用Rad Studio XE並傳遞完整路徑。在調試模式，我得到這樣一些警告：

Debug Output: 
Invalid address specified to RtlSizeHeap(006E0000, 007196D8) 
Invalid address specified to RtlSizeHeap(006E0000, 007196D8) 

我不知道是我的環境有關：Windows 8.1中64位的RAD Studio XE。 當我嘗試粘貼剪貼板時，沒有任何反應。另外，使用監視器工具查看剪貼板，該工具會顯示錯誤。

的代碼是：

procedure TfrmDoc2.CopyFilesToClipboard(FileList: string); 
    var 
     DropFiles: PDropFiles; 
     hGlobal: THandle; 
     iLen: Integer; 
    begin 
     iLen := Length(FileList) + 2; 
     FileList := FileList + #0#0; 
     hGlobal := GlobalAlloc(GMEM_SHARE or GMEM_MOVEABLE or GMEM_ZEROINIT, 
     SizeOf(TDropFiles) + iLen); 
     if (hGlobal = 0) then raise Exception.Create('Could not allocate memory.'); 
     begin 
     DropFiles := GlobalLock(hGlobal); 
     DropFiles^.pFiles := SizeOf(TDropFiles); 
     Move(FileList[1], (PChar(DropFiles) + SizeOf(TDropFiles))^, iLen); 
     GlobalUnlock(hGlobal); 
     Clipboard.SetAsHandle(CF_HDROP, hGlobal); 
     end; 
    end; 

UPDATE：

我很抱歉，我覺得愚蠢。在我的項目中，我使用了無法運行的代碼，即有人問到的原始問題，而我使用了Remy的代碼，這是Stackoverflow中的正確解決方案。我以爲我在我的項目中使用了Remy的代碼。所以，現在，使用Remy的代碼，一切都很好。對不起，這個錯誤。

Answer 1

您鏈接到的論壇帖子包含您的問題中的代碼，並詢問爲什麼它不起作用。毫不奇怪，代碼對於你來說不再適用於提問者。

Remy給出的答案是ANSI和Unicode之間不匹配。代碼用於ANSI，但編譯器是Unicode。

所以點擊雷米的回答，做它說：http://embarcadero.newsgroups.archived.at/public.delphi.nativeapi/200909/0909212187.html

基本上你需要適應的代碼解釋字符爲寬2個字節的Unicode德爾福，但我沒有看到真正的目的在這裏重複雷米的代碼。

但是，我會說你可以做得比這個代碼更好。這段代碼的問題在於它將每個方面都混合到一個大功能中。更重要的是，這個函數是GUI中的一種形式的方法，它確實是錯誤的地方。代碼的某些方面可能可以重用，但不能這樣分解。

我會從一個將已知內存塊放入剪貼板的函數開始。

procedure ClipboardError; 
begin 
    raise Exception.Create('Could not complete clipboard operation.'); 
    // substitute something more specific that Exception in your code 
end; 

procedure CheckClipboardHandle(Handle: HGLOBAL); 
begin 
    if Handle=0 then begin 
    ClipboardError; 
    end; 
end; 

procedure CheckClipboardPtr(Ptr: Pointer); 
begin 
    if not Assigned(Ptr) then begin 
    ClipboardError; 
    end; 
end; 

procedure PutInClipboard(ClipboardFormat: UINT; Buffer: Pointer; Count: Integer); 
var 
    Handle: HGLOBAL; 
    Ptr: Pointer; 
begin 
    Clipboard.Open; 
    Try 
    Handle := GlobalAlloc(GMEM_MOVEABLE, Count); 
    Try 
     CheckClipboardHandle(Handle); 
     Ptr := GlobalLock(Handle); 
     CheckClipboardPtr(Ptr); 
     Move(Buffer^, Ptr^, Count); 
     GlobalUnlock(Handle); 
     Clipboard.SetAsHandle(ClipboardFormat, Handle); 
    Except 
     GlobalFree(Handle); 
     raise; 
    End; 
    Finally 
    Clipboard.Close; 
    End; 
end; 

我們還需要能夠製作雙空終止的字符串列表。像這樣：

function DoubleNullTerminatedString(const Values: array of string): string; 
var 
    Value: string; 
begin 
    Result := ''; 
    for Value in Values do 
    Result := Result + Value + #0; 
    Result := Result + #0; 
end; 

也許你可能會增加一個接受TStrings實例的超載。

現在我們已經擁有了所有這些，我們可以專注於製作CF_HDROP格式所需的結構。

procedure CopyFileNamesToClipboard(const FileNames: array of string); 
var 
    Size: Integer; 
    FileList: string; 
    DropFiles: PDropFiles; 
begin 
    FileList := DoubleNullTerminatedString(FileNames); 
    Size := SizeOf(TDropFiles) + ByteLength(FileList); 
    DropFiles := AllocMem(Size); 
    try 
    DropFiles.pFiles := SizeOf(TDropFiles); 
    DropFiles.fWide := True; 
    Move(Pointer(FileList)^, (PByte(DropFiles) + SizeOf(TDropFiles))^, 
     ByteLength(FileList)); 
    PutInClipboard(CF_HDROP, DropFiles, Size); 
    finally 
    FreeMem(DropFiles); 
    end; 
end; 

Answer 2

由於您使用Delphi XE，字符串是Unicode，但是當您分配和移動內存時，您不會將字符大小計算在內。

更改行分配內存

hGlobal := GlobalAlloc(GMEM_SHARE or GMEM_MOVEABLE or GMEM_ZEROINIT, 
    SizeOf(TDropFiles) + iLen * SizeOf(Char)); 

和行復制記憶，

Move(FileList[1], (PByte(DropFiles) + SizeOf(TDropFiles))^, iLen * SizeOf(Char)); 

注意，在兩條線納入*SizeOf(Char)和PChar類型的變化PBYTE在第二行。

然後，還DROPFILES的fWide成員設置爲True

DropFiles^.fWide := True; 

所有這些變化都已經從雷米代碼，由大衛稱。