function shfileoperation(const lpfileop: tshfileopstruct): integer; stdcall;
Данная функция позволяет производить копирование, перемещение,
переименование и удаление (в том числе и в recycle bin) объектов файловой системы.
Функция возвращает 0, если операция выполнена успешно,
и ненулевое значение в противном :-) случае.
Функция имеет единственный аргумент - структуру типа tshfileopstruct,
в которой и передаются все необходимые данные.
Эта структура выглядит следующим образом:
_shfileopstructa = packed record
wnd: hwnd;
wfunc: uint;
pfrom: pansichar;
pto: pansichar;
fflags: fileop_flags;
fanyoperationsaborted: bool;
hnamemappings: pointer;
lpszprogresstitle: pansichar; { используется только при установленном флаге fof_simpleprogress }
end;
Поля этой структуры имеют следующее назначение:
hwnd Хэндл окна, на которое будут выводиться диалоговые окна о ходе операции.
wfunc Требуемая операция. Может принимать одно из значений:
fo_copy Копирует файлы, указанные в pfrom в папку, указанную в pto.
fo_delete Удаляет файлы, указанные pfrom (pto игнорируется).
fo_move Перемещает файлы, указанные в pfrom в папку, указанную в pto.
fo_rename Переименовывает файлы, указанные в pfrom.
pfrom
Указатель на буфер, содержащий пути к одному или нескольким файлам.
Если файлов несколько, между путями ставится нулевой байт.
Список должен заканчиваться двумя нулевыми байтами.
pto
Аналогично pfrom, но содержит путь к директории - адресату,
в которую производится копирование или перемещение файлов.
Также может содержать несколько путей.
При этом нужно установить флаг fof_multidestfiles.
fflags
Управляющие флаги.
fof_allowundo Если возможно, сохраняет информацию для возможности undo.
fof_confirmmouse Не реализовано.
fof_filesonly Если в поле pfrom установлено *.*, то операция
будет производиться только с файлами.
fof_multidestfiles Указывает, что для каждого исходного
файла в поле pfrom указана своя директория - адресат.
fof_noconfirmation Отвечает "yes to all" на все запросы в ходе опеации.
fof_noconfirmmkdir Не подтверждает создание нового каталога,
если операция требует, чтобы он был создан.
fof_renameoncollision В случае, если уже существует файл
с данным именем, создается файл с именем "copy #n of..."
fof_silent Не показывать диалог с индикатором прогресса.
fof_simpleprogress Показывать диалог с индикатором прогресса,
но не показывать имен файлов.
fof_wantmappinghandle Вносит hnamemappings элемент.
Дескриптор должен быть освобожден функцией shfreenamemappings.
fanyoperationsaborted
Принимает значение true если пользователь прервал любую файловую
операцию до ее завершения и false в ином случае.
hnamemappings
Дескриптор объекта отображения имени файла, который содержит
массив структур shnamemapping. Каждая структура содержит
старые и новые имена пути для каждого файла, который перемещался,
скопирован, или переименован. Этот элемент используется только,
если установлен флаг fof_wantmappinghandle.
lpszprogresstitle
Указатель на строку, используемую как заголовок для диалогового окна прогресса.
Этот элемент используется только, если установлен флаг fof_simpleprogress.
Примечание.
Если pfrom или pto не указаны, берутся файлы из текущей директории.
Текущую директорию можно установить с помощью функции setcurrentdirectory
и получить функцией getcurrentdirectory.
А теперь - примеры.
Разумеется, вам нужно вставить в секцию uses модуль shellapi, в котором определена
функция shfileoperation.
Рассмотрим самое простое - удаление файлов.
procedure tform1.button1click(sender: tobject);
var
shfileopstruct : tshfileopstruct;
from : array [0..255] of char;
begin
setcurrentdirectory( pchar( 'c:' ) );
from := 'test1.tst' + #0 + 'test2.tst' + #0 + #0;
with shfileopstruct do
begin
wnd := handle;
wfunc := fo_delete;
pfrom := @from;
pto := nil;
fflags := 0;
fanyoperationsaborted := false;
hnamemappings := nil;
lpszprogresstitle := nil;
end;
shfileoperation( shfileopstruct );
end;
Обратите внимание, что ни один из флагов не установлен.
Если вы хотите не просто удалить файлы, а переместить их
в корзину, должен быть установлен флаг fof_allowundo.
Для удобства дальнейших экспериментов напишем функцию,
создающую из массива строк буфер для передачи его в качестве параметра pfrom.
После каждой строки в буфер вставляется нулевой байт, в конце списка - два нулевых байта.
type tbuffer = array of char;
procedure createbuffer( names : array of string; var p : tbuffer );
var i, j, l : integer;
begin
for i := low( names ) to high( names ) do
begin
l := length( p );
setlength( p, l + length( names[ i ] ) + 1 );
for j := 0 to length( names[ i ] ) - 1 do
p[ l + j ] := names[ i, j + 1 ];
p[ l + j ] := #0;
end;
setlength( p, length( p ) + 1 );
p[ length( p ) ] := #0;
end;
Выглядит ужасно, но работает. Можно написать красивее, просто лень.
И, наконец, функция, удаляющая файлы, переданные ей в списке names.
Параметр torecycle определяет, будут ли файлы перемещены в корзину
или удалены. Функция возвращает 0, если операция выполнена успешно,
и ненулевое значение, если руки у кого-то растут не из того места, и этот
кто-то всунул функции имена несуществующих файлов.
function deletefiles( handle : hwnd; names : array of string; torecycle : boolean ) : integer;
var
shfileopstruct : tshfileopstruct;
src : tbuffer;
begin
createbuffer( names, src );
with shfileopstruct do
begin
wnd := handle;
wfunc := fo_delete;
pfrom := pointer( src );
pto := nil;
fflags := 0;
if torecycle then fflags := fof_allowundo;
fanyoperationsaborted := false;
hnamemappings := nil;
lpszprogresstitle := nil;
end;
result := shfileoperation( shfileopstruct );
src := nil;
end;
Обратите внимание, что мы освобождаем буфер src простым
присваиванием значения nil. Если верить документации,
потери памяти при этом не происходит, а напротив,
происходит корректное уничтожение динамического массива.
Каким образом, правда - это рак мозга :-).
Проверяем :
procedure tform1.button1click(sender: tobject);
begin
deletefiles( handle, [ 'c:test1', 'c:test2' ], true );
end;
Вроде все работает.
Кстати, обнаружился забавный глюк - вызовем процедуру deletefiles таким образом:
procedure tform1.button1click(sender: tobject);
begin
setcurrentdirectory( pchar( 'c:' ) );
deletefiles( handle, [ 'test1', 'test2' ], true );
end;
Файлы 'test1' и 'test2' удаляются совсем, без помещения в корзину,
несмотря на установленный флаг fof_allowundo.
Мораль: при использовании функции
shfileoperation используйте полные пути всегда, когда это возможно.
Ну, с удалением файлов разобрались.
Теперь очередь за копированием и перемещением.
Следующая функция перемещает файлы указанные в списке src в директорию dest.
Параметр move определяет, будут ли файлы перемещаться или копироваться.
Параметр autorename указывает, переименовывать ли файлы в случае конфликта имен.
function copyfiles( handle : hwnd; src : array of string; dest : string;
move : boolean; autorename : boolean ) : integer;
var
shfileopstruct : tshfileopstruct;
srcbuf : tbuffer;
begin
createbuffer( src, srcbuf );
with shfileopstruct do
begin
wnd := handle;
wfunc := fo_copy;
if move then wfunc := fo_move;
pfrom := pointer( srcbuf );
pto := pchar( dest );
fflags := 0;
if autorename then fflags := fof_renameoncollision;
fanyoperationsaborted := false;
hnamemappings := nil;
lpszprogresstitle := nil;
end;
result := shfileoperation( shfileopstruct );
srcbuf := nil;
end;
Ну, проверим.
procedure tform1.button1click(sender: tobject);
begin
copyfiles( handle, [ 'c:test1', 'c:test2' ], 'c:temp', true, true );
end;
Все в порядке (а кудa ж оно денется).
Есть, правда еще одна возможность - перемещать много файлов каждый
в свою директорию за один присест, но я с трудом представляю, кому это может понадобиться.
Осталась последняя о
function renamefiles( handle : hwnd; src : string; new : string; autorename : boolean ) : integer;
var shfileopstruct : tshfileopstruct;
begin
with shfileopstruct do
begin
wnd := handle;
wfunc := fo_rename;
pfrom := pchar( src );
pto := pchar( new );
fflags := 0;
if autorename then fflags := fof_renameoncollision;
fanyoperationsaborted := false;
hnamemappings := nil;
lpszprogresstitle := nil;
end;
result := shfileoperation( shfileopstruct );
end;
И проверка ...
procedure tform1.button1click(sender: tobject);
begin
renamefiles( handle, 'c:test1' , 'c:test3' , false );
end;