Главная      Учебники - Разные     Лекции (разные) - часть 32

 

Поиск            

 

Разработка файловой оболочки

 

             

Разработка файловой оболочки

Постановка задачи.

Задача заключается в разработке файловой оболочки для операционной системы Windows’95/98. В программе реализовать механизмы копирования, переноса, удаления, переименования файлов и директорий, поиск файлов по маске, просмотр списка файлов по маске, просмотр и редактирование файлов во внешних редакторах, присвоение и получение атрибутов файла, присвоение атрибутов группе файлов, запуск приложений со строкой параметров, создание директории, определение размера директории, получение информации о диске, настройки интерфейса программы, определение суммарного объёма дискового пространства занимаемого группой файлов, восстановление интерфейсных параметров при повторном запуске программы. Так же обеспечить управление оболочкой при помощи манипулятора типа “мышь” и клавиатуры.

Метод реализации.

Для реализации поставленной задачи необходимо создать интерфейс пользователя состоящий из таких компонент:

А) список директорий.

Б) список файлов

В) список дисков

Г) главное меню программы

Д) панель инструментов.

Для организации интерфейса пользователя будут использованы стандартные визуальные компоненты Delphi 3.0. Для реализации механизма копирования/вставки необходимо запомнить список копируемых файлов/директорий, каждый элемент списка должен содержать информацию о месте нахождения файла/директории и имени файла/директории. При копировании группы файлов или одного файла необходимо определить их место положение в иерархии каталогов, а затем заполнить список, выбирая все файлы отмеченные пользователем из списка файлов показанного в интерфейсной части программы (списке файлов). При копировании директории необходимо также определить её положение и произвести сканирование самой директории с сохранением в списке имён файлов содержащихся в копируемой директории и структуры каталогов. Для вставки директории в место копирования, необходимо воссоздать её структуру, а затем скопировать в неё файлы. Для осуществления этого процесса вышеупомянутый список разбивается на два. В первом списке (назовем его временный список директорий) должна находиться структура каталогов, а во втором (временном списке файлов) расположенные в этих каталогах файлы. Два списка необходимы для уменьшения времени затраченного на копирование, так как при наличии одного списка необходим анализ каждого элемента списка на предмет наличия поддиректорий и создание этих поддиректорий в месте копирования, а в копируемой директории в большинстве случаев количество директорий меньше чем количество файлов и времени на проверку понадобиться больше, чем при использовании двух списков.

Если же использовать два списка то для воссоздания структуры каталогов необходимо лишь отсортировать временный список директорий в соответствии с иерархией каталогов, и создавать директории проходя по списку сверху вниз. Так как после сортировки, директории расположенные на верхних уровнях вложенности каталогов будут находиться в верхней части списка, а директории расположенные на нижних уровнях будут находиться в конце списка. После воссоздания структуры директории остаётся только переписать файлы.

Алгоритм заполнения временных списков показан на рисунке 1 в виде блок схемы. Реализация данного алгоритма будет базирована на использовании функций FindFirst и FindNext, эти функции осуществляют просмотр содержимого указанной директории и в качестве результата возвращают имя найденного элемента, его атрибуты, время создания и размер. При анализе атрибутов найденного элемента можно определить данный элемент директория или файл, и в соответствии с анализом записать его имя и положение в соответствующий список. На описанном алгоритме будет базирован также механизм удаления директории.

Упомянутые выше функции FindFirst и FindNext будут также применены при реализации механизма поиска файлов по маске.

Описание программы.

Программа реализована на языке паскаль с использованием

Delphi 3.0 - среды визуального программирования приложений для Windows’95 .

Детально рассмотрим реализацию некоторых механизмов, таких как:

Поиск файлов;

Копирование Директорий;

Удаление директорий.

Поиск файлов:

Поиск файлов в программе реализован с использованием маски. В маске возможно использование служебного символа, замены группы неизвестных символов в имени файла, или его расширении “*”, а также возможен поиск с различием регистров символов, и без такового, с указанием области поиска. Так же существуют возможности поиска с наложением дополнительных ограничений, таких как размер искомого файла, а так же времени создания файла. Детально с реализацией выше перечисленных механизмов вы можете ознакомиться в приложении 1 на страницах (29-35). Здесь же, мы рассмотрим реализацию основной части этого механизма.

Для поиска файлов по маске необходимо задание маски поиска в виде * .сом или autoexec . * , или другие возможные варианты, и области поиска. В качестве дополнительного параметра может быть задана проверка регистра символов. Блок схема поиска файлов показана на рисунке 1. При поиске используется рекурсивная процедура (текст 1.) в которой последовательно просматривается область поиска, включая подкаталоги, сравнивается имя найденного файл с маской поиска, и если все наложенные ограничения выполнены, найденный файл заносится в список предлагаемый пользователю для просмотра. Для организации поиска в разных областях изменяется лишь место первого вызова рекурсивной процедуры.

Текст 1.

Procedure TFindForm.FindInCurrentDir(CurDir:string);

Var

SizeF:integer;

i:integer;

EndList:boolean;

F:TSearchRec;

D:string;

begin

{ Вывод в статус строке директории в которой производится поиск }

FindForm.StatusFind.Panels[1].Text:=CurDir;

FindFirst(CurDir+'*.*',faAnyFile,F);

FindNext(F);

repeat

// Проверка расширенного поиска

If FindForm.CBAdvSearch.Checked and (F.Attr<>faDirectory) then

begin

// Проверка на размер найденного файла

// размер и время создания найденого файла должны находится в пределах заданных

// пользователем

if not(((F.Size < StrToInt(FindForm.SLess.Text)) and

(F.Size > StrToInt(FindForm.SGreater.Text)))) then Continue;

if not(((FileDateTime(CurDir+F.Name)<FindForm.DateIsBefore.Date) and (FileDateTime(CurDir+F.Name) > FindForm.DateIsAfter.Date))) then Continue;

end;

// проверить не является ли найденый файл директорией

if F.Attr=faDirectory then

if (F.Name<>'.') and (F.Name<>'..') then

begin

// если найденный файл – директория , рекурсивный вызов поиска в данной директории

