В данной статье мы подробно рассмотрим применение функции SHFileOperation. 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;
|