Копировать буфер в поток и обратно

Оформил: DeeCo

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;