Буфер обмена

Code:

procedure CopyStringToClipboard(s: string);

var

hg: THandle;

P: PChar;

begin

hg:=GlobalAlloc(GMEM_DDESHARE or GMEM_MOVEABLE, Length(S)+1);

P:=GlobalLock(hg);

StrPCopy(P, s);

GlobalUnlock(hg);

OpenClipboard(Application.Handle);

SetClipboardData(CF_TEXT, hg);

CloseClipboard;

GlobalFree(hg);

end;

Code:

uses

  clipbrd;

procedure CopyStreamToClipboard(fmt: Cardinal; S: TStream);

var

  hMem: THandle;

  pMem: Pointer;

begin

  Assert(Assigned(S));

  S.Position := 0;

  hMem       := GlobalAlloc(GHND or GMEM_DDESHARE, S.Size);

  if hMem <> 0 then

  begin

    pMem := GlobalLock(hMem);

    if pMem <> nil then

    begin

      try

        S.Read(pMem^, S.Size);

        S.Position := 0;

      finally

        GlobalUnlock(hMem);

      end;

      Clipboard.Open;

      try

        Clipboard.SetAsHandle(fmt, hMem);

      finally

        Clipboard.Close;

      end;

    end { If }

    else

    begin

      GlobalFree(hMem);

      OutOfMemoryError;

    end;

  end { If }

  else

    OutOfMemoryError;

end; { CopyStreamToClipboard }

procedure CopyStreamFromClipboard(fmt: Cardinal; S: TStream);

var

  hMem: THandle;

  pMem: Pointer;

begin

  Assert(Assigned(S));

  hMem := Clipboard.GetAsHandle(fmt);

  if hMem <> 0 then

  begin

    pMem := GlobalLock(hMem);

    if pMem <> nil then

    begin

      try

        S.Write(pMem^, GlobalSize(hMem));

        S.Position := 0;

      finally

        GlobalUnlock(hMem);

      end;

    end { If }

    else

      raise Exception.Create('CopyStreamFromClipboard: could not lock global handle ' +

        'obtained from clipboard!');

  end; { If }

end; { CopyStreamFromClipboard }

procedure SaveClipboardFormat(fmt: Word; writer: TWriter);

var

  fmtname: array[0..128] of Char;

  ms: TMemoryStream;

begin

  Assert(Assigned(writer));

  if 0 = GetClipboardFormatName(fmt, fmtname, SizeOf(fmtname)) then

    fmtname[0] := #0;

  ms := TMemoryStream.Create;

  try

    CopyStreamFromClipboard(fmt, ms);

    if ms.Size > 0 then

    begin

      writer.WriteInteger(fmt);

      writer.WriteString(fmtname);

      writer.WriteInteger(ms.Size);

      writer.Write(ms.Memory^, ms.Size);

    end; { If }

  finally

    ms.Free

  end; { Finally }

end; { SaveClipboardFormat }

procedure LoadClipboardFormat(reader: TReader);

var

  fmt: Integer;

  fmtname: string;

  Size: Integer;

  ms: TMemoryStream;

begin

  Assert(Assigned(reader));

  fmt     := reader.ReadInteger;

  fmtname := reader.ReadString;

  Size    := reader.ReadInteger;

  ms      := TMemoryStream.Create;

  try

    ms.Size := Size;

    reader.Read(ms.memory^, Size);

    if Length(fmtname) > 0 then

      fmt := RegisterCLipboardFormat(PChar(fmtname));

    if fmt <> 0 then

      CopyStreamToClipboard(fmt, ms);

  finally

    ms.Free;

  end; { Finally }

end; { LoadClipboardFormat }

procedure SaveClipboard(S: TStream);

var

  writer: TWriter;

  i: Integer;

begin

  Assert(Assigned(S));

  writer := TWriter.Create(S, 4096);

  try

    Clipboard.Open;

    try

      writer.WriteListBegin;

      for i := 0 to Clipboard.formatcount - 1 do

        SaveClipboardFormat(Clipboard.Formats[i], writer);

      writer.WriteListEnd;

    finally

      Clipboard.Close;

    end; { Finally }

  finally

    writer.Free

  end; { Finally }

end; { SaveClipboard }

procedure LoadClipboard(S: TStream);

var

  reader: TReader;

begin

  Assert(Assigned(S));

  reader := TReader.Create(S, 4096);

  try

    Clipboard.Open;

    try

      clipboard.Clear;

      reader.ReadListBegin;

      while not reader.EndOfList do

        LoadClipboardFormat(reader);

      reader.ReadListEnd;

    finally

      Clipboard.Close;

    end; { Finally }

  finally

    reader.Free

  end; { Finally }

end; { LoadClipboard }

// Examples:

{ Save Clipboard }

procedure TForm1.Button1Click(Sender: TObject);

var

  ms: TMemoryStream;

begin

  ms := TMemoryStream.Create;

  try

    SaveClipboard(ms);

    ms.SaveToFile('c:\temp\ClipBrdSaved.dat');

  finally

    ms.Free;

  end; { Finally }

end;

{ Clear Clipboard }

procedure TForm1.Button2Click(Sender: TObject);

begin

  clipboard.Clear;

end;

{ Restore Clipboard }

procedure TForm1.Button3Click(Sender: TObject);

var

  fs: TfileStream;

begin

  fs := TFilestream.Create('c:\temp\ClipBrdSaved.dat',

    fmopenread or fmsharedenynone);

  try

    LoadClipboard(fs);

  finally

    fs.Free;

  end; { Finally }

end;

Code:

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, Beispiel:

procedure TForm1.Button1Click(Sender: TObject);

begin

CopyFilesToClipboard('C:\Bootlog.Txt'#0'C:\AutoExec.Bat');

end;

Code:

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;