var FS:TFileStream;

procedure TForm1.bClearClick(Sender: TObject);

begin

OpenClipBoard(0);

EmptyClipboard;

CloseClipBoard;

end;

procedure TForm1.BSaveClick(Sender: TObject);

var CBF:Cardinal;

CBFList:TList;

i:Integer;

h:THandle;

p:Pointer;

CBBlockLength,Temp:Cardinal;

FS:TFileStream;

begin

if OpenClipBoard(0)then begin

CBFList:=TList.Create;

CBF:=0;

repeat

CBF:=EnumClipboardFormats(CBF);

if CBF<>0 then

CBFList.Add(pointer(CBF));

until CBF=0;

edit1.text:=IntToStr(CBFList.Count);

if CBFList.Count>0 then begin

FS:=TFileStream.Create('e:\cp.dat',fmCreate);

Temp:=CBFList.Count;

FS.Write(Temp,SizeOf(Integer));

for i:=0 to CBFList.Count-1 do begin

h:=GetClipboardData(Cardinal(CBFList[i]));

if h>0 then begin

CBBlockLength:=GlobalSize(h);

if h>0 then begin

p:=GlobalLock(h);

if p <> nil then begin

Temp:=Cardinal(CBFList[i]);

FS.Write(Temp,SizeOf(Cardinal));

FS.Write(CBBlockLength,SizeOf(Cardinal));

FS.Write(p^,CBBlockLength);

end;

GlobalUnlock(h);

end;

end;

end;

FS.Free;

end;

CBFList.Free;

CloseClipBoard;

 end;

end;

procedure TForm1.bLoadClick(Sender: TObject);

var h:THandle;

p:Pointer;

CBF:Cardin!

al;

CBBlockLength:Cardinal;

i,CBCount:Integer;

FS:TFileStream;

begin

if OpenClipBoard(0)then begin

FS:=TFileStream.Create('e:\cp.dat',fmOpenRead);

if FS.Size=0 then Exit;

FS.Read(CBCount,sizeOf(Integer));

if CBCount=0 then Exit;

for i:=1 to CBCount do begin

FS.Read(CBF,SizeOf(Cardinal));

FS.Read(CBBlockLength,SizeOf(Cardinal));

h:=GlobalAlloc(GMEM_MOVEABLE or GMEM_SHARE or GMEM_ZEROINIT,CBBlockLength);

if h>0 then begin

p:=GlobalLock(h);

if p=nil then

GlobalFree(h)

else begin

FS.Read(p^,CBBlockLength);

GlobalUnlock(h);

SetClipboardData(CBF,h);

end;

end;

end;

FS.Free;

CloseClipBoard;

end;

end;

{ **** UBPFD *********** by kladovka.net.ru ****
>> Сохранение буфера обмена в файл
Процедура позволяет сохранить содержимое буфера обмена в заданый файл.
Код процедуры был взят на сайте: http://www.delphiworld.narod.ru/
(<a href="http://www.delphiworld.narod.ru/base/clipbrd_to_file.html" title="http://www.delphiworld.narod.ru/base/clipbrd_to_file.html">http://www.delphiworld.narod.ru/base/clipbrd_to_file.html</a>) адаптирован под мои нужды.
P.S. На всякий случай: я не претендую на авторство
данного кода, я его просто привёл к виду, который мне больше подходил.
В эту базу я его выложил исходя из предположения, что не каждый,
кому понадобится такая процедура знает вышеуказанный адрес или
обратится туда (сам долго искал иные способы).
Зависимости: стандартные модули
Автор: Lucifer, _lucifer_@ukr.net
Copyright: http://www.delphiworld.narod.ru/
Дата: 6 октября 2004 г.
********************************************** }
procedure SaveFromClipBoardTo(FileName: string);
var
 CBFList: TList;
 i: Integer;
 h: THandle;
 p: Pointer;
 CBBlockLength,
 Temp,
 CBF: Cardinal;
 FS: TFileStream;
begin
 if OpenClipBoard(0) then begin
 CBFList := TList.Create;
 CBF := 0;
 repeat
  CBF := EnumClipboardFormats(CBF);
  if CBF <> 0 then CBFList.Add(pointer(CBF));
 until CBF = 0;
 if CBFList.Count > 0 then begin
  FS := TFileStream.Create(FileName, fmCreate);
  Temp := CBFList.Count;
  FS.Write(Temp, SizeOf(Integer));
  for i := 0 to CBFList.Count - 1 do begin
  h := GetClipboardData(Cardinal(CBFList[i]));
  if h > 0 then begin
  CBBlockLength := GlobalSize(h);
  if h > 0 then begin
  p := GlobalLock(h);
  if p <> nil then begin
  Temp := Cardinal(CBFList[i]);
  FS.Write(Temp, SizeOf(Cardinal));
  FS.Write(CBBlockLength, SizeOf(Cardinal));
  FS.Write(p^, CBBlockLength);
  end;
  GlobalUnlock(h);
  end;
  end;
  end;
  FS.Free;
 end;
 CBFList.Free;
 CloseClipBoard;
 end;
end;