Clipboard temporär speichern

[Sherlock]

Und weil auch das Webarchiv irgendwann einmal den Weg alles irdischen gegangen sein könnte:

Zitat:

...copy the clipboard to a stream and restore it again?
Autor: P. Below
Homepage: http://www.teamb.com

Delphi-Quellcode:

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;

Sherlock
- bevor Fragen aufkommen: Die Delphipraxis ist ewig...