Файл: Основы программирования на языке Pascal.pdf

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

В главном модуле предусмотрено 7 процедур.

----------------//Процедура создания дерева

procedure TfrmMain.CraeteTree;

const

IconNames: array [0..6] of string = ('CLOSEDFOLDER', 'OPENFOLDER', 'FLOPPY', 'HARD', 'NETWORK', 'CDROM', 'RAM');

var

bm, mask: TBitmap;

i: integer;

diskChar: char;

disk: string;

node: TTreeNode;

DriveType: integer;

begin

tvCatalog.Items.BeginUpdate;

tvCatalog.Images := TImageList.CreateSize(16, 16);

bm := TBitmap.Create;

mask := TBitmap.Create;

for i := low(IconNames) to high(IconNames) do begin

bm.Handle := LoadBitmap(HInstance, PChar(IconNames[i]));

bm.Width := 16;

bm.Height := 16;

mask.Assign(bm);

mask.Mask(clBlue);

tvCatalog.Images.Add(bm, mask);

end;

for diskChar:= 'A' to 'Z' do begin

disk := diskChar + ':';

DriveType := GetDriveType(PChar(disk));

if DriveType = 1 then continue; //Корневой директории не существует

node := tvCatalog.Items.AddChild(nil, disk);

case DriveType of

DRIVE_REMOVABLE: node.ImageIndex := 2; //Съёмный диск

DRIVE_FIXED: node.ImageIndex := 3; //Жёсткий диск

DRIVE_REMOTE: node.ImageIndex := 4; //Сетевой диск

DRIVE_CDROM: node.ImageIndex := 5; //CD-ROM

else node.ImageIndex := 6; //RAM-диск

end;

node.SelectedIndex := node.ImageIndex;

node.HasChildren := true;

end;

tvCatalog.Items.EndUpdate;

end;

----------------//Процедура открытия каталога в дереве и поиска подкаталогов

procedure TfrmMain.OpenCatalog(ParentNode: TTreeNode);

function DirectoryName(name: string): boolean;

begin

result := (name <> '.') and (name <> '..');

end;

var

sr, srChild: TSearchRec;

node: TTreeNode;

path: string;

begin

node := ParentNode;

path := '';

repeat

path := node.Text + '\' + path;

node := node.Parent;

until node = nil;

if FindFirst(path + '*.*', faDirectory, sr) = 0 then begin

repeat

if (sr.Attr and faDirectory <> 0) and DirectoryName(sr.Name) then begin

node := tvCatalog.Items.AddChild(ParentNode, sr.Name);

node.ImageIndex := 0;

node.SelectedIndex := 1;

node.HasChildren := false;

if FindFirst(path + sr.Name + '\*.*', faDirectory, srChild) = 0 then begin

repeat

if (srChild.Attr and faDirectory <> 0) and DirectoryName(srChild.Name)

then node.HasChildren := true;

until (FindNext(srChild) <> 0) or node.HasChildren;

end;

FindClose(srChild);

end

until FindNext(sr) <> 0;

end else ParentNode.HasChildren := false;

FindClose(sr);

end;

----------------//Процедура создания формы

procedure TfrmMain.FormCreate(Sender: TObject);

begin

CraeteTree;

end;

----------------//Процедура раскрытия узла дерева

procedure TfrmMain.tvCatalogExpanding(Sender: TObject; Node: TTreeNode;

var AllowExpansion: Boolean);

begin

tvCatalog.Items.BeginUpdate;

node.DeleteChildren;

OpenCatalog(node);

tvCatalog.Items.EndUpdate;

end;

----------------//Процедура обновления

procedure TfrmMain.btnRefreshClick(Sender: TObject);

begin

tvCatalog.Items.Clear;

CraeteTree;

end;

----------------//Процедура открытия формы работы с файлами

procedure TfrmMain.imFileWorkClick(Sender: TObject);

var

frm: TfrmFiles;

begin

Application.CreateForm(TfrmFiles,frm);

frm.ShowModal;

frm.Free;

end;

----------------//Процедура закрытия приложения

procedure TfrmMain.imCloseClick(Sender: TObject);

begin

Application.Terminate;

end;

В модуле работы с файлами предусмотрены следующие процедуры и функции, относящиеся к самой форме.

----------------//Показ формы

procedure TfrmFiles.FormShow(Sender: TObject);

begin

lbFiles.Clear;

ChoiseFile:=nil;

edtCatalog.Text:='';

edtName.Text:='';

edtExt.Text:='';

edtFilePath.Text:='';

edtFileName.Text:='';

edtFileSize.Text:='';

end;

----------------//Основная процедура поиска

procedure TfrmFiles.FindFile(Dir, FileName, FileExt: string);

Var

I: Integer;

dirList: TStringList;

begin

// dirList:=TStringList.Create;

dirList:=FindDir(Dir);

dirList.Add(Dir);

for I := 0 to dirList.Count-1 do

FindFileDir(dirList.Strings[i],FileName,FileExt);

end;

