CODEWITHSUNDEEP
delphidelphi-xe
Dabiel Kabuto
Dabiel Kabuto

Reputation: 2862

Copy a file to clipboard in Delphi

I am trying to copy a file to the clipboard. All examples in Internet are the same. I am using one from, http://embarcadero.newsgroups.archived.at/public.delphi.nativeapi/200909/0909212186.html but it does not work.

I use Rad Studio XE and I pass the complete path. In mode debug, I get some warnings like:

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

I am not sure is my environment is related: Windows 8.1 64 bits, Rad Studio XE. When I try to paste the clipboard, nothing happens. Also, seeing the clipboard with a monitor tool, this tool shows me error.

The code is:

    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:

I am sorry, I feel stupid. I used the code that did not work, the original question that somebody asked, in my project, while I used the Remy's code, the correct solution, here in Stackoverflow. I thought that I used the Remy's code in my project. So, now, using the Remy's code, everything works great. Sorry for the mistake.

Upvotes: 4

Views: 4719

Answers (2)

David Heffernan
David Heffernan

Reputation: 613013

The forum post you link to contains the code in your question and asks why it doesn't work. Not surprisingly the code doesn't work for you any more than it did for the asker.

The answer that Remy gives is that there is a mismatch between ANSI and Unicode. The code is for ANSI but the compiler is Unicode.

So click on Remy's reply and do what it says: http://embarcadero.newsgroups.archived.at/public.delphi.nativeapi/200909/0909212187.html

Essentially you need to adapt the code to account for characters being 2 bytes wide in Unicode Delphi, but I see no real purpose repeating Remy's code here.

However, I'd say that you can do better than this code. The problem with this code is that it mixes every aspect all into one big function that does it all. What's more, the function is a method of a form in your GUI which is really the wrong place for it. There are aspects of the code that you might be able to re-use, but not factored like that.

I'd start with a function that puts an known block of memory into the clipboard.

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;

We're also going to need to be able to make double-null terminated lists of strings. Like this:

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;

Perhaps you might add an overload that accepted a TStrings instance.

Now that we have all this we can concentrate on making the structure needed for the CF_HDROP format.

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;

Upvotes: 13

Tom Brunberg
Tom Brunberg

Reputation: 21033

Since you use Delphi XE, strings are Unicode, but you are not taking the size of character into count when you allocate and move memory.

Change the line allocating memory to

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

and the line copying memory, to

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

Note the inclusion of *SizeOf(Char) in both lines and change of PChar to PByte on second line.

Then, also set the fWide member of DropFiles to True

   DropFiles^.fWide := True;

All of these changes are already in the code from Remy, referred to by David.

Upvotes: 2

Related Questions