Справочник функций

Ваш аккаунт

Войти через: 
Забыли пароль?
Регистрация
Информацию о новых материалах можно получать и без регистрации:

Почтовая рассылка

Подписчиков: -1
Последний выпуск: 19.06.2015

Буфер обмена

330
26 октября 2011 года
kastron
215 / / 17.09.2006
Здравствуйте. Подскажите пожалуйста как при клике на Button1 проверить есть ли что-то в буфере обмена Windows если да и это файлы или папки то вставить их по указанному пути?
19K
26 октября 2011 года
Alegun
269 / / 10.09.2010
Примерно вот так:
Код:
uses ShellAPI;
procedure CopyFilesFromClipBoard(Path: string);
var
f: THandle;
buffer: array [0..MAX_PATH] of Char;
i,numFiles: Integer;
begin
// проверка - а есть ли файлы в буфере?
if not Clipboard.HasFormat(CF_HDROP) then Exit;
Clipboard.Open;
try
   f := Clipboard.GetAsHandle(CF_HDROP);
   if f <> 0 then
   begin
  // получаем имя (имена) файла(ов):
     numFiles := DragQueryFile(f, $FFFFFFFF, nil, 0);
     for i := 0 to numfiles - 1 do
     begin
     buffer[0] := #0;
     DragQueryFile(f, i, buffer, SizeOf(buffer));

// В данный момент в buffer лежит имя файла
// и с ним можно делать что угодно, например скопировать:

 CopyFile(buffer,PChar(Path+
'\' // можно слеш и убрать, при необходимости
+ExtractFileName(buffer)),
True);
      end;
   end;
finally
   Clipboard.Close;
end;
end;

Использование:
 
Код:
procedure TForm1.Button1Click(Sender: TObject);
begin
CopyFilesFromClipBoard('C:\Slops');
end;

Если в буфере обмена есть файлы, то они будут скопированны в папку C:\Slops. Для копирования папок нужно использовать другие методы.
330
26 октября 2011 года
kastron
215 / / 17.09.2006
спасибо! а какие методы для папок использовать?
330
26 октября 2011 года
kastron
215 / / 17.09.2006
разобрался

Код:
function FullDirectoryCopy(SourceDir, TargetDir: string; StopIfNotAllCopied,
  OverWriteFiles: Boolean): Boolean;
var
  SR: TSearchRec;
  I: Integer;
begin
  Result := False;
  SourceDir := IncludeTrailingBackslash(SourceDir);
  TargetDir := IncludeTrailingBackslash(TargetDir);
  if not DirectoryExists(SourceDir) then
    Exit;
  if not ForceDirectories(TargetDir) then
    Exit;

  I := FindFirst(SourceDir + '*', faAnyFile, SR);
  try
    while I = 0 do
    begin
      if (SR.Name <> '') and (SR.Name <> '.') and (SR.Name <> '..') then
      begin
        if SR.Attr = faDirectory then
          Result := FullDirectoryCopy(SourceDir + SR.Name, TargetDir + SR.NAME,
            StopIfNotAllCopied, OverWriteFiles)
        else if not (not OverWriteFiles and FileExists(TargetDir + SR.Name))
          then
          Result := CopyFile(Pchar(SourceDir + SR.Name), Pchar(TargetDir +
            SR.Name), False)
        else
          Result := True;
        if not Result and StopIfNotAllCopied then
          exit;
      end;
      I := FindNext(SR);
    end;
  finally
    SysUtils.FindClose(SR);
  end;
end;

procedure CopyFilesFromClipBoard(Path: string);
var
  f: THandle;
  buffer: array [0..MAX_PATH] of Char;
  i,numFiles: Integer;
