- 40 -

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

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

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.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;

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

begin

for i:=10 downto 0 do

if FindForm.CBFindMask.Items[i]<>FindForm.CBFindMask.Text then

tmp:=true

else

begin

tmp:=False;

break;

end;

if tmp then

for i:=10 downto 2 do

begin

FileMaskToFind[i]:=FileMaskToFind[i-1];

end;

FileMaskToFind[1]:=s;

end;

end;

procedure TFindForm.FormActivate(Sender: TObject);

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

begin

Timer1.Enabled:=True;

InitFileMask;

DateIsBefore.Date:=Date;

DateIsAfter.Date:=Date;

CBFindMask.Text:='*.*';

CBCase.Checked:=False;

RBCUrDir.Checked:=True;

LCurDir.Caption:=MainForm.Directory.Directory;

SGreater.Text:='';

SLess.Text:='';

CBAdvSearch.Checked:=False;

FileWasFind.Clear;

FindForm.StatusFind.Panels[0].Text:='0';

FindForm.ActiveControl:=CBFindMask;

end;

procedure TFindForm.BitBtn1Click(Sender: TObject);

//Начать поиск файлов

begin

ZdvigMask(CBFindMask.Text);

FindForm.FileWasFind.Clear;

FindForm.StatusFind.Panels[0].Text:='0';

FindForm.FileWasFind.Sorted:=False;

FindForm.Refresh;

FindFile;

FindForm.FileWasFind.Sorted:=True;

FindForm.FileWasFind.Refresh;

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

end;

procedure TFindForm.CBFindMaskDropDown(Sender: TObject);

begin

InitFileMask;

end;

procedure TFindForm.RBCurDirClick(Sender: TObject);

begin

WhereFind;

end;

procedure TFindForm.RBCurDriveClick(Sender: TObject);

begin

WhereFind

end;

procedure TFindForm.RBAllDrivesClick(Sender: TObject);

begin

WhereFind;

end;

procedure TFindForm.ExitSearchClick(Sender: TObject);

begin

FindForm.Close;

end;

procedure TFindForm.CBAdvSearchClick(Sender: TObject);

begin

if CBAdvSearch.Checked then

begin

Table.ActivePage:='Advanced Search';

end;

end;

procedure TFindForm.MenuPopup(Sender: TObject);

var i:integer;

begin

for i:=0 to FindForm.FileWasFind.Items.Count-1 do

If FindForm.FileWasFind.Selected[i] then

begin

FindForm.Run1.Enabled:=True;

FindForm.GoTo1.Enabled:=True;

Break;

end

else

begin

FindForm.Run1.Enabled:=False;

FindForm.GoTo1.Enabled:=False;

end;

end;

procedure TFindForm.Run1Click(Sender: TObject);

//Запуск файла из формы поиска

Var

i:integer;

begin

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

if FindForm.FileWasFind.Selected[i] then

begin

ExecuteFile(FindForm.FileWasFind.Items[i],'','',SW_SHOW);

break;

end;

FindForm.Close;

end;

Procedure GoToFile;

// Преход в главную форму к месту расположения найденного файла

Var

i,j:integer;

Dir,FileName:string;

begin

for i:=0 to FindForm.FileWasFind.Items.Count-1 do

begin

if FindForm.FileWasFind.Selected[i] then

begin

FileName:=ExtractFileName(FindForm.FileWasFind.Items[i]);

FindForm.Close;

Dir:=FindForm.FileWasFind.Items[i];

for j:=Length(Dir) downTo 0 do

begin

if Dir[j]='\' then

begin

Dir[j+1]:=#0;

break;

end;

end;

MainForm.Directory.SetDrive(Dir[1]);

MainForm.Directory.Expand(1);

MainForm.Directory.SetDirectory(Dir);

MainForm.Directory.BuildTree;

MainForm.FileList.Refresh;

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

begin

if MainForm.FileList.Items[j]=FileName then

begin

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

MainForm.FileList.Refresh;

break;

end;

end;

break

end

end;

end;

procedure TFindForm.GoTo1Click(Sender: TObject);

begin

GotoFile;

end;

procedure TFindForm.B2Click(Sender: TObject);

begin

GotoFile;

end;

procedure TFindForm.B1Click(Sender: TObject);

begin

Run1Click(Sender);

end;

procedure TFindForm.Timer1Timer(Sender: TObject);

begin

if FileWasFind.SelCount<=0 then

begin

B1.Enabled:=False;

B2.Enabled:=False;

end

else

begin

B1.Enabled:=True;

B2.Enabled:=True;

end;

end;

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

begin

Timer1.Enabled:=False;

end;

end.

Изменённый стандартный модульunit

FmxUtils; //Изменённый стандартный модуль

// Внесйнные изменения отмечены "{}"

interface

uses SysUtils, Windows, Classes, Consts;

type

EInvalidDest = class(EStreamError);

EFCantMove = class(EStreamError);

procedure CopyFile(const FileName, DestName: string);

procedure MoveFile(const FileName, DestName: string);

function GetFileSize(const FileName: string): LongInt;

function FileDateTime(const FileName: string): TDateTime;

function HasAttr(const FileName: string; Attr: Word): Boolean;

