Code:

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;

Code:

{ **** UBPFD *********** by kladovka.net.ru ****

>> Сохранение буфера обмена в файл

Процедура позволяет сохранить содержимое буфера обмена в заданый файл.

Код процедуры был взят на сайте: http://www.delphiworld.narod.ru/

(http://www.delphiworld.narod.ru/base/clipbrd_to_file.html) адаптирован под мои нужды.

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;