----------------//Поиск файла в директории

procedure TfrmFiles.FindFileDir(Dir, FileName, FileExt: string);

var SR:TSearchRec;

FindRes:Integer;

begin

if FileName='' then FileName:='*';

if FileExt='' then FileExt:='*';

FindRes:=FindFirst(Dir+FileName+'.'+FileExt,faAnyFile,SR);

While FindRes=0 do

begin

// если найден не каталог, то

if ((SR.Attr and faDirectory)<>faDirectory) then

lbFiles.Items.Add(Dir+SR.Name);

FindRes:=FindNext(SR);

end;

FindClose(SR);

end;

----------------//Составление списка подкаталогов указанного каталога

function TfrmFiles.FindDir(Dir: string): TStringList;

Var SR:TSearchRec;

FindRes:Integer;

begin

Result:=TStringList.Create;

FindRes:=FindFirst(Dir+'*',faDirectory,SR);

While FindRes=0 do

begin

if ((SR.Attr and faDirectory)=faDirectory) and

((SR.Name='.')or(SR.Name='..')) then

begin

FindRes:=FindNext(SR);

Continue;

end;

// если найден каталог, то

if ((SR.Attr and faDirectory)=faDirectory) then

begin

// входим в процедуру поиска с параметрами текущего каталога

// каталог, что мы нашли