function ExecuteFile(const FileName, Params, DefaultDir: string;

ShowCmd: Integer): THandle;

{} Var AllReadByteFile:Real;

{} SizeAllCopy:Longint;

implementation

uses Forms, ShellAPI, UProgressForm, UMainForm_, UNotTrivial,UMainForm;

const

SInvalidDest = 'Destination %s does not exist';

SFCantMove = 'Cannot move file %s';

procedure CopyFile(const FileName, DestName: TFileName);

var

FileSizeProgress,ReadByteFile:Real;

CopyBuffer: Pointer; { buffer for copying }

BytesCopied: Longint;

Source, Dest: Integer; { handles }

Destination: TFileName; { holder for expanded destination name }

const

ChunkSize: Longint = 8192; { copy in 8K chunks }

begin

Destination := ExpandFileName(DestName); { expand the destination path }

if HasAttr(Destination, faDirectory) then { if destination is a directory... }

Destination := Destination + ExtractFileName(FileName); { ...clone file name }

GetMem(CopyBuffer, ChunkSize); { allocate the buffer }

try

Source := FileOpen(FileName, fmShareDenyWrite); { open source file }

if Source < 0 then raise EFOpenError.CreateFmt(SFOpenError, [FileName]);

try

Dest := FileCreate(Destination); { create output file; overwrite existing }

if Dest < 0 then raise EFCreateError.CreateFmt(SFCreateError, [Destination]);

try

//Ведение статистики в форме прогресса копирования

{} If MainForm.CMFileList.Items.Count=0 then

{} SizeAllCopy:=GetSizeAllFiles(MainForm.TempCopyMove);

{} ProgressForm.ProgresCopy.Progress:=0;

{} ProgressForm.Total.Caption:=FormatSize(IntToStr(SizeAllCopy));

{} FileSizeProgress:=GetFileSize(FileName);

{} ProgressForm.LFrom.Caption:=FileName;

{} ProgressForm.LFileSize.Caption:=FormatSize(IntToStr(GetFileSize(FileName)));

{} ProgressForm.LTo.Caption:=Destination;

{} ProgressForm.Update;

{} ReadByteFile:=0;

repeat

BytesCopied := FileRead(Source, CopyBuffer^, ChunkSize); { read chunk }

{} if ChunkSize>GetFileSize(FileName)then

{} ReadByteFile:=ReadByteFile+GetFileSize(FileName)

{} else

{} ReadByteFile:=ReadByteFile+ChunkSize;

{} ProgressForm.LREadyWrite.Caption:=FormatSize(FloatToStr(ReadByteFile));

{} ProgressForm.Update;

{} ProgressForm.ProgresCopy.Progress:=FloatToInt(((100*ReadByteFile)/(FileSizeProgress+1)));

{End Paste}

if BytesCopied > 0 then { if we read anything... }

FileWrite(Dest, CopyBuffer^, BytesCopied); { ...write chunk }

{} ProgressForm.ProgresCopy.Repaint;

{} ProgressForm.AllProgresCopy.Repaint;

until BytesCopied < ChunkSize; { until we run out of chunks }

{} AllReadByteFile:=AllReadByteFile+GetFileSize(FileName);

{} ProgressForm.Ready.Caption:=FormatSize(FloatToStr(AllReadByteFile));

{} ProgressForm.AllProgresCopy.Progress:=FloatToInt(((100*(AllReadByteFile)/(SizeAllCopy+1))));

{} ProgressForm.ProgresCopy.Progress:=100;

finally

FileClose(Dest); { close the destination file }

end;

finally

FileClose(Source); { close the source file }

end;

finally

FreeMem(CopyBuffer, ChunkSize); { free the buffer }

end;

end;

{ MoveFile procedure }

{

Moves the file passed in FileName to the directory specified in DestDir.

Tries to just rename the file. If that fails, try to copy the file and

delete the original.

Raises an exception if the source file is read-only, and therefore cannot

be deleted/moved.

}

procedure MoveFile(const FileName, DestName: string);

var

Destination: string;

begin

Destination := ExpandFileName(DestName); { expand the destination path }

if not RenameFile(FileName, Destination) then { try just renaming }

begin

CopyFile(FileName, Destination); { copy it over to destination...}

DelOneFile(FileName,All);

end;

end;

{ GetFileSize function }

{

Returns the size of the named file without opening the file. If the file

doesn't exist, returns -1.

}

function GetFileSize(const FileName: string): LongInt;

var

SearchRec: TSearchRec;

begin

if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then

Result := SearchRec.Size

else Result := -1;

end;

function FileDateTime(const FileName: string): System.TDateTime;

begin

Result := FileDateToDateTime(FileAge(FileName));

end;

function HasAttr(const FileName: string; Attr: Word): Boolean;

begin

Result := (FileGetAttr(FileName) and Attr) = Attr;

end;

function ExecuteFile(const FileName, Params, DefaultDir: string;

ShowCmd: Integer): THandle;

var

zFileName, zParams, zDir: array[0..79] of Char;

begin

Result := ShellExecute(Application.MainForm.Handle, nil,

StrPCopy(zFileName, FileName), StrPCopy(zParams, Params),

StrPCopy(zDir, DefaultDir), ShowCmd);

end;

end.