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;
Буфер обмена
Здравствуйте. Подскажите пожалуйста как при клике на Button1 проверить есть ли что-то в буфере обмена Windows если да и это файлы или папки то вставить их по указанному пути?
Код:
Использование:
Код:
procedure TForm1.Button1Click(Sender: TObject);
begin
CopyFilesFromClipBoard('C:\Slops');
end;
begin
CopyFilesFromClipBoard('C:\Slops');
end;
Если в буфере обмена есть файлы, то они будут скопированны в папку C:\Slops. Для копирования папок нужно использовать другие методы.
спасибо! а какие методы для папок использовать?
Код:
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;
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;
Код:
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;
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;
Код:
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;
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;
(некоторые элементы совпадают (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;
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;
Но твой варьянт намного проще, молоток!