Постановка
задачи.
Задача
заключается
в разработке
файловой оболочки
для операционной
системы 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.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 килобайт
дискового
пространства.
Литература.
П.
Туротт, Г. Брент,
Р. Багдазиан,
С.Тендон «DELPHI
3», DiaSoft,
Киев, 1997 г.
Главная
форма программы
Модуль
описывающий
главную форму
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
TMainForm.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)
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.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;
|