复制任意文件或文件夹到剪贴板

Tags: /超级猛料/Stream.File.流、文件和目录/Shell操作/ Date Created:

uses
 ShlObj, ClipBrd;
procedure 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;
// Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
 CopyFilesToClipboard('C:\Bootlog.Txt'#0'C:\AutoExec.Bat');
end;
{
 Separate the files with a #0.
}

沈前卫的回答:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,ShlObj;

type
TForm1 = class(TForm)
  Button1: TButton;
  procedure Button1Click(Sender: TObject);
private
  { Private declarations }
public
  { Public declarations }
end;

var
  Form1: TForm1;

implementation
{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
const  FileName:string='c:\netlog.txt';
var
  DataHandle: THandle;
  DataPointer: PDROPFILES;
begin
  DataHandle := GlobalAlloc(GMEM_DDESHARE or GMEM_MOVEABLE,SizeOf(DROPFILES)+2+Length(FileName));
  DataPointer := PDROPFILES(GlobalLock(DataHandle));
  FillChar(DataPointer^,SizeOf(DROPFILES)+2+Length(FileName),0);
  DataPointer.pFiles:=SizeOf(DROPFILES);
  DataPointer.pt:=Point(0,0);
  DataPointer.fNC:=False;
  DataPointer.fWide:=False;
  Move(FileName[1],Pointer(Integer(DataPointer)+SizeOf(DROPFILES))^,Length(FileName));
  GlobalUnlock(DataHandle);
  OpenClipboard(Form1.Handle);
  EmptyClipboard;
  SetClipboardData(CF_HDROP, DataHandle);
  CloseClipboard;
end;

end.

在Windows的资源管理器中，选中一个或多个文件，在文件上单击鼠标右键，在弹出菜单中选复制。再切换到另外的目录，单击鼠标右键，点粘贴。就这样执行了一次文件的拷贝操作，那么Windows在拷贝过程中执行了什么操作，是否将整个文件拷贝到剪贴板上了呢？当然没有。实际上，Windows只是将一个文件结构拷贝到了剪贴版，这个结构如下：
　　 tDropFile＋文件1文件名＋vbNullChar＋文件2文件名＋vbNullChar……＋文件N文件名＋vbNullChar，其中tDropFile是一个DROPFILES结构，这个结构在Windows API中有定义。在粘贴文件时，利用API函数 DragQueryFile 就可以获得拷贝到剪贴板的文件全路径名，然后就可以根据获得的文件名执行文件拷贝函数，实现对文件的粘贴操作。
那么如何从剪切板或取复制的文件内容呢？请参看下面的例子：

/// Author：Peter Below
uses
 clipbrd, shellapi;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
 f: THandle;
 buffer: array [0..MAX_PATH] of Char;
 i, numFiles: Integer;
begin
 if not Clipboard.HasFormat(CF_HDROP) then Exit;
 Clipboard.Open;
 try
   f := Clipboard.GetAsHandle(CF_HDROP);
   if f <> 0 then
   begin
     numFiles := DragQueryFile(f, $FFFFFFFF, nil, 0);
     memo1.Clear;
     for i := 0 to numfiles - 1 do
     begin
       buffer[0] := #0;
       DragQueryFile(f, i, buffer, SizeOf(buffer));
       memo1.Lines.Add(buffer);
     end;
   end;
 finally
   Clipboard.Close;
 end;
end;

function FileList_SetToClipboard ( FileList : TStrings ): Boolean ;
var
 n : Integer ;
 sBuffer : string ;
 myDropFiles : TDropFiles ;
 hGlobal : THandle ;
 pMemory : Pointer ;
begin
 Result := False ;
  // make sure that directories don't have a trailing '\' and the files  exists
    // ...
  // fill the buffer with the file list, end with two #0
 sBuffer := '' ;
  for n := 0 to FileList . Count - 1 do
   sBuffer := sBuffer + FileList . Strings [ n ] + #0 ;
 sBuffer := sBuffer + #0 ;
  // prepare DropFiles structure
 myDropFiles . pFiles := SizeOf ( myDropFiles );
 myDropFiles . fNC := False ;
 myDropFiles . fWide := False ;
  // copy to global memory
 hGlobal := GlobalAlloc ( GMEM_MOVEABLE , SizeOf ( myDropFiles ) +
   Length ( sBuffer ));
  try
   pMemory := GlobalLock ( hGlobal );
    try
     CopyMemory ( pMemory , @ myDropFiles , SizeOf ( myDropFiles ));
     pMemory := Pointer ( Integer ( pMemory ) + SizeOf ( myDropFiles ));
     CopyMemory ( pMemory , @ sBuffer [ 1 ], Length ( sBuffer ));
    finally
     GlobalUnlock ( hGlobal );
    end ;
    // set to clipboard
   Clipboard . Open ;
    try
     Clipboard . SetAsHandle ( CF_HDROP , hGlobal );
    finally
     Clipboard . Close ;
    end ;
   Result := True ;
  except
    // free only if hGlobal could not set to the clipboard.
   GlobalFree ( hGlobal );
  end ;
end ;
procedure TForm1 . Button2Click ( Sender : TObject );
var
 Files : TStrings ;
begin
 Files := TStringList . Create ;
 Files . Add ( 'C:\in.tmp' );
 Files . Add ( 'C:\Out.tmp' );
 FileList_SetToClipboard ( Files );
 Files . Free ;
end ;