begin
if not Clipboard.HasFormat(CF_HDROP) then Exit;
Clipboard.Open;
try
   f := Clipboard.GetAsHandle(CF_HDROP);
   if f <> 0 then
   begin
     numFiles := DragQueryFile(f, $FFFFFFFF, nil, 0);
     for i := 0 to numfiles - 1 do
     begin
       buffer[0] := #0;
       DragQueryFile(f, i, buffer, SizeOf(buffer));
       if FileExists(buffer)=True then
       begin
         CopyFile(buffer,PChar(Path+ExtractFileName(buffer)), True);
       end;
       if DirectoryExists(buffer)=True then
       begin
         FullDirectoryCopy(buffer, Path+ExtractFileName(buffer), False, True);
       end;
     end;
   end;
finally
   Clipboard.Close;
end;
end;
330
26 октября 2011 года
kastron
215 / / 17.09.2006
еще вопрос, пытаюсь скопировать в буфер выделенные файлы и папки в ShellListView - не работает

Код:
var
  H:THandle;
  i:integer;
  Lst:TStringList;
begin
  Lst:=TStringList.Create;
  for i:=0 to ShellListView.Items.Count-1 do
  begin
    if ShellListView.Items.Item.Selected=True then
    Lst.Add(ShellListView.Folders.PathName);
  end;
  H:=HWND(Lst.Text);
  SetClipboardData(CF_HDROP, H);
  CloseClipboard;
  GlobalFree(H);
  Lst.Free;
end;
330
26 октября 2011 года
kastron
215 / / 17.09.2006
всё разобрался

Код:
procedure CopyFilesToClipboard(FileList: String);
var
 DropFiles: PDropFiles;
 hGlobal: THandle;
 iLen: Integer;
begin
  iLen := Length(FileList);
  hGlobal := GlobalAlloc(GMEM_SHARE or GMEM_MOVEABLE or GMEM_ZEROINIT, SizeOf(TDropFiles) + iLen);
  if (hGlobal = 0) then
   begin
    Exit;
   end;
  DropFiles := GlobalLock(hGlobal);
  DropFiles^.pFiles := SizeOf(TDropFiles);
  Move(FileList[1], (PChar(DropFiles) + SizeOf(TDropFiles))^, iLen);
  GlobalUnlock(hGlobal);
  if OpenClipboard(0) then
   begin
    SetClipboardData(CF_HDROP, hGlobal);
    CloseClipboard;
   end;
end;
19K
26 октября 2011 года
Alegun
269 / / 10.09.2010
Ай молдца, kastron - наконец-то догуглился:) А я тебе вот такой изврат предложить хотел:
(некоторые элементы совпадают (FullDirectoryCopy), поэтому пропущу койчего;))

Код:
uses Clipbrd, ShellAPI, FileCtrl ;

function FullDirectoryCopy(SourceDir, TargetDir: string; StopIfNotAllCopied,
  OverWriteFiles: Boolean): Boolean;

function DirName(Path: string): string;
var i: integer;
begin
if Path = '' then exit;
for i:=Length(Path) DownTo 1 do if Path='\' then
begin
Result:= Copy(Path, i, Length(Path));
exit;
end;
end;

procedure CopyFilesAndDirFromClipBoard(Path: string);
var
f: THandle;
buffer: array [0..MAX_PATH] of Char;
i, numFiles: Integer;
begin
if not Clipboard.HasFormat(CF_HDROP) then Exit;
Clipboard.Open;
try
   f:= Clipboard.GetAsHandle(CF_HDROP);
   if f <> 0 then
   begin
     numFiles:= DragQueryFile(f, $FFFFFFFF, nil, 0);
     for i:= 0 to numfiles - 1 do
     begin
     buffer[0]:= #0;
     DragQueryFile(f,i,buffer,SizeOf(buffer));
     
     if DirectoryExists(buffer) then
     FullDirectoryCopy(buffer,Path+DirName(buffer),False,True) else
     CopyFile(buffer,PChar(Path + '\'+ ExtractFilename(buffer)),True);
      end;
   end;
finally
   Clipboard.Close;
end;
end;


Но твой варьянт намного проще, молоток!
Реклама на сайте | Обмен ссылками | Ссылки | Экспорт (RSS) | Контакты
Добавить статью | Добавить исходник | Добавить хостинг-провайдера | Добавить сайт в каталог