// Hiermit kann man Namen von Dateien in die Zwischenablage stellen, um sie
// dann beispielsweise im Windows-Explorer einzufügen.

// Getestet mit D4 unter WinME
 

uses clipbrd, shlobj; 
 
function DateienInsClipboard(dateien: TStrings): boolean; 
var 
  df: ^_DropFiles; 
  lg, h, x, g: integer; 
  s: string; 
begin 
  result := false; 
  if dateien.count > 0 then begin 
    s := ''; 
    for x := 0 to dateien.count - 1 do begin 
      if not fileexists(dateien[x]) then exit; 
      s := s + dateien[x] + #0; 
    end; 
    s := s + #0; 
    lg := length(s); 
    g := sizeof(_DropFiles); 
    h := globalalloc(gmem_zeroinit or gmem_ddeshare, g + lg); 
    if h <> 0 then begin 
      try 
        df := globallock(h); 
        df^.pfiles := g; 
        move(s[1], (pchar(df) + g)^, lg); 
        clipboard.setashandle(cf_hdrop, h); 
        globalunlock(h); 
        result := true; 
      except 
      end; 
    end; 
  end; 
end; 
 
 
// Beispielaufruf 
 
procedure TForm1.Button4Click(Sender: TObject); 
begin 
  Listbox1.items.clear; 
  Listbox1.items.add('C:\test.txt'); 
  Listbox1.items.add('C:\autoexec.bat'); 
  Listbox1.items.add('D:\programme\delph2htm.exe'); 
  if not DateienInsClipboard(Listbox1.items) 
    then showmessage('Fehler'); 
end;

// -------------------------------------------------------------------

// Und so kann man die Namen wieder herausholen:

uses shellapi; 
 
procedure GetClipFiles(gefunden: TStrings; loeschen: boolean); 
var 
  hDrop, count, i, size: longint; 
  File_Flr: string; 
begin 
  gefunden.clear; 
  if OpenClipboard(0) then begin 
    try 
      hDrop := GetClipboardData(CF_HDROP); 
      if hDrop <> 0 then begin 
        count := DragQueryFile(hDrop, $FFFFFFFF, nil, 0) - 1; 
        for i := 0 to count do begin 
          size := dragqueryfile(hDrop, i, nil, 0); 
          setlength(File_Flr, size); 
          dragqueryfile(hDrop, i, pchar(File_Flr), size + 1); 
          gefunden.add(File_Flr); 
        end; 
        if loeschen then EmptyClipboard; 
      end; 
    finally 
      CloseClipboard; 
    end; 
  end; 
end; 
 
// Beispielaufruf 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  GetClipFiles(Listbox1.Items, True); 
  if Listbox1.items.count = 0 
    then Listbox1.items.add('+++ Nichts gefunden +++'); 
end; 



Zugriffe seit 6.9.2001 auf Delphi-Ecke