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

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 =
    '\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell 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.