Сохранение буфера обмена в файл
Процедура позволяет сохранить содержимое буфера обмена в заданый файл.
P.S. На всякий случай: я не претендую на авторство данного кода, я его просто привёл к виду, который мне больше подходил.
В эту базу я его выложил исходя из предположения, что не каждый, кому понадобится такая процедура знает вышеуказанный адрес или
обратится туда (сам долго искал иные способы).
|
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; |
Из рассылки "Мастера DELPHI. Новости мира компонент,..."
|
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; |
Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.
ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!