Управление каталогами и файлами

unit
 win95;
{

Копирование, перемещение и удаление файлов и каталогов наподобие
Проводника (Explorer) в Windows 95.
Дата  : 06/04/97
Последнее обновление: 03/08/97

Просьба сообщать о всех найденных ошибках и недочетах на мой
адрес электронной почты.
Приветствуются пожелания и предложения по улучшению функциональности!!!

ОБНОВЛЕНИЯ:
(18/04/97)
Множество небольших поправок после множества ваших писем.
Спасибо всем.

(31/08/97)
Две новых процедуры: Win95AddToRecent и
Win95ClearRecentDocs.
}
interface

uses
 Classes, ShellApi, ShlObj, Registry, Windows;
type


  Str10 = string
[10];

const


  fpRootKey =
    'SoftwareMicrosoftWindowsCurrentVersionExplorerShell Folders';
  fpDesktop: Str10 = 'DESKTOP';
  fpFavorites: Str10 = 'FAVORITES';
  fpFonts: Str10 = 'FONTS';
  fpPersonal: Str10 = 'PERSONAL';
  fpPrograms: Str10 = 'PROGRAMS';
  fpRecent: Str10 = 'RECENT';
  fpSendTo: Str10 = 'SENDTO';
  fpStartMenu: Str10 = 'START MENU';
  fpStartup: Str10 = 'STARTUP';
  fpTemplates: Str10 = 'TEMPLATES';

  {Пути к системным папкам}
function
 GetFolderPath(const
 FolderName: Str10): string
;

{Функции для работы с файлами}
procedure
 Win95AddToRecentDocs(const
 Filename: string
);
procedure
 Win95ClearRecentDocs;
{Для манипулирования несколькими файлами разделите их имена символом "#0"}
function
 Win95Copy(Owner: Integer; FromFile, ToFile: string
; RenameOnCollision,
  Confirm: boolean): Boolean;
function
 Win95Move(Owner: Integer; FromFile, ToFile: string
; RenameOnCollision,
  Confirm: boolean): Boolean;
{Если SendToRecycleBin = True, то файлы будут отправлены в Корзину (RecycleBin),

в противном случае они будут стерты}
function
 Win95Erase(Owner: Integer; WichFiles: string
; SendToRecycleBin,
  Confirm: Boolean): Boolean;

implementation


function
 GetFolderPath(const
 FolderName: Str10): string
;
begin


  with
 TRegistry.Create do

  try

    RootKey := HKEY_CURRENT_USER;
    OpenKey(fpRootKey, False
);
    Result := ReadString(FolderName);
  finally

    Free;
  end
;
end
;

procedure
 Win95AddToRecentDocs(const
 Filename: string
);
begin


  SHAddToRecentDocs(SHARD_PATH, @Filename[1]);
end
;

procedure
 Win95ClearRecentDocs;
begin


  SHAddToRecentDocs(SHARD_PATH, nil
);
end
;

function
 Win95Copy(Owner: Integer; FromFile, ToFile: string
; RenameOnCollision,
  Confirm: boolean): Boolean;
const


  Aborted: Boolean = False
;
var


  Struct: TSHFileOpStructA;
begin


  while
 pos(';', FromFile) > 0 do

    FromFile[pos(';', FromFile)] := #0;
  while
 pos(';', ToFile) > 0 do

    ToFile[pos(';', ToFile)] := #0;
  FromFile := FromFile + #0#0;
  ToFile := ToFile + #0#0;
  with
 Struct do

  begin

    wnd := Owner;
    wFunc := FO_Copy;
    pFrom := PChar(FromFile);
    pTo := PChar(ToFile);
    fFlags := FOF_ALLOWUNDO or
 FOF_FILESONLY;
    if
 RenameOnCollision then

      fFLags := fFlags or
 FOF_RENAMEONCOLLISION;
    if
 not
 Confirm then

      fFLags := fFlags or
 FOF_NOCONFIRMATION;
    fAnyOperationsAborted := Aborted;
    hNameMappings := nil
;
    lpszProgressTitle := nil
;
  end
;
  result := (SHFileOperationA(Struct) = 0) and
 (not
 Aborted);
end
;

function
 Win95Move(Owner: Integer; FromFile, ToFile: string
; RenameOnCollision,
  Confirm: boolean): Boolean;
const


  Aborted: Boolean = False
;
var


  Struct: TSHFileOpStructA;
begin


  while
 pos(';', FromFile) > 0 do

    FromFile[pos(';', FromFile)] := #0;
  while
 pos(';', ToFile) > 0 do

    ToFile[pos(';', ToFile)] := #0;

  FromFile := FromFile + #0#0;
  ToFile := ToFile + #0#0;
  with
 Struct do

  begin

    wnd := Owner;
    wFunc := FO_Move;
    pFrom := PChar(FromFile);
    pTo := PChar(ToFile);
    fFlags := FOF_ALLOWUNDO or
 FOF_FILESONLY;
    if
 RenameOnCollision then

      fFLags := fFlags or
 FOF_RENAMEONCOLLISION;
    if
 Confirm then

      fFLags := fFlags or
 FOF_NOCONFIRMATION;
    fAnyOperationsAborted := Aborted;
    hNameMappings := nil
;
    lpszProgressTitle := nil
;
  end
;
  result := (SHFileOperationA(Struct) = 0) and
 (not
 Aborted);
end
;

function
 Win95Erase(Owner: Integer; WichFiles: string
; SendToRecycleBin,
  Confirm: Boolean): Boolean;
const


  Aborted: Boolean = False
;
var


  Struct: TSHFileOpStructA;
begin


  while
 pos(';', WichFiles) > 0 do

    WichFiles[pos(';', WichFiles)] := #0;
  WichFiles := WichFiles + #0#0;
  with
 Struct do

  begin

    wnd := Owner;
    wFunc := FO_Delete;
    pFrom := PChar(WichFiles);
    pTo := nil
;
    if
 not
 Confirm then

      fFlags := FOF_NOCONFIRMATION;
    if
 SendToRecycleBin then

      fFLags := fFlags or
 FOF_ALLOWUNDO or
 FOF_FILESONLY
    else

      fFlags := fFlags or
 0 or
 FOF_FILESONLY;
    fAnyOperationsAborted := Aborted;
    hNameMappings := nil
;
    lpszProgressTitle := nil
;
  end
;
  result := (SHFileOperationA(Struct) = 0) and
 (not
 Aborted);
end
;

end
.

Другое по теме:

• Как скопировать все файлы вместе с подкаталогами
• Копирование файлов
• Удалить файл в корзину? Запросто!