Result.Add(Dir+SR.Name+'\');

Result.AddStrings(FindDir(Dir+SR.Name+'\'));

FindRes:=FindNext(SR);

// после осмотра вложенного каталога мы продолжаем поиск

// в этом каталоге

Continue; // продолжить цикл

end;

FindRes:=FindNext(SR);

end;

FindClose(SR);

end;

Реализован класс выбранного файла:

TChoiseFile = class

Filename: string;

FileExt: string;

FilePath: string;

FileSize: Double;

constructor Create(fn: string); overload;

function Copy(path: string): TResult;

function Delete: TResult;

end;

----------------//Обработка события нажатия на кнопку поиска

procedure TfrmFiles.btnSearchClick(Sender: TObject);

var

dir, fileName, fileExt: string;

begin

if (edtCatalog.Text='') or (not DirectoryExists(edtCatalog.Text)) then

ShowMessage('Каталог поиска указан неверно')

else

begin

Dir:=edtCatalog.Text+'\';

fileName:=edtName.Text;

fileExt:=edtExt.Text;

lbFiles.Clear;

FindFile(dir, fileName, fileExt);

end;

----------------//Обработка события нажатия на кнопку открытия файла

procedure TfrmFiles.btnOpenFileClick(Sender: TObject);

begin

if Assigned(ChoiseFile) then

begin

if FileExists(ChoiseFile.FilePath) then

begin

ShellExecute(0,'open',PChar(ChoiseFile.FilePath),'','',SW_SHOW);

end

else

ShowMessage('Выбранный файл был удалён или перемещён');

end;

----------------//Обработка события нажатия на кнопку закрытия формы

procedure TfrmFiles.btnCloseClick(Sender: TObject);

begin

if edtFilePath.Text<>'' then ChoiseFile.Free;

ModalResult:=mrOk;

end;

----------------//Обработка события нажатия на кнопку выбора каталога поиска

procedure TfrmFiles.btnODClick(Sender: TObject);

var

dir: string;

begin

SelectDirectory('Выбор каталога поиска', '', dir);

edtCatalog.Text:=dir;

end;

----------------//Обработка события нажатия на кнопку выбора файла

procedure TfrmFiles.btnChoiseFileClick(Sender: TObject);

begin

if Assigned(ChoiseFile) then ChoiseFile.Free;

ShowMessage(lbFiles.Items[lbFiles.ItemIndex]);

ChoiseFile:=TChoiseFile.Create(lbFiles.Items[lbFiles.ItemIndex]);

edtFileName.Text:=ChoiseFile.FileName;

edtFilePath.Text:=ChoiseFile.FilePath;

edtFileSize.Text:=FloatToStr(ChoiseFile.FileSize)+' Кб.';

end;

----------------//Обработка события нажатия на кнопку удаления файла

procedure TfrmFiles.btnDeleteFileClick(Sender: TObject);

var

res: TResult;

begin

if MessageDlg('Вы действительно хотите удалить файл?',mtWarning,mbOkCancel,0)=mrOk then

begin

res:=ChoiseFile.Delete;

ShowMessage(res.msg);

if res.code<>-1 then begin

edtFilePath.Text:='';

edtFileName.Text:='';

edtFileSize.Text:='';

end;

----------------//Обработка события нажатия на кнопку выбора каталога для копирования файла

procedure TfrmFiles.btnChoiseCatalogToCopyClick(Sender: TObject);

var

dir: string;

begin

SelectDirectory('Выбор каталога назначения', '', dir);

edtCatalogToCopy.Text:=dir;

end;

----------------//Обработка события нажатия на кнопку копирования файла

procedure TfrmFiles.btnCopyFileClick(Sender: TObject);

var

res: TResult;

begin

if edtCatalogToCopy.Text<>'' then begin

res:=ChoiseFile.Copy(edtCatalogToCopy.Text);

ShowMessage(res.msg);

case res.code of

0: edtFilePath.Text:=ChoiseFile.FilePath;

-2: begin

edtFilePath.Text:='';

edtFileName.Text:='';

edtFileSize.Text:='';

ChoiseFile.Free;

end;

Реализация методов класса TChoiseFile представлена ниже.

----------------//Конструктор класса

Constructor TChoiseFile.Create(fn: string);

var

str: string;

fl: integer;

begin

FilePath:=fn;

str:=AnsiReverseString(fn);

self.FileName:=AnsiReverseString(System.Copy(str,Pos('.',str)+1,Pos('\',str)-Pos('.',str)-1));

self.FileExt:=AnsiReverseString(System.Copy(str,1,Pos('.',str)-1));

try

fl:=FileOpen(FilePath, fmOpenRead);

FileSize:= RoundTo(GetFileSize(fl, nil) / 1024,-2);

finally

FileClose(fl);

end;

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

function TChoiseFile.Copy(path: string): TResult;

begin

try

if FileExists(self.FilePath) then begin

Result.code:=0;

if CopyFile(PWideChar(self.FilePath), PWideChar(path+'\'+self.FileName+'.'+self.FileExt), false) then Result.msg:='Файл скопирован';

self.FilePath:=path+'\'+self.FileName+'.'+self.FileExt;

end else

begin

Result.code:=-2;

Result.msg:='Файл был удалён или перемещён';

end;

except

on E : Exception do

begin

Result.msg:=E.Message;

Result.code:=-1;

end;

----------------//Удаление файла

function TChoiseFile.Delete: TResult;

begin

try

if FileExists(self.FilePath) then begin

DeleteFile(self.FilePath);

Result.msg:='Операция удаления выполнена';

Result.code:=0;

end else

begin

Result.code:=-2;

Result.msg:='Файл был удалён или перемещён';

end;

self.Free;

except

on E : Exception do

begin

Result.msg:=E.Message;

Result.code:=-1;

end;

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

program FileManager;

uses

Vcl.Forms,

uMain in 'uMain.pas' {frmMain},

uFiles in 'uFiles.pas' {frmFiles};

{$R *.res}

begin

Application.Initialize;

Application.MainFormOnTaskbar := True;

Application.CreateForm(TfrmMain, frmMain);

Application.Run;

end.

Испытания полученной программы

Методика испытаний

Были выявлены следующие требования к программе:

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

Для испытания программы требуется проверить работу по всем требованиям.

Проверка программы

Было проведено ручное испытание разработанной системы по указанным требования к программе.

1. Построение дерева каталогов при запуске программы.

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

Рисунок 5 – Проверка построения дерева каталогов

2. Обновления дерева каталогов по требованию пользователя.

Приложение запущено в этот момент, к компьютеру подключается съёмный носитель – usb-флэш. Для обновления каталогов требуется нажать кнопку «Обновить». Дерево перестраивается и появляется новый каталог съёмного носителя – рисунок 6 (появился диск F:).

Рисунок 6 – Обновление дерева каталога по требованию пользователя

3. Поиск файла в заданном каталоге с возможным названием или расширением файла, или без них.

Для доступа к поиску файлов требуется выбрать в главном меню пункт «Файл» и «Работа с файлами». Для поиска указывается каталог поиска. А также, можно указать расширение файла или его название. После нажатия кнопки «Поиск» все найденные файлы будут отображены в списке поиска – рисунок 7.

Рисунок 7 – Проверка поиска файлов

4. Открытие выбранного файла в приложении по умолчанию для расширения файла.

Для выбора файла в приложении требуется выбрать файл в списке и нажать кнопку «Выбрать файл». В полях появятся данные файла – рисунок 8.

Рисунок 8 – Проверка выбора файла

Для запуска файла в приложении, которое назначено для данного типа файла по умолчанию требуется нажать кнопку «Открыть». Файл будет открыт в своём приложении – рисунок 9.

Рисунок 9 – Проверка открытия файла

5. Копирование выбранного файла с подтверждением выполненной операции.

Для копирования файла требуется указать каталог копирования и нажать кнопку «Копировать». На рисунке 10 представлено подтверждение копирования файла. После удачного копирования выдаётся сообщение о проделанной операции – рисунок 11.

Рисунок 10 – Проверка копирования файла

Рисунок 11 – Подтверждение выполнения операции копирования

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

Для удаления файла требуется нажать кнопку «Удалить», появится окно подтверждения операции пользователем – рисунок 12. При подтверждении файл удаляется и появляется сообщение об успешно выполненной операции удаления – рисунок 13. В окне очищаются данные о выбранном файле – рисунок 14.

Рисунок 12 – Проверка подтверждения операции удаления файла

Рисунок 13 – Проверка сообщения об успешном завершении операции удаления файла

Рисунок 14 – Проверка удаления файла