[D2010] Dateien in Zwischenablage kopieren (PDF)

[H3llsing]

Hallo DPler,

entschuldigt bitte wenn ich ein weiteres Thema zu den vielen anderen Clipboard-Themen erstelle, aber die anderen führen leider nicht zur Lösung.
Nun zu meinem Problem:
Ich möchte gerne Dateien in die Zwischenablage kopieren und woanders einfügen. Beim kopieren geht etwas schief :(

dazu verwende ich diesen Code:

Delphi-Quellcode:

//################################################
//   CopyFilesToClipboard
//################################################
procedure TfrmAnfrage.CopyFilesToClipboard(FileList: string);
var
  DropFiles: PDropFiles;
  hGlobal: THandle;
  iLen: Integer;
begin
  iLen := Length(FileList) + 2;
  FileList := FileList + #0#0;
  hGlobal := GlobalAlloc(GMEM_MOVEABLE+GMEM_DDESHARE,
    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

ich habe

Delphi-Quellcode:

(PChar(DropFiles)

durch

Delphi-Quellcode:

(PAnsiChar(DropFiles)

bereits ersetzt da es sonst zu einem Fehler beim kopieren führt.

dann habe ich das Tool Clipboard-Explorer besorgt
und folgende abweichung beim kopieren im Explorer und beim kopieren per Programm festgestellt:

Explorer: HDROP: C:\Users\XXX\Documents\RAD Studio\Projekte\Hexacom\SalesBoard\bin\Anhang\10_P romotion2010_Q3.pdf
Programm: HDROP: C:\Users\XXX\Documents\RAD Studio\Projekte\He????.?.lesBoard\bin\Anhang\10_Pr omotion2010_Q3.pdf

desweiteren wird per programm nur der HDROP erstellt.
Beim Explorer kopieren der PDF: an die 11 Formate (DataObject,ShellIDListArray,dataobjectAtrribute.. .usw)

Ich wäre euch für jeden Tipp sehr Dankbar!

MFG
H3llsing

[H3llsing]

hat niemand ne idee woran es liegen könnte ?

[MarcoWarm]

Was genau ist

Delphi-Quellcode:

PDropFiles

?
Soll heißen ... auf welchen Typ ist das ein Pointer?

[H3llsing]

Da ich noch Delphi-Anfänger bin kann ich dir die frage nicht genau beantworten.

MSDN DROPFILES Structure ist zu entnehmen dass es ein Pointer aufs CF_HDROP Clipboard format ist. Dem die Daten in einer Liste von Filenamen vorliegt, die mit doppeltem #0 schließt.

;) ich hoffe ich lieg damit einiger maßen richtig :)

Die Funktion ist übrigens von den Schweizern Hier zu finden

[DeddyH]

Ich vermute ein Unicode-Problem. Wie sieht es so aus?

Delphi-Quellcode:

procedure TfrmAnfrage.CopyFilesToClipboard(FileList: AnsiString);
var
  DropFiles: PDropFiles;
  hGlobal: THandle;
  iLen: Integer;
begin
  iLen := Length(FileList) + 2;
  FileList := FileList + #0#0;
  hGlobal := GlobalAlloc(GMEM_MOVEABLE+GMEM_DDESHARE,
    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], (PAnsiChar(DropFiles) + SizeOf(TDropFiles))^, iLen);

    GlobalUnlock(hGlobal);
    Clipboard.SetAsHandle(CF_HDROP, hGlobal);
  end;
end

[H3llsing]

wunderbar =D
DeddyH du bist mein Held :)

Bin nicht draufgekommen es bei dem Funktionsparameter selbst umzustellen.

außerdem musste noch folgende Zeile geändert werden

Delphi-Quellcode:

hGlobal := GlobalAlloc(GMEM_MOVEABLE+GMEM_DDESHARE,

in

Delphi-Quellcode:

hGlobal := GlobalAlloc(GMEM_SHARE or GMEM_MOVEABLE or GMEM_ZEROINIT,

GesamtCode:

Delphi-Quellcode:

//################################################
//   CopyFilesToClipboard
//################################################
procedure TfrmAnfrage.CopyFilesToClipboard(FileList: Ansistring);
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], (PAnsiChar(DropFiles) + SizeOf(TDropFiles))^, iLen);

    GlobalUnlock(hGlobal);
    Clipboard.SetAsHandle(CF_HDROP, hGlobal);
  end;
end;

Vielen Dank an euch beide =)

[MarcoWarm]

*räusper*

Ein Unicode-Problem sollte man nicht damit lösen es zu ignorieren. Falls mal Unicodezeichen im Pfad vorkommen 'المسار_الأكاديمي.png' ... (oops hoffentlich hat google das richtig übersetzt) hilft dir diese routine nicht weiter. Also besser so:

Delphi-Quellcode:

procedure CopyFilesToClipboard(FileList: string);
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('Could not allocate memory.');
  try
    DropFiles := GlobalLock(hGlobal);
    if (DropFiles = nil) then raise Exception.Create('Could not access allocated memory.');
    try
      DropFiles^.pFiles := SizeOf(TDropFiles);
      DropFiles^.fWide := (SizeOf(Char) = SizeOf(WideChar));

      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;

Dann geht auch sowas:

Delphi-Quellcode:

procedure TForm2.Button1Click(Sender: TObject);
begin
  CopyFilesToClipboard('C:\Temp\المسار_الأكاديمي.png');
end;

viel Spaß

Marco

[himitsu]

Zitat:

Zitat von DeddyH (Beitrag 1038926)

Ich vermute ein Unicode-Problem.

Nee, hier würde mal das Unicodeproblem auftreten, wenn man den Code genauso in einem älteren Delphi ausführt.

Diese Strucktur muß als Unicode vorliegen. :stupid:

[MarcoWarm]

Zitat:

Zitat von himitsu (Beitrag 1038950)

Diese Strucktur muß als Unicode vorliegen. :stupid:

Die Struktur selbst ist in jeder Version gleich, da sie selbst keine Stringdaten enthält. Da gibt es keine Unicodeversion. Daher auch das boolsche Wide-Flag

[DeddyH]

Eine Frage noch: müsste das letzte except nicht eigentlich ein finally sein?