Программирование и администрирование ● Delphi
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;

 

_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 ] ) - 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;

Есть, правда еще одна возможность - перемещать много файлов каждый в свою директорию за один присест, но я с трудом представляю, кому это может понадобиться.

Осталась последняя операция - переименование.

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;

Copied from: http://articles.org.ru/myfaq/10012003.php

ИНФОРМАЦИЯ
МЕТКИ
    (меток не найдено)
Все метки