FindInCurrentDir(CurDir+F.Name+'\');

end;

if (F.Name<>'..') and (F.Name<>'.') then

// если файл подходит под маску, занести его в список

if CompareFileWithMask(F.Name) then

begin

FindForm.FileWasFind.Items.Add(CurDir+F.Name);

FindForm.StatusFind.Panels[0].Text:=IntToStr(StrToInt(FindForm.StatusFind.Panels[0].Text)+1);

FindForm.FileWasFind.Refresh;

end;

// выполнять поиск пока не закончатся файлы в текущей области заданной области.

Until((FindNext(F) <> 0));

FindClose(F);

end;

В форме поиска файлов возможен переход к выбранному файлу, из списка найденных, а также запуск либо просмотр/редактирование во внешнем редакторе.

Копирование / Удаление директорий:

Описанная выше реализация алгоритма поиска файлов применёна в реализации копирования и удаления директорий. При реализации рассматриваемых процессов понадобится наличие двух временных списков: списка директорий и списка файлов (каждая строка обоих списков включает в себя “полный путь” (FULL PATH)) файла/директории. Для реализации временных списков использован визуальная компонента ListBoх, данная компонента представляет собой динамический список строк и набор процедур и функций для управления этим списком. Заполнение этих списков осуществляется при помощи просмотра директории.С листингом программы реализующем эти процессы вы можете ознакомиться в приложении 1 на страницах (17,23-27). Для копирования/удаления директорий составляются оба вышеупомянутых списка. При вставке директории создаётся полное дерево директории, а затем происходит копирование файлов. При удалении директории так же составляются оба списка, но так как стандартной процедуры удаляющей не пустую директорию нет, то в начале удаляются все файлы в удаляемой директории (включая файлы находящиеся в поддиректориях), а затем пустые директории.

Анализ результатов.

Программа имеет все необходимые функции работы с файлами. Все функции можно активизировать нажатием комбинации клавиш. Производиться статистика копирования, переноса, удаления файлов/директорий в удобной для восприятия пользователем форме. Существует простой механизм наложения фильтра на показываемые файлы. При изменении интерфейса программы, все изменения сохраняются и будут восстановлены при следующем запуске. Запуск приложений со строкой параметров с указанием типа запуска. Вывод сообщения о количестве поддиректорий в директории и о количестве файлов расположенных в ней. Определение размера директории присвоение атрибутов группе файлов простым нажатием двух клавиш.

Выводы.

В ходе работы была разработана программа манипулирования файлами и директориями.

В программе реализованы следующие механизмы:

· копирования, переноса, удаления, переименования файлов и директорий,

· поиск файлов по маске,

· наложение фильтра на список файлов,

· просмотр и редактирование файлов во внешних редакторах,

· присвоение и получение атрибутов файла,

· присвоение атрибутов группе файлов,

· запуск приложений со строкой параметров,

· создание директории,

· определение размера директории,

· получение информации о диске,

· настройки интерфейса программы,

· определение суммарного объёма дискового пространства занимаемого группой файлов,

· восстановление интерфейсных параметров при повторном запуске программы.

Программа имеет удобный интерфейс и может использоваться для работы пользователями с разным уровнем знаний.

Системные требования: Операционная система Windows’95 и выше, 500 килобайт дискового пространства.

Главная форма программы

Модуль описывающий главную форму

unit UMainForm; // главная форма программы

interface

// подключаемые модули (стандартные)

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

Menus, ExtCtrls, ComCtrls, StdCtrls, FileCtrl, Grids, Outline, DirOutln,

ToolWin, Buttons;

type

TMainForm = class(TForm)

MainMenu1: TMainMenu;

File1: TMenuItem;

About1: TMenuItem;

N1: TMenuItem;

Exit1: TMenuItem;

Options1: TMenuItem;

Directory: TDirectoryOutline;

FileList: TFileListBox;

Drv: TDriveComboBox;

StatusBar: TStatusBar;

DirectoryMenu: TPopupMenu;

FileMenu: TPopupMenu;

Splitter: TSplitter;

Cut: TMenuItem;

Copy: TMenuItem;

Paste: TMenuItem;

Rename1: TMenuItem;

Delete: TMenuItem;

NewDir: TMenuItem;

CopyDir: TMenuItem;

RenameDir: TMenuItem;

DeleteDir: TMenuItem;

PasteDir: TMenuItem;

TempDelete: TListBox;

TempCopyMove: TListBox;

Open: TMenuItem;

View: TMenuItem;

FileMask1: TMenuItem;

CMDirList: TListBox;

DFileList: TListBox;

Find1: TMenuItem;

Info1: TMenuItem;

CMFileList: TListBox;

FileAttr: TMenuItem;

SizeDirectory1: TMenuItem;

CutDir: TMenuItem;

ToolBar1: TToolBar;

DrBox: TDriveComboBox;

Bevel1: TBevel;

Bevel2: TBevel;

SpeedButton1: TSpeedButton;

SCut: TSpeedButton;

Bevel3: TBevel;

SCopy: TSpeedButton;

SPaste: TSpeedButton;

SDel: TSpeedButton;

Up: TSpeedButton;

Bevel4: TBevel;

Cut1: TMenuItem;

Copy1: TMenuItem;

Paste1: TMenuItem;

Rename: TMenuItem;

Delete1: TMenuItem;

Selectall: TMenuItem;

InvertSelect: TMenuItem;

procedure About1Click(Sender: TObject);

procedure Exit1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure Options1Click(Sender: TObject);

procedure DrivesSectionClick(HeaderControl: THeaderControl;

Section: THeaderSection);

procedure DrivesMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure NewDirClick(Sender: TObject);

procedure DirectoryChange(Sender: TObject);

procedure CopyClick(Sender: TObject);

procedure CutClick(Sender: TObject);

procedure PasteClick(Sender: TObject);

procedure Rename1Click(Sender: TObject);

procedure DeleteDirClick(Sender: TObject);

procedure DeleteClick(Sender: TObject);

procedure FileMenuPopup(Sender: TObject);

procedure FileMask1Click(Sender: TObject);

procedure FileListDblClick(Sender: TObject);

procedure SplitterMoved(Sender: TObject);

procedure Find1Click(Sender: TObject);

procedure Info1Click(Sender: TObject);

procedure CopyDirClick(Sender: TObject);

procedure RenameDirClick(Sender: TObject);

procedure FileAttrClick(Sender: TObject);

procedure ViewClick(Sender: TObject);

procedure SizeDirectory1Click(Sender: TObject);

procedure FileListMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure FileListKeyPress(Sender: TObject; var Key: Char);

procedure FileListKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure PasteDirClick(Sender: TObject);

procedure DirectoryMenuPopup(Sender: TObject);

procedure File1Click(Sender: TObject);

procedure OpenClick(Sender: TObject);

procedure DrBoxChange(Sender: TObject);

procedure UpClick(Sender: TObject);

procedure SCutClick(Sender: TObject);

procedure SPasteClick(Sender: TObject);

procedure SDelClick(Sender: TObject);

procedure SCopyClick(Sender: TObject);

procedure FileListClick(Sender: TObject);

procedure CutDirClick(Sender: TObject);

procedure Cut1Click(Sender: TObject);

procedure Copy1Click(Sender: TObject);

procedure Paste1Click(Sender: TObject);

procedure Delete1Click(Sender: TObject);

procedure RenameClick(Sender: TObject);

procedure FormResize(Sender: TObject);

procedure InvertSelectClick(Sender: TObject);

procedure FileListKeyUp(Sender: TObject; var Key: Word;

Shift: TShiftState);

procedure SelectallClick(Sender: TObject);

private

public

end;

var

MainForm: TMainForm;

Size:integer;

implementation

// подключаемые модули (не стандартные)

uses UAboutBox,UMainForm_, UOptionsForm, UCreateDir, UProgressForm,

URenameForm, UAskDeleteForm, UGetFileMask, FmxUtils, UFindForm, UInfoForm,

UAttrFilesForm,UNotTrivial, UDeleteDir, URenameDirForm, URunForm,

UViewForm;

{$R *.DFM}

procedure TMainForm.About1Click(Sender: TObject);

// вывод формы "ИНФОРМАЦИЯ О ПРОГРАММЕ"

begin

AboutBox.Show;

end;

procedure TMainForm.Exit1Click(Sender: TObject);

// Обработка выхода из программы

begin

If AskExit then

begin

// Подтверждение выхода

If Application.MessageBox('Exit ?','Exit',MB_APPLMODAL+MB_ICONQuestion+MB_YESNO)=IDYes then

Begin

// запись информации о программе в файл МС.INI

SaveIniMainForm;

Close;

end

end

else

begin

SaveIniMainForm;

Close;

end;

end;

procedure TMainForm.FormCreate(Sender: TObject);

//Установка начльных параметров для компонент главной формы

begin

SetUpMainForm;

SetUpComponents;

end;

procedure TMainForm.Options1Click(Sender: TObject);

//Вывод формы параметров

begin

// Центрирование выводимой формы относительно главной формы

GetFormToCenter(OptionsForm);

OptionsForm.ShowModal;

end;

procedure TMainForm.DrivesSectionClick(HeaderControl: THeaderControl;

Section: THeaderSection);

// Смена текущего диска

begin

Directory.Drive:=Section.Text[1];

Directory.SetDirectory(Section.Text[1]+':\');

MainForm.Directory.BuildTree;

end;

procedure TMainForm.DrivesMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

//перерисовка списка директорий при необходимости

Directory.Repaint;

end;

procedure TMainForm.NewDirClick(Sender: TObject);

// Создание директории и вывод соответствующей формы

begin

CreateDirForm.Show;

end;

Function CountDir(Str:String):String;

// Определение количества поддиректорий в текущей директории

Var F:TSearchRec;

C:integer;

begin

c:=0;

findfirst(Str+'\*.*',faAnyFile,F);

findnext(F);

repeat

if (f.Attr>=16) and (f.attr<32) and (f.Name<>'.') and (f.Name<>'..') then

c:=c+1;

Until(findnext(f)<>0);

CountDir:=IntToStr(c);

end;

procedure TMainForm.DirectoryChange(Sender: TObject);

//Смена текущей директории

begin

//Обновление списка файлов

FileList.SetDirectory(Directory.Directory);

//Заполнение статус-строки

MainForm.StatusBar.Panels[0].Text:=CountDir(Directory.Directory)+' dir. & '+IntToStr(MainForm.FileList.Items.Count)+

' files ';

MainForm.StatusBar.Panels[1].Text:='';

//Определение активных кнопок панели управления

If UpperCase(MainForm.Directory.Directory)=UpperCase(MainForm.DrBox.Drive+':\') then

begin

Up.Enabled:=False;

SCut.Enabled:=False;

SCopy.Enabled:=False;

SDel.Enabled:=False;

end

else

begin

Up.Enabled:=True;

SCut.Enabled:=True;

SCopy.Enabled:=True;

SDel.Enabled:=True;

end;

end;

procedure TMainForm.CopyClick(Sender: TObject);

// Копирование файлов

begin

FlagCopyFile:=True;

FlagMoveFile:=False;

CopyPathFileInTemp;

end;

procedure TMainForm.CutClick(Sender: TObject);

// Вырезание файлов

begin

FlagMoveFile:=True;

CopyPathFileInTemp;

end;

procedure TMainForm.PasteClick(Sender: TObject);

begin

ProgressForm.Show;

PasteFileFromTemp;

ProgressForm.Close;

MainForm.TempCopyMove.Clear;

end;

procedure TMainForm.Rename1Click(Sender: TObject);

// Переименование файлов в соответствующей экранной форме

begin

GetFormToCenter(RenameFileForm);

RenameFileForm.ShowModal;

end;

procedure TMainForm.DeleteDirClick(Sender: TObject);

// Удаление директории

begin

// Обнуление временных списков

MainForm.CMDirList.Clear;

MainForm.CMFileList.Clear;

DeleteEmptyDirectory(MainForm.Directory.Directory);

//Обновление списка директорий

MainForm.Directory.Invalidate;

end;

procedure TMainForm.DeleteClick(Sender: TObject);

//Удаление файлов

begin

AskDeleteForm.Show;

end;

procedure TMainForm.FileMenuPopup(Sender: TObject);

//Определение видимых строк в контектсном меню файловой области

//в момент его вызова

begin

if MainForm.FileList.SelCount=0 then

begin

with MainForm.FileMenu do

begin

Delete.Enabled:=False;

Cut.Enabled:=False;

Copy.Enabled:=False;

Rename1.Enabled:=False;

end;

end

else

begin

with MainForm.FileMenu do

begin

Delete.Enabled:=True;

Cut.Enabled:=True;

Copy.Enabled:=True;

Rename1.Enabled:=True;

end;

end;

if MainForm.TempCopyMove.Items.Count = 0 then

Paste.Enabled:=False

else

Paste.Enabled:=True;

end;

procedure TMainForm.FileMask1Click(Sender: TObject);

// Запрос маски файлов для списка файлов (в дальнейшем СФ)

begin

GetFileMask.Show;

end;

procedure TMainForm.FileListDblClick(Sender: TObject);

// Запуск программ/редактирование(просмотр) во внешнем редакторе

// при двойном щелчке мышкой

Var

str:string;

begin

Str:=FileList.FileName;

ExecuteFile(Str,'','',SW_SHOW);

end;

procedure TMainForm.SplitterMoved(Sender: TObject);

//Перемещение разделителя СФ и Списка директорий (В Дальнейшем СД)

begin

// Ограничение на положение разделителя

// Ширина СД не должна быть меньше Списка дисков (В дальнейшем СПД)

if Splitter.Left<=DrBox.Width then

begin

Directory.Width:=DrBox.Width+6;

end;

// Сохранение положения разделителя для следующего запуска программы

McIni.WriteInteger('ASWindow','Splitter',MainForm.Directory.Width);

// Установка размеров панелей статус-строки

MainForm.StatusBar.Panels[0].Width:=MainForm.Directory.Width;

end;

procedure TMainForm.Find1Click(Sender: TObject);

// Поиск файлов

begin

FindForm.Show

end;

procedure TMainForm.Info1Click(Sender: TObject);

// Вывод информации о текущем диске и директории

begin

GetFormToCenter(InfoForm);

InfoForm.ShowModal;

end;

procedure TMainForm.CopyDirClick(Sender: TObject);

//Копирование директорий (Выбран пункт меню копировать)

begin

SourseDir:=MainForm.Directory.Directory;

DoingWithDir:=True;

CopyMoveDirectory;

end;

procedure TMainForm.RenameDirClick(Sender: TObject);

//Переименование директории в соответствующей форме

begin

GetFormToCenter(RenameDirForm);

RenameDirForm.ShowModal;

end;

procedure TMainForm.FileAttrClick(Sender: TObject);

//Получение установка атрибутов файла в соотв. форме

begin

GetFormToCenter(AttrFileForm);

AttrFileForm.ShowModal;

end;

procedure TMainForm.ViewClick(Sender: TObject);

// Определение видимых компонент в меню VIEW

// в момент его открытия

begin

if MainForm.FileList.SelCount = 0 then

begin

MainForm.FileAttr.Enabled:=False;

end

else

begin

MainForm.FileAttr.Enabled:=True;

end;

if UpperCase(MainForm.Directory.Directory)=UpperCase(MainForm.DrBox.Drive+':\') then

MainForm.SizeDirectory1.Enabled:=False

else

MainForm.SizeDirectory1.Enabled:=True;

end;

Procedure DDD(DirS:string);

// Определение размера текущей директории

Var

d:TSearchRec;

begin

FindFirst(DirS+'\'+'*.*',faAnyFile,D);

FindNext(D);

repeat

if (D.Name<>'.') and (D.Name<>'..') then

begin

if (D.Attr=faDirectory) Or (D.Attr=18) then

begin

DDD(DirS+'\'+D.Name);

end

else

begin

Size:=Size+D.Size;

end;

end;

Until(FindNext(D) <> 0);

FindClose(D);

end;

procedure TMainForm.SizeDirectory1Click(Sender: TObject);

// Вывод информации о текущей директории в статус-строке

begin

Size:=0;

MainForm.StatusBar.Panels[0].Text:='Wait...';

DDD(MainForm.Directory.Directory);

MainForm.StatusBar.Panels[0].Text:=FormatSize(IntToStr(Size)); // перевод числа в читабельный формат

MainForm.StatusBar.Panels[0].Text:=MainForm.StatusBar.Panels[0].Text+' b';

end;

procedure TMainForm.FileListMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

// Левая кнопка мышки отпущена

Var

i:integer;

F:TSearchRec;

str:string;

begin

str:=' ';

Size:=0;

//Если при помощи мышки выделена группа файлов определить их суммарный размер

for i:=0 to MainForm.FileList.Items.Count-1 do

begin

if MainForm.FileList.Selected[i] then

begin

FindFirst(MainForm.FileList.Items[i],faAnyFile,F);

Size:=Size+F.Size;

if MainForm.FileList.SelCount=1 then break;

end;

end;

// Если один выделенный файл, вывести информацию о нем в строке статуса

if MainForm.FileList.SelCount=1 then

begin

MainForm.StatusBar.Panels[1].Text:=ExtractFileName(F.Name)+' '+

FormatSize(IntToStr(F.Size))+' b'+' '+

DateToStr(FileDateTime(F.Name))+' '+TimeToStr(FileDateTime(F.Name));

end

else

begin

MainForm.StatusBar.Panels[1].Text:=FormatSize(intToStr(Size))+' b'+

' in '+IntToStr(MainForm.FileList.SelCount)+ ' selected files';

end;

end;

Procedure ReselectAllFile;

// Инвертирование выделения файлов

Var i:integer;

begin

For i:=0 to MainForm.FileList.Items.Count-1 do

MainForm.FileList.Selected[i]:=not MainForm.FileList.Selected[i];

end;

Procedure SelectAllF(Key:Char);

// Выделить все файлы в СФ

Var

i:integer;

F:TsearchRec;

Str:string;

begin

if Key='*' then

begin

if MainForm.FileList.SelCount=MainForm.FileList.Items.Count then

ReselectAllFile

else

begin

for i:=0 to MainForm.FileList.Items.Count-1 do

MainForm.FileList.Selected[i]:=True;

str:=' ';

Size:=0;

// Обновление Статус-строки

for i:=0 to MainForm.FileList.Items.Count-1 do

begin

if MainForm.FileList.Selected[i] then

begin

FindFirst(MainForm.FileList.Items[i],faAnyFile,F);

Size:=Size+F.Size;

if MainForm.FileList.SelCount=1 then break;

end;

end;

if MainForm.FileList.SelCount=1 then

begin

MainForm.StatusBar.Panels[1].Text:=ExtractFileName(F.Name)+' '+

FormatSize(IntToStr(F.Size))+' b'+' '+

DateToStr(FileDateTime(F.Name))+' '+TimeToStr(FileDateTime(F.Name));

end

else

begin

MainForm.StatusBar.Panels[1].Text:=FormatSize(intToStr(Size))+' b'+

' in '+IntToStr(MainForm.FileList.SelCount)+ ' selected files';

end;

end;

end;

end;

procedure TMainForm.FileListKeyPress(Sender: TObject; var Key: Char);

begin

SelectAllF(Key);

end;

procedure TMainForm.FileListKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

//Нажата клавиша на клавиатуре

Var

i:integer;

F:TSearchRec;

str:string;

begin

// если нажат ENTER запустить файл

if (Key=13) and not AskDeleteForm.Active then ExecuteFile(FileList.FileName,'','',SW_SHOW);

str:=' ';

Size:=0;

for i:=0 to MainForm.FileList.Items.Count-1 do

begin

if MainForm.FileList.Selected[i] then

begin

FindFirst(MainForm.FileList.Items[i],faAnyFile,F);

Size:=Size+F.Size;

if MainForm.FileList.SelCount=1 then break;

end;

end;

// Обновление статус строки

if MainForm.FileList.SelCount=1 then

begin

MainForm.StatusBar.Panels[1].Text:=ExtractFileName(F.Name)+' '+

FormatSize(IntToStr(F.Size))+' b'+' '+

DateToStr(FileDateTime(F.Name))+' '+TimeToStr(FileDateTime(F.Name));

end

else

begin

MainForm.StatusBar.Panels[1].Text:=FormatSize(intToStr(Size))+' b'+

' in '+IntToStr(MainForm.FileList.SelCount)+ ' selected files';

end;

end;

procedure TMainForm.PasteDirClick(Sender: TObject);

//Вставка директории

begin

DestinationDir:=MainForm.Directory.Directory;

PasteDirectory(SourseDir,MainForm.Directory.Directory);

MainForm.Directory.BuildTree;

//Если директория переноситься то удалить источник

If not DoingWithDir then

begin

DelNotEmptyDirectory(SourseDir);

MainForm.Directory.BuildTree;

end;

MainForm.CMDirList.Clear;

end;

procedure TMainForm.DirectoryMenuPopup(Sender: TObject);

// Определение видимых компонент контектсного меню СД

begin

if MainForm.CMDirList.Items.Count=0 then

PasteDir.Enabled:=False

else

PasteDir.Enabled:=True;

If Length(MainForm.Directory.Directory) <= 3 then

begin

CopyDir.Enabled:=False;

CutDir.Enabled:=False;

DeleteDir.Enabled:=False;

RenameDir.Enabled:=False;

end

else

begin

CutDir.Enabled:=True;

CopyDir.Enabled:=True;

DeleteDir.Enabled:=True;

RenameDir.Enabled:=True;

end;

end;

procedure TMainForm.File1Click(Sender: TObject);

//Определение является ли выделенный файл приложением и подсвечивание / скрытие

//пункта меню RUN в момент открытия меню FILE

begin

if (UpperCase(ExtractFileExt(MainForm.FileList.FileName))='.EXE') or

(UpperCase(ExtractFileExt(MainForm.FileList.FileName))='.COM') then

Open.Enabled:=True

else Open.Enabled:=False;

end;

procedure TMainForm.OpenClick(Sender: TObject);

//Запуск приложения со строкой параметров

begin

GetFormToCenter(RunForm);

RunForm.ShowModal;

end;

procedure TMainForm.DrBoxChange(Sender: TObject);

//Смена текущего диска и обносление СФ и СД

Var F:TSearchRec;

s:string;

begin

MainForm.Directory.Drive:=MainForm.DrBox.Drive;

MainForm.FileList.Directory:=MainForm.DrBox.Drive+':\';

S:=MainForm.FileList.Mask;

MainForm.FileList.Mask:='>.>';

FindFirst(MainForm.DrBox.Drive+':\*.*',faDirectory,F);

Repeat

Until ((FindNext(F)<>0) or ((F.Attr=faDirectory) and ((F.Name<>'.') or (F.Name<>'..'))));

if F.Attr<>faDirectory then

MainForm.Directory.SetDirectory(MainForm.DrBox.Drive+':\')

else

MainForm.Directory.SetDirectory(MainForm.DrBox.Drive+':\'+F.Name);

MainForm.Directory.BuildTree;

MainForm.Directory.SetDirectory(MainForm.DrBox.Drive+':\');

MainForm.FileList.Enabled:=True;

MainForm.FileList.Mask:=s;

MainForm.StatusBar.Panels[0].Text:=IntToStr(MainForm.FileList.Items.Count)+

' files ';

end;

procedure TMainForm.UpClick(Sender: TObject);

//Перход на один уровень вверх в списке директорий

Var

i:integer;

Str:string;

begin

str:=MainForm.Directory.Directory;

for i:=Length(Str) downto 0 do

if Str[i]='\' then

begin

str[i+1]:=#0;

break;

end;

MainForm.Directory.Directory:=str;

MainForm.Directory.BuildTree;

end;

procedure TMainForm.SCutClick(Sender: TObject);

// Нажата кнопка ВЫРЕЗАТЬ на панели инструментов

begin

//Если активен СФ то выреззать файлы

if MainForm.FileList.Focused then

begin

FlagMoveFile:=True;

CopyPathFileInTemp;

end;

//Если активен СД то вырезать директорию

If MainForm.Directory.Focused then

begin

SourseDir:=MainForm.Directory.Directory;

DoingWithDir:=False;

MainForm.CMDirList.Items.Add(MainForm.Directory.Directory);

GreateCopyMoveDirList(MainForm.Directory.Directory);

end;

end;

procedure TMainForm.SPasteClick(Sender: TObject);

//На панели инструментов нажата кнопка ВСТАВИТЬ

begin

// Определить (по заполнению временных списков) что необходимо вставить

// файлы или директории

if MainForm.TempCopyMove.Items.Count<>0 then

begin

ProgressForm.Show;

PasteFileFromTemp;

ProgressForm.Close;

end;

If MainForm.CMDIrList.Items.Count<>0 then

begin

DestinationDir:=MainForm.Directory.Directory;

PasteDirectory(SourseDir,MainForm.Directory.Directory);

MainForm.Directory.BuildTree;

If not DoingWithDir then

begin

DelNotEmptyDirectory(SourseDir);

MainForm.Directory.BuildTree;

end;

MainForm.CMDirList.Clear;

end;

end;

procedure TMainForm.SDelClick(Sender: TObject);

//на панели нажата кнопка УДАЛИТЬ

begin

if (MainForm.FileList.Focused) and (MainForm.FileList.SelCount>0) then

begin

AskDeleteForm.ShowModal;

end;

if MainForm.Directory.Focused then

begin

IndexDeleteDirectory:=MainForm.Directory.SelectedItem;

MainForm.CMDirList.Clear;

MainForm.CMFileList.Clear;

DeleteEmptyDirectory(MainForm.Directory.Directory);

MainForm.Directory.Invalidate;

end;

end;

procedure TMainForm.SCopyClick(Sender: TObject);

//На панели нажата кнопка КОПИРОВАТЬ

begin

If MainForm.Directory.Focused then

begin

SourseDir:=MainForm.Directory.Directory;

DoingWithDir:=True;

CopyMoveDirectory;

end;

If MainForm.FileList.Focused then

begin

FlagCopyFile:=True;

FlagMoveFile:=False;

CopyPathFileInTemp;

end;

end;

procedure TMainForm.FileListClick(Sender: TObject);

begin

MainForm.SDel.Enabled:=True;

MainForm.SCopy.Enabled:=True;

MainForm.SCut.Enabled:=True;

end;

procedure TMainForm.CutDirClick(Sender: TObject);

// Вырезание Директории

begin

SourseDir:=MainForm.Directory.Directory;

DoingWithDir:=False;

MainForm.CMDirList.Items.Add(MainForm.Directory.Directory);

GreateCopyMoveDirList(MainForm.Directory.Directory);

end;

procedure TMainForm.Cut1Click(Sender: TObject);

// Вырезание в зависимости от контекста

begin

if MainForm.FileList.Focused then

begin

FlagMoveFile:=True;

CopyPathFileInTemp;

end;

If MainForm.Directory.Focused then

begin

SourseDir:=MainForm.Directory.Directory;

DoingWithDir:=False;

MainForm.CMDirList.Items.Add(MainForm.Directory.Directory);

GreateCopyMoveDirList(MainForm.Directory.Directory);

end;

end;

procedure TMainForm.Copy1Click(Sender: TObject);

// Копирование в зависимости от контекста

begin

If MainForm.Directory.Focused then

begin

SourseDir:=MainForm.Directory.Directory;

DoingWithDir:=True;

CopyMoveDirectory;

end;

If MainForm.FileList.Focused then

begin

FlagCopyFile:=True;

FlagMoveFile:=False;

CopyPathFileInTemp;

end;

end;

procedure TMainForm.Paste1Click(Sender: TObject);

// Вставка в зависимости от контекста

begin

if MainForm.TempCopyMove.Items.Count<>0 then

begin

ProgressForm.Show;

PasteFileFromTemp;

ProgressForm.Close;

end;

If MainForm.CMDIrList.Items.Count<>0 then

begin

DestinationDir:=MainForm.Directory.Directory;

PasteDirectory(SourseDir,MainForm.Directory.Directory);

MainForm.Directory.BuildTree;

If not DoingWithDir then

begin

DelNotEmptyDirectory(SourseDir);

MainForm.Directory.BuildTree;

end;

MainForm.CMDirList.Clear;

end;

end;

procedure TMainForm.Delete1Click(Sender: TObject);

//Удаление в зависимости от контекста

begin

if (MainForm.FileList.Focused) and (MainForm.FileList.SelCount>0) then

begin

AskDeleteForm.Show;

end;

if MainForm.Directory.Focused then

begin

IndexDeleteDirectory:=MainForm.Directory.SelectedItem;

MainForm.CMDirList.Clear;

MainForm.CMFileList.Clear;

DeleteEmptyDirectory(MainForm.Directory.Directory);

MainForm.Directory.Invalidate;

end;

end;

procedure TMainForm.RenameClick(Sender: TObject);

// Переименование в зависимости от контекста

begin

If MainForm.Directory.Focused then

begin

GetFormToCenter(RenameDirForm);

RenameDirForm.ShowModal;

end;

if MainForm.FileList.Focused then

begin

RenameFileForm.ShowModal;

end;

end;

procedure TMainForm.FormResize(Sender: TObject);

// Наложение ограничений на минимальные размеры главной формы

begin

if MainForm.Width<391 then

MainForm.Width:=391;

if MainForm.Height<260 then

MainForm.Height:=260;

end;

procedure MainForm.InvertSelectClick(Sender: TObject);

begin

ReselectAllFile;

end;

procedure TMainForm.FileListKeyUp(Sender: TObject; var Key: Word;

Shift: TShiftState);

// Клавиша отпущена при работе с СФ

Var

i:integer;

F:TSearchRec;

str:string;

begin

// Обновление статус-строки

str:=' ';

Size:=0;

for i:=0 to MainForm.FileList.Items.Count-1 do

begin

if MainForm.FileList.Selected[i] then

begin

FindFirst(MainForm.FileList.Items[i],faAnyFile,F);

Size:=Size+F.Size;

if MainForm.FileList.SelCount=1 then break;

end;

end;

if MainForm.FileList.SelCount=1 then

begin

MainForm.StatusBar.Panels[1].Text:=ExtractFileName(F.Name)+' '+

FormatSize(IntToStr(F.Size))+' b'+' '+

DateToStr(FileDateTime(F.Name))+' '+TimeToStr(FileDateTime(F.Name));

end

else

begin

MainForm.StatusBar.Panels[1].Text:=FormatSize(intToStr(Size))+' b'+

' in '+IntToStr(MainForm.FileList.SelCount)+ ' selected files';

end;

end;

procedure TMainForm.SelectallClick(Sender: TObject);

begin

SelectAllF('*');

end;

end.

Вспомогательные модули

unit UMainForm_; //Вспомогательный модуль программы

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

Menus,IniFiles,ExtCtrls, ComCtrls, StdCtrls, FileCtrl, Grids, Outline, DirOutln,

ToolWin, Buttons;

Const

FL1='1 column';

FL2='2 column';

FL3='3 column';

Var

AskExit:boolean;

MCIni:TIniFile;

FlagCopyFile:Boolean;

FlagMoveFile:Boolean;

Function FloatToInt(x:real):integer;

Procedure SaveIniMainForm;

Procedure ReadIniMainForm;

Procedure SetUpMainForm;

Procedure GetFormToCenter(Form:TForm);

Function FormatSize(S:String):String;

Procedure UpdateMC;

Procedure WriteIniOptions;

Procedure ReadIniOptions;

Procedure SetUpComponents;

Var

ColDeleteFiles,ColFilesIn_TempCopyMove:integer;

AllDeleteFlag,DeleteFlag:boolean;

ResultFDCFFlag:integer;

FDel:boolean;

Procedure CopyPathFileInTemp;

Function CreateStringForTemp(i:integer):string;

Procedure PasteFileFromTemp;

Function GetSizeAllFiles(List:TListBox):Integer;

Procedure DeleteEmptyDirectory(Dir:string);

Procedure CheckForOverwrite(Str:string;x:integer);

Var

Ddir:string;

DoingWithDir:boolean;

DirSourse:string;

Procedure GreateCopyMoveDirList(DirS:string);

Procedure CopyMoveDirectory;

implementation

Uses UMainForm, UOptionsForm, FMXUtils, UAskDeleteForm, UAskDeleteCurrentFile,

UDeleteDir;

Procedure CopyMoveDirectory;

//Копирование перенос директорий

begin

MainForm.CMDirList.Clear;

MainForm.CMFileList.Clear;

MainForm.CMDirList.Items.Add(MainForm.Directory.Directory);

//Создание временных списков

GreateCopyMoveDirList(MainForm.Directory.Directory);

end;

Procedure GreateCopyMoveDirList(DirS:string);

//Рекурсивная процедура создания списков для копирования/переноса/удаления директории

Var

D:TSearchRec;

begin

FindFirst(DirS+'\'+'*.*',faAnyFile,D);

FindNext(D);

repeat

if (D.Name<>'.') and (D.Name<>'..') then

begin

if (D.Attr=faDirectory) Or (D.Attr=18) then

begin

MainForm.CMDirList.Items.Add(DirS+'\'+D.Name);

GreateCopyMoveDirList(DirS+'\'+D.Name);

end

else

begin

MainForm.CMFileList.Items.Add(DirS+'\'+D.Name);

end;

end;

Until(FindNext(D) <> 0);

FindClose(D);

end;

Procedure CheckForOverwrite(Str:string;x:integer);

// Проверка существования файлов и перезапись его по желанию пользователя при вставке

Var

i:integer;

FilePaste:string;

FileinDir:string;

MStr:PChar;

begin

FilePaste:=ExtractFileName(Str);

for i:=0 to ColAllFiles-1 do

begin

Str:=MainForm.FileList.Items[i];

FileInDir:=Str;

if FilePaste=FileInDir then

begin

Str:='OverWrite '+MainForm.TempCopyMove.Items[x];

Mstr:=PChar(Str);

// Найден файл , запрос на его перезапись

if Application.MessageBox(MStr,'Warning',1)<>1 then

begin

MainForm.TempCopyMove.Items[x]:=MainForm.TempCopyMove.Items[x]+'*';//.Delete(x);

ColFilesIn_TempCopyMove:=ColFilesIn_TempCopyMove-2;

end;

end;

end;

end;

Procedure DeleteEmptyDirectory(Dir:String);

//Удаление пустой директории

Var

i:integer;

begin

{$I-}

i:=MainForm.Directory.SelectedItem;

MainForm.Directory.Directory:=(MainForm.Directory.Drive+':\');

RmDir(Dir);

if IOResult <> 0 then

begin

GetFormToCenter(FDeleteDir);

FDeleteDir.LDir.Caption:=Dir;

FDeleteDir.ShowModal;

if Fdel then

begin

MainForm.Directory.Delete(i);

RmDir(Dir);

end

Else

begin

MainForm.Directory.SetDirectory(Dir);

MainForm.Directory.BuildTree;

end;

end

Else MainForm.Directory.Delete(i);

{$I+}

MainForm.Directory.Update;

MainForm.CMDirList.Items.Clear;

MainForm.CMFileList.Items.Clear;

end;

Function GetSizeAllFiles(List:TListBox):Integer;

// Определение размера всех файлов для прогресс формы

Var

i:integer;

Size:integer;

begin

Size:=0;

For i:=0 to List.Items.Count-1 do

begin

Size:=Size+GetFileSize(List.Items[i]);

end;

GetSizeAllFiles:=Size;

end;

Procedure PasteFileFromTemp;

//Вставка файлов

Var

StrPaste:string;

Str:string;

i:integer;

begin

//Формирование параметров для вставки файлов

If MainForm.Directory.Directory[Length(MainForm.Directory.Directory)]<>'\' then

begin

StrPaste:=MainForm.Directory.Directory+'\';

end

else

begin

StrPaste:=MainForm.Directory.Directory;

end;

//Проверка всего списка вставляемых файлов на перезапись

For i:=0 to MainForm.TempCopyMove.Items.Count-1 do

CheckForOverwrite(MainForm.TempCopyMove.Items[i],i);

For i:=0 to MainForm.TempCopyMove.Items.Count-1 do

begin

Str:=MainForm.TempCopyMove.Items[i];

//Определение действия над файлами копировать или перемещать

If FlagMoveFile then

begin

if Str[Length(str)]<>'*' then

MoveFile(MainForm.TempCopyMove.Items[i],StrPaste);

end

else

begin

if Str[Length(str)]<>'*' then

CopyFile(MainForm.TempCopyMove.Items[i],StrPaste);

end;

If Str[Length(str)]='*' then

begin

Str[Length(str)]:=#0;

MainForm.TempCopyMove.Items[i]:=Str;

end;

end;

MainForm.FileList.Update;

If FlagMoveFile then

begin

FlagMoveFile:=False;

MainForm.TempCopyMove.Clear;

end;

end;

Function CreateStringForTemp(i:integer):string;

//Создание строки для временного списка

Var

Str:string;

begin

Str:=MainForm.Directory.Directory;

If Str[Length(Str)]<>'\' then

begin

Str:=Str+'\';

end;

Str:=Str+MainForm.FileList.Items[i];

CreateStringForTemp:=Str;

end;

Procedure CopyPathFileInTemp;

//Создание временного списка файлов

Var

i:integer;

begin

ColFilesIn_TempCopyMove:=0;

MainForm.TempCopyMove.Clear;

for i:=0 to ColAllFiles-1 do

begin

if MainForm.FileList.Selected[i] then

begin

ColFilesIn_TempCopyMove:=ColFilesIn_TempCopyMove+1;

If FlagMoveFile then

begin

MainForm.TempCopyMove.Items.Add(CreateStringForTemp(i));

MainForm.FileList.Items[i]:='';

end

else

begin

MainForm.TempCopyMove.Items.Add(CreateStringForTemp(i));

end;

end;

end;

end;

Procedure SetUpComponents;

begin

MainForm.StatusBar.Panels[0].Width:=MainForm.Directory.Width;

end;

Procedure ReadIniOptions;

//Чтение параметров из ини файла

var tmpinteger:integer;

begin

with OptionsForm do

begin

AskOnExit.Checked:=MCIni.ReadBool('Options','AskOnExit',True);

CStatusBar.Checked:=MCIni.ReadBool('Options','StatusBar',True);

tmpinteger:=MCIni.ReadInteger('Options','FileListColumns',1);

Case tmpinteger of

1 : LFileList.Caption:=FL1;

2 : LFileList.Caption:=FL2;

3 : LFileList.Caption:=FL3;

end; //Case

end;

end;

Procedure WriteIniOptions;

// Запись параметров в ини файл

begin

with MCIni do

begin

WriteBool('Options','AskOnExit',OptionsForm.AskOnExit.Checked);

WriteBool('Options','StatusBar',OptionsForm.CStatusBar.Checked);

Case MainForm.FileList.Columns of

1 : WriteInteger('Options','FileListColumns',1);

2 : WriteInteger('Options','FileListColumns',2);

3 : WriteInteger('Options','FileListColumns',3);

end; //case

end;

end;

Procedure UpdateMC;

// Обновление интерфейсных параметров программы

begin

if OptionsForm.AskOnExit.Checked then AskExit:=True

else AskExit:=False;

If OptionsForm.CStatusBar.Checked then MainForm.StatusBar.Visible:=True

else MainForm.StatusBar.Visible:=False;

if OptionsForm.LFilelist.Caption=FL1 then

begin

MainForm.FileList.Columns:=1;

MainForm.FileList.Update;

end;

if OptionsForm.LFilelist.Caption=FL2 then

begin

MainForm.FileList.Columns:=2;

MainForm.FileList.Update;

end;

if OptionsForm.LFilelist.Caption=FL3 then

begin

MainForm.FileList.Columns:=3;

MainForm.FileList.Update;

end;

end;

Procedure SetUpMainForm;

begin

//Подключение файла параметров

MCIni:=TIniFile.Create('MC.Ini');

ReadIniMainForm;

end;

Procedure ReadIniMainForm;

begin

with MainForm do

begin

Top:=MCIni.ReadInteger('ASWindow','Top',100);

Left:=MCIni.ReadInteger('ASWindow','Left',100);

Height:=MCIni.ReadInteger('ASWindow','Height',100);

Width:=MCIni.ReadInteger('ASWindow','Width',100);

Directory.Width:=McIni.ReadInteger('ASWindow','Splitter',100);

end;

end;

Procedure SaveIniMainForm;

begin

if MainForm.Top<>-4 then

begin

MCIni.WriteInteger('ASWindow','Top',MainForm.Top);

MCIni.WriteInteger('ASWindow','Left',MainForm.Left);

MCIni.WriteInteger('ASWindow','Width',MainForm.Width);

MCIni.WriteInteger('ASWindow','Height',MainForm.Height);

end;

end;

Function FloatToInt(x:real):integer;

begin

FloatToInt:=StrToInt(FloatToStr(Int(X)));

end;

Procedure GetFormToCenter(Form:TForm);

begin

Form.Top:=FloatToInt(MainForm.Top+MainForm.Height/2-Form.Height/2);

Form.Left:=FloatToInt(MainForm.Left+MainForm.Width/2-Form.Width/2);

end;

Function FormatSize(S:String):String;

// перевод целого числа в читабельный формат (для размеров файлов / директорий)

Var

i,j,n:integer;

Tmp,Temp:String;

begin

Tmp:='';

for i:=Length(S) downto 1 do

tmp:=tmp+S[i];

n:=0;

for i:=1 to Length(tmp) do

begin

if n=3 then

begin

n:=0;

Temp:=Temp+',';

end;

Temp:=Temp+Tmp[i];

n:=n+1;

end;

Tmp:='';

for i:=Length(Temp) downto 1 do

Tmp:=Tmp+Temp[i];

FormatSize:=Tmp;

end;

end.

unit UNotTrivial; //Вспамагательный модуль программы

interface

Uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, Buttons;

Var

IndexDelDir:integer;

CurDeleteDir:string;

Yes,No,All:boolean;

SourseDir:String;

DestinationDir:String;

IndexDeleteDirectory:integer;

Procedure DelOneFile(dFile:string;Flag:boolean);

Procedure DelNotEmptyDirectory(Dir:String);

Procedure PasteDirectory(SDir,DDir:string);

Procedure CreateDirInDestin(S,D:string);

Procedure SortCMDirList;

implementation

Uses

UMainForm, UMainForm_, UDeleteDir, DirOutLn, UAskDeleteCurrentFile,

FMXUtils,UProgressForm;

Procedure DelNotEmptyDirectory(Dir:string);

//Удаление не пустой директории

Var

i:integer;

Max:integer;

EndFor:integer;

begin

//Создание временных списков

GreateCopyMoveDirList(dir);

//Удаление файлов из всех поддиректорий

For i:=0 to MainForm.CMFileList.Items.Count-1 do

begin

DelOneFile(MainForm.CMFileList.Items[i],True);

FDeleteDir.Label1.Visible:=False;

FDeleteDir.LDir.Caption:='File '+MainForm.CMFileList.Items[i]+' is now deleting';

FdeleteDir.Update;

end;

//Сортировка временного списка директорий по возврастанию

SortCMDirList;

//Удаление уже пустых директорий

For i:=MainForm.CMDirList.Items.Count-1 downto 0 do

begin

{$I-}

RmDir(MainForm.CMDirList.Items[i]);

FDeleteDir.LDir.Caption:='Directory '+MainForm.CMDirList.Items[i]+' is now deleting';

FDeleteDir.Label1.Visible:=False;

FdeleteDir.Update;

if IOResult<>0 then

begin

MainForm.CMDirList.Items.Clear;

MainForm.CMFileList.Items.Clear;

Exit;

end;

MainForm.CMDirList.Items.Delete(i);

end;

end;

Function DesideSlash(str:string):integer;

// Подсчёт количества "\" для сортировки

Var

D,r:integer;

begin

d:=0;

for r:=0 to Length(str) do

if str[r]='\' then d:=d+1;

DesideSlash:=D;

end;

Procedure SortCMDirList;

//Пузырьковая сортировка списка директорий

Var i:integer;

Strl,StrH:string;

Flag:Boolean;

begin

Flag:=False;

if MainForm.CMDirList.Items.Count=0 then Flag:=true;

If MainForm.CMDirList.Items.Count<>1 then

repeat

For i:=0 to MainForm.CMDirList.Items.Count-2 do

begin

strl:=MainForm.CMDirList.Items[i];

StrH:=MainForm.CMDirList.Items[i+1];

if DesideSlash(StrL)>DesideSlash(StrH) then

begin

MainForm.CMDirList.Items[i]:=StrH;

MainForm.CMDirList.Items[i+1]:=StrL;

end;

end;

For i:=0 to MainForm.CMDirList.Items.Count-2 do

begin

if DesideSlash(MainForm.CMDirList.Items[i])<=DesideSlash(MainForm.CMDirList.Items[i+1]) then

begin

Flag:=True;

end

else

begin

Flag:=False;

Break;

end;

end;

Until (Flag);

end;

Procedure CreateOneDirInDes(d,s,str:string);

Var i,Point:integer;

begin

For i:=0 to Length(str) do

if (str[i]<>s[i]) or (str[i]='\') then

begin

if (Str[i]='\') and (Str[i+1]=S[i+1]) then Point:=i

else break;

end;

if D[Length(D)]='\' then Point:=Point+1;

For i:=Point to Length(str) do

d:=d+str[i];

if not CreateDir(D) then

begin

end

else

begin

MainForm.Directory.SetDirectory(D);

MainForm.Directory.BuildTree;

end;

end;

Procedure CreateDirInDestin(S,D:string);

//Создание дерева директорий при копировании /переносе

Var

P,i,j:integer;str,str1:string;

EndFor:integer;

begin

MainForm.StatusBar.Panels[1].Text:='Build destination Tree, Please Wait....';

SortCMDirList;

For i:=0 to MainForm.CMDirList.Items.Count-1 do

begin

str:=MainForm.CMDirList.Items[i];

CreateOneDirInDes(D,S,str);

end;

end;

Function CheskSizeInDestination:boolean;

// Проверка доступного места на диске

Var

i:integer;

Size:integer;

begin

For i:=0 to MainForm.CMFileList.Items.Count-1 do

size:=size+GetFileSize(MainForm.CMFileList.Items[i]);

if DiskFree(0) < size then

CheskSizeInDestination:=False

else

CheskSizeInDestination:=True;

end;

Function CreateDestinPathForFile(S,D,f:string):string;

Var

Point,i:integer;

begin

For i:=0 to Length(s) do

if S[i]='\' then Point:=i;

if D[Length(d)]='\' then Point:=Point+1;

For i:=Point to Length(f) do

d:=d+f[i];

For i:=Length(d) downTo 0 do

if D[i]='\' then

begin

D[i+1]:=#0;

Break;

end;

CreateDestinPathForFile:=d;

end;

Procedure PasteFileInDest(S,D:string);

//Вставка файлов при копир. /перен. директории

Var

i:integer;

Str:string;

F:String;

begin

MainForm.Directory.Repaint;

GetFormToCenter(ProgressForm);

ProgressForm.Show;

SizeAllCopy:=GetSizeAllFiles(MainForm.CMFileList);

While (MainForm.CMFileList.Items.Count<>0) do

begin

Str:=CreateDestinPathForFile(S,D,MainForm.CMFileList.Items[0]);

CopyFile(MainForm.CMFileList.Items[0],Str);

If not DoingWithDir then

DelOneFile(MainForm.CMFileList.Items[0],False);

MainForm.CMFileList.Items.Delete(0);

end;

ProgressForm.Close;

MainForm.FileList.Update;

end;

Procedure PasteDirectory(SDir,DDir:string);

//Вставка директории

Var

i:integer;

begin

if CheskSizeInDestination then

begin

CreateDirInDestin(SDir,DDir);

PasteFileInDest(Sdir,DDir);

if not DoingWithDir then

begin

end;

end

else

begin

if DoingWithDir then

begin

Application.MessageBox('Not Free Spase','Error',MB_APPLMODAL+MB_OK);

end

else

begin

end;

end;

end;

Procedure DelOneFile(dFile:string;Flag:boolean);

//Удаление одного файла

Var

F:TSearchRec;

begin

if flag then

begin

FileSetAttr(dFile,faArchive);

DeleteFile(dFile)

end

else

begin

FindFirst(dFile,faAnyFile,F);

if (F.Attr=32) or (F.Attr=0) then

DeleteFile(dFile)

else

begin

AskDeleteCurrentFile.FileName.Caption:=F.Name;

AskDeleteCurrentFile.FileName.Caption:=AskDeleteCurrentFile.FileName.Caption+' is Read Only';

AskDeleteCurrentFile.ShowModal;

if not No Then

begin

FileSetAttr(dFile,faArchive);

DeleteFile(dFile);

end;

end;

end;

FindClose(f);

end;

end.

Форма поиска файлов по маске

unit UFindForm; // Форма поиска файлов

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ComCtrls, Tabnotbk, StdCtrls, Buttons, Menus, ExtCtrls;

type

TFindForm = class(TForm)

FileWasFind: TListBox;

StatusFind: TStatusBar;

Table: TTabbedNotebook;

BitBtn1: TBitBtn;

CBFindMask: TComboBox;

Label1: TLabel;

GroupBox1: TGroupBox;

RBCurDir: TRadioButton;

RBCurDrive: TRadioButton;

RBAllDrives: TRadioButton;

GroupBox2: TGroupBox;

LCurDir: TLabel;

ExitSearch: TButton;

Label2: TLabel;

Label3: TLabel;

DateIsAfter: TDateTimePicker;

DateIsBefore: TDateTimePicker;

Label4: TLabel;

Label5: TLabel;

SGreater: TEdit;

SLess: TEdit;

CBAdvSearch: TCheckBox;

Menu: TPopupMenu;

Run1: TMenuItem;

GoTo1: TMenuItem;

CBCase: TCheckBox;

B2: TBitBtn;

B1: TButton;

Timer1: TTimer;

procedure FormActivate(Sender: TObject);

procedure BitBtn1Click(Sender: TObject);

procedure CBFindMaskDropDown(Sender: TObject);

procedure RBCurDirClick(Sender: TObject);

procedure RBCurDriveClick(Sender: TObject);

procedure RBAllDrivesClick(Sender: TObject);

procedure ExitSearchClick(Sender: TObject);

procedure CBAdvSearchClick(Sender: TObject);

procedure MenuPopup(Sender: TObject);

procedure Run1Click(Sender: TObject);

procedure GoTo1Click(Sender: TObject);

procedure B2Click(Sender: TObject);

procedure B1Click(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

private

public

Procedure FindInCurrentDir(CurDir:string);

end;

Type

PRec = ^TRec;

TRec = record

Name:TSearchRec;

SubDir:string;

Next:PRec;

end;

var

FindForm: TFindForm;

FileMaskToFind:array[1..10] of string;

EndFindFlag:boolean;

Procedure ZdvigMask(s:string);

Procedure InitFileMask;

Procedure WhereFind;

Procedure FindFile;

Procedure FindInAllDr;

function CompareFileWithMask(FileName:string):boolean;

implementation

uses UMainForm,FmxUtils;

{$R *.DFM}

function CompareFileWithMask(FileName:string):boolean;

//Сравнение имени и расширения очередного файла с маской

Var

MaskN,Mask,MaskR,FN,FR:string;

EndFor,i,j:integer;

tmp,R:boolean;

begin

FN:='';

Mask:=FindForm.CBFindMask.Text;

if not FindForm.CBCase.Checked then

begin

Mask:=UpperCase(Mask);

FileName:=UpperCase(FileName);

end;

FR:=ExtractFileExt(FileName);

For i:=1 to Length(FileName) do

if FileName[i]<>'.' then

FN:=FN+FileName[i]

else break;

For i:=1 to Length(Mask) do

if Mask[i]<>'.' then

MaskN:=MaskN+Mask[i]

else break;

MaskR:=ExtractFileExt(Mask);

//начало мучений с расширением

if Length(MaskR)< Length(FR) then

EndFor:=Length(MaskR)

else

EndFor:=Length(FR);

if (MaskR[2]='*') and (FR<>'') then

begin

j:=Length(MaskR);

for i:=Length(FR) downTo Length(Fr)-EndFor do

begin

if (MaskR[j]=FR[i]) and (MaskR[j]<>'*') then

begin

j:=j-1;

R:=True;

end

Else

if (MaskR[j]='*') and (R=True) then

begin

break;

end

else

begin

R:=False;

Break;

end;

end;

end;

If MaskR[Length(MaskR)]='*' then

begin

j:=1;

for i:=1 to EndFor do

begin

if (MaskR[j]=FR[i]) and (MaskR[j]<>'*') then

begin

j:=j+1;

R:=True;

end

else

begin

if (MaskR[j]='*') and (R=True) then

begin

break;

end

else

begin

R:=False;

Break;

end;

end;

end;

end;

for i:=0 to Length(MaskR) do

if MaskR[i]<>'*' then

tmp:=True

else

begin

tmp:=False;

break;

end;

if tmp then

if Length(MaskR)=Length(FR) then

begin

for i:=0 to Length(FR) do

if MaskR[i]=FR[i] then

R:=True

else

begin

R:=False;

break;

end;

end

else

begin

R:=False;

end;

//вроде конец с мучениями по расширению

//начало мучений с именем

if R then

begin

if Length(MaskN)<Length(FN) then

EndFor:=Length(MaskN)

else EndFor:=Length(FN);

if MaskN[1]='*' then

begin

j:=Length(MaskN);

for i:=Length(FN) downto Length(FN)-EndFor do

begin

if (MaskN[j]=FN[i]) and (MaskN[j]<>'*') then

begin

j:=j-1;

R:=True;

end

else

begin

if (MaskN[j]='*')and(R=True) then

begin

break;

end

else

begin

r:=false;

break;

end;

end;

end;

end;

if MaskN[Length(MaskN)]='*' then

begin

j:=0;

for i:=0 to EndFor do

begin

if (MaskN[j]=FN[i]) and (MaskN[j]<>'*') then

begin

j:=j+1;

r:=True;

end

else

begin

if (MaskN[j]='*')and(R=True) then

break

else

begin

R:=False;

break;

end;

end;

end;

end;

for i:=0 to Length(MaskN) do

if MaskN[i]<>'*' then

tmp:=True

else

begin

tmp:=False;

break;

end;

if tmp then

if Length(MaskN)<>Length(FN) then

r:=False

else

begin

for i:=0 to Length(MaskN) do

if MaskN[i]=FN[i] then

r:=True

else

begin

r:=False;

break;

end;

end;

end;

CompareFileWithMask:=R;

end;

Procedure FindFile;

// Поиск файла

Var

Dir:string;

SubDir:string;

Dr:Char;

begin

//Поиск в текущей директории

If FindForm.RBCurDir.Checked then

begin

Dir:=FindForm.LCurDir.Caption;

if Dir[Length(Dir)]<>'\' then

Dir:=Dir+'\';

FindForm.FindInCurrentDir(Dir);

end;

//Поиск на текущем диске

If FindForm.RBCurDrive.Checked then

begin

Dir:=FindForm.LCurDir.Caption;

if Dir[Length(Dir)]<>'\' then

Dir:=Dir+'\';

FindForm.FindInCurrentDir(Dir);

end;

//Поиск на всех дисках

If FindForm.RBAllDrives.Checked then

begin

FindInAllDr;

end;

end;

Procedure TFindForm.FindInCurrentDir(CurDir:string);

//Рекурсивная Процедура поиска в текущей директории и поддиректориях

Var

SizeF:integer;

i:integer;

EndList:boolean;

F:TSearchRec;

D:string;

Key:Char;

begin

FindForm.StatusFind.Panels[1].Text:=CurDir;

FindFirst(CurDir+'*.*',faAnyFile,F);

FindNext(F);

repeat

// вставить АSМовый код для прерывания по клавише ESC

If FindForm.CBAdvSearch.Checked and (F.Attr<>faDirectory) then

begin

if not(((F.Size < StrToInt(FindForm.SLess.Text)) and (F.Size > StrToInt(FindForm.SGreater.Text)))) then Continue;

if not(((FileDateTime(CurDir+F.Name)<FindForm.DateIsBefore.Date) and (FileDateTime(CurDir+F.Name) > FindForm.DateIsAfter.Date))) then Continue;

end;

if F.Attr=faDirectory then

if (F.Name<>'.') and (F.Name<>'..') then

begin

FindInCurrentDir(CurDir+F.Name+'\');

end;

if (F.Name<>'..') and (F.Name<>'.') then

if CompareFileWithMask(F.Name) then

begin

FindForm.FileWasFind.Items.Add(CurDir+F.Name);

FindForm.StatusFind.Panels[0].Text:=IntToStr(StrToInt(FindForm.StatusFind.Panels[0].Text)+1);

FindForm.FileWasFind.Refresh;

end;

Until((FindNext(F) <> 0));{ and (KeyPressed));}

FindClose(F);

end;

Procedure FindInAllDr;

//Поиск на всех дисках

Var

Dir:string;

i:integer;

begin

for i:=1 to MainForm.DrBox.Items.Count-1 do

begin

dir:=MainForm.DrBox.Items.Strings[i];

dir:=UpperCase(dir[1]);

FindForm.FindInCurrentDir(dir+':\');

end;

end;

Procedure WhereFind;

//Интерфейсная часть

Var

i:integer;

begin

if FindForm.RBCurDir.Checked then

begin

FindForm.LCurDir.Caption:=MainForm.Directory.Directory;

end;

if FindForm.RBCurDrive.Checked then

begin

FindForm.LCurDir.Caption:=UpperCase(MainForm.Directory.Drive)+':\';

end;

if FindForm.RBAllDrives.Checked then

begin

FindForm.LCurDir.Caption:='';

for i:=1 to MainForm.DrBox.Items.Count-1 do

begin

FindForm.LCurDir.Caption:=FindForm.LCurDir.Caption+UpperCase(MainForm.DrBox.Items.Strings[i][1])+':\ '

end;

end;

end;

Procedure InitFileMask;

//Проверка маски поиска для дальнейшего занесения в список масок

Var

i:integer;

tempStr:string;

begin

tempStr:=FindForm.CBFindMask.Text;

FindForm.CBFindMask.Clear;

for i:=1 to 10 do

begin

if FileMaskToFind[i]<>'' then

FindForm.CBFindMask.Items.Add(FileMaskToFind[i]);

end;

FindForm.CBFindMask.Text:=tempStr;

end;

Procedure ZdvigMask(s:string);

// Формирование списка масок поиска для хранения

Var

i:integer;

tmp:boolean;

begin

if FindForm.CBFindMask.Text<>'*.*' then