Сохранение всего содержимого буфера обмена в файл

Code:

{ **** UBPFD *********** ****

 Зависимости: стандартные модули

Автор:       Lucifer, Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра.

Copyright:   https://www.delphiworld.narod.ru/

********************************************** }

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;