Объектно-ориентированное программирование

 

2. РАЗРАБОТКА ПРИЛОЖЕНИЯ ВЫЛОНЯЮЩЕЕ ФУНКЦИИ ФАЙЛОВОГО МЕНЕДЖЕРА

2.1 Назначение и интерфейс приложения

При работе в любой операционной системе (ОС), в том числе и в  Windows, возникает необходимость в манипуляции файлами. Пользователю всегда необходимо иметь возможность для копирования, перемещения, переименования, удаления и, конечно же, запуска файлов. Для осуществления этих, и других операций с файлами, применяются специальные программы – файловые менеджеры (также иногда называемые оболочками). При работе в ОС Windows можно пользоваться стандартной программой Explorer, которая практически интегрирована в Windows, а также можно применять файловые менеджеры сторонних разработчиков. В настоящее время наибольшую популярность получили две программы-оболочки: FAR и Total Commander. FAR предлагает знакомое DOS-окно, но с поддержкой длинных имен и кучей дополнительных функций и возможностей. Total Commander выполнен в стиле Norton Commander, но реализован в графическом интерфейсе Windows.  Интерфейс моего файлового менеджера выполнен в стиле Total Commander (рис.2.1). На следующих скриншотах показаны функции, которые способен выполнить файловый менеджер.

 

 

Рис.2.1 Общий вид файлового  менеджера.

 Рис.2.2 Переименование.

Рис.2.3 Перемещение с помощью  функции DragDrop.

 Рис.2.4 Создание нового каталога.  

2.2 Блок-схемы основных процедур

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

Рис. 2.1 Блок-схема процедуры копирования

 

Рис. 2.2  Блок-схема процедуры  переименования

 

 Рис. 2.3 Блок-схема процедуры перемещения

 

  Рис. 2.4  Блок-схема процедуры создания нового каталога

 

 

Рис. 2.5 Блок-схема процедуры  удаления 

2.3 Листинг с комментариями

unit Unit1;

interface

uses

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

  Dialogs, ComCtrls, ShellCtrls, StdCtrls, ExtCtrls, FileCtrl, Buttons,

  ToolWin;

type

  TForm1 = class(TForm)

    Dick1: TShellComboBox;

    File1: TShellListView;

    Dick2: TShellComboBox;

    File2: TShellListView;

    P1: TPanel;

    Panel1: TPanel;

    Button1: TButton;

    Edit1: TEdit;

    BitBtn1: TBitBtn;

    Label1: TLabel;

    Up1: TSpeedButton;

    Up2: TSpeedButton;

    ToolBar1: TToolBar;

    SpeedButton1: TSpeedButton;

    SpeedButton2: TSpeedButton;

    SpeedButton3: TSpeedButton;

    SpeedButton4: TSpeedButton;

    SpeedButton5: TSpeedButton;

    SpeedButton6: TSpeedButton;

    procedure ExitClick(Sender: TObject);

    procedure Up1Click(Sender: TObject);

    procedure Up2Click(Sender: TObject);

    procedure CopyFClick(Sender: TObject);

    procedure File1MouseDown(Sender: TObject; Button: TMouseButton;

      Shift: TShiftState; X, Y: Integer);

    procedure File2MouseDown(Sender: TObject; Button: TMouseButton;

      Shift: TShiftState; X, Y: Integer);

    procedure RePlaceClick(Sender: TObject);

    procedure ReNameClick(Sender: TObject);

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    procedure NewFolderClick(Sender: TObject);

    procedure DeleteClick(Sender: TObject);

    procedure File1DragOver(Sender, Source: TObject; X, Y: Integer;

      State: TDragState; var Accept: Boolean);

    procedure File1DragDrop(Sender, Source: TObject; X, Y: Integer);

 

  private

    { Private declarations }

  public

    { Public declarations }

  end;

  Tfile=file;

 

var

  Form1: TForm1;

  FromF, ToF : TFile;

  Buf : array [1..4096] of char;

  NumRead, NumWritten: Integer;

  enableF:boolean;

 

implementation

 

{$R *.dfm}

 

procedure Copy(var FromF, ToF : TFile);       //процедура копирования

begin

repeat

  BlockRead(FromF, Buf, SizeOf(Buf), NumRead);

  BlockWrite(ToF, Buf, NumRead, NumWritten);

until (NumRead = 0) or (NumWritten <> NumRead);

end;

 

procedure TForm1.ExitClick(Sender: TObject);  

begin

  Application.terminate;

end;

 

procedure TForm1.Up1Click(Sender: TObject); 

begin

    file1.Back;

end;

 

procedure TForm1.Up2Click(Sender: TObject);

begin

  file2.Back;

end;

 

function GetR(s:string):string;      // выделяем полное имя файла

var i:integer;

begin

  result:='';

  i:=length(s);

  while (i>0) and (result='') do begin

    if s[i]='\' then i:=0;

    if s[i]='.' then break;

    if i<>0 then dec(i);

  end;

  if i<>0 then

    result:=system.copy(s,i,length(s)-i+1);

end;

 

procedure TForm1.CopyFClick(Sender: TObject);        // копируем файл

var

  f:Tshellfolder;

  s:string;

begin

  if file1.RootFolder.PathName<>file2.RootFolder.PathName then

    if EnableF then begin

      f:=file1.SelectedFolder;

      if assigned(f) then assignfile(fromF,f.PathName);

      {$I-}

        reset(fromf,1);

      {$I+}

      if ioresult=0 then begin

        if getR(f.DisplayName)='' then

          s:=getR(f.PathName)

        else

          s:='';

        assignfile(toF,file2.RootFolder.PathName+'\'+f.DisplayName+s);

        {$I-}

          rewrite(toF,1);

        {$I+}

        if ioresult=0 then begin

          copy(fromf,tof);

          closefile(tof);

          file2.Refresh;

        end;

        closefile(fromf);

      end;

    end

    else begin

      f:=file2.SelectedFolder;

      if assigned(f) then assignfile(fromF,f.PathName);

      {$I-}

        reset(fromf,1);

      {$I+}

      if ioresult=0 then begin

        if getR(f.DisplayName)='' then

          s:=getR(f.PathName)

        else

          s:='';

        assignfile(toF,file1.RootFolder.PathName+'\'+f.DisplayName+s);

        {$I-}

          rewrite(toF,1);

        {$I+}

        if ioresult=0 then begin

          copy(fromf,tof);

          closefile(tof);

          file1.Refresh;

        end;

        closefile(fromf);

      end;

    end;

end;

 

procedure TForm1.File1MouseDown(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

begin

  enableF:=true;                            //возвращается назад в 1 окне

end;

 

procedure TForm1.File2MouseDown(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

begin

  Enablef:=false;                       //возвращается назад во 2 окне

end;

 

procedure TForm1.RePlaceClick(Sender: TObject);      // перемещение файла

begin

  Copy click(sender);                    // копируем файл

  {$I-}

    reset(tof);

  {$I+}

  if ioresult=0 then begin               // если исходный существует

    closefile(tof);

    {$I-}

      reset(fromF);

    {$I+}

    if ioresult=0 then begin            // и копия существует

      closefile(fromF);

      erase(fromF);                     // удаляем исходный

      if enableF then

        file1.Refresh

      else

        file2.Refresh;

    end;

  end;

end;

 

procedure TForm1.ReNameClick(Sender: TObject);

var

  f:TshellFolder;

begin

  if enableF then begin

    f:=file1.SelectedFolder;

    if assigned(f) then begin

      panel1.visible:=true;

      p1.Enabled:=false;

      edit1.Text:=f.DisplayName;

    end;

  end

  else begin

    f:=file1.SelectedFolder;

    if assigned(f) then begin

      panel1.Visible:=true;

      p1.Enabled:=false;

      edit1.Text:=f.DisplayName;

    end;

  end;

end;

 

procedure TForm1.Button1Click(Sender: TObject); //Переименование файла

begin

  panel1.Visible:=false;

  p1.Enabled:=true;

end;

 

procedure TForm1.Button2Click(Sender: TObject);

var

  f:TshellFolder;

begin

  if enableF then begin

    f:=file1.SelectedFolder;

    if f.Rename(edit1.Text) then begin

      panel1.Visible:=false;

      p1.Enabled:=true;

      file1.Refresh;

    end

    else

      showmessage('Не  могу переименовать!!!(Возможно использованы  НЕДОПУСТИМЫЕ символы)'); //вывод сообщения при написании неправильных символов

  end

  else begin

    f:=file2.SelectedFolder;

    if f.Rename(edit1.Text) then begin

      panel1.Visible:=false;

      p1.Enabled:=true;

      file2.Refresh;

    end

    else

      showmessage('Не  могу переименовать!!!(Возможно использованы  НЕДОПУСТИМЫЕ символы)');

  end;

end;

 

function MyRemoveDir(sDir: string): Boolean; //функция для удаления каталогов

var

  iIndex: Integer;

  SearchRec: TSearchRec;

  sFileName: string;

begin

  Result := False;

  sDir := sDir + '\*.*';

  iIndex := FindFirst(sDir, faAnyFile, SearchRec);

  while iIndex = 0 do

  begin

    sFileName := ExtractFileDir(sDir)+'\'+SearchRec.name;

    if SearchRec.Attr = faDirectory then

      begin

        if (SearchRec.name <> '' ) and

           (SearchRec.name <> '.') and

           (SearchRec.name <> '..') then

          MyRemoveDir(sFileName);

      end

    else begin

      if SearchRec.Attr <> faArchive then

        FileSetAttr(sFileName, faArchive);

      if not DeleteFile(sFileName) then

        ShowMessage('Немогу удалить ' + sFileName);

    end;

    iIndex := FindNext(SearchRec);

  end;

 

  FindClose(SearchRec); //освобождение памяти после цикла поиска

 

  RemoveDir(ExtractFileDir(sDir));

  Result := True;

end;

 

procedure TForm1.NewFolderClick(Sender: TObject); //новая папка

var f:file;

    folder:TShellFolder;

    s:string;

begin

  if enablef then begin

    s:=file1.RootFolder.PathName;

    if length(s)>3 then s:=s+'\';

    if not createdir(s+'NewFolder') then

      showmessage('Не могу создать папку в данном каталоге')//при создании двух каталогов в одном месте, выводит ошибку

    else

      file1.Refresh;

  end

  else begin

    s:=file2.RootFolder.PathName;

    if length(s)>3 then s:=s+'\';

    if not createdir(s+'NewFolder') then

      showmessage('Не могу создать папку в данном каталоге')

    else

      file2.Refresh;

  end;

end;

 

procedure TForm1.DeleteClick(Sender: TObject); //Процедура удаления

begin

  if enableF then begin

    if getR(file1.SelectedFolder.PathName)<>'' then begin

      assignfile(fromF,file1.SelectedFolder.PathName);

      {$I-}

        reset(fromF);

      {$I+}

      if ioresult=0 then begin

        closefile(fromF);

        erase(fromF);

      end

      else

        showmessage('Немогу удалить файл');

    end

    else

      if not myremovedir(file1.SelectedFolder.PathName) then

        showmessage('Немогу удалить каталог'); //вывод ошибки

    file1.Refresh;

  end

  else begin

    if getR(file2.SelectedFolder.PathName)<>'' then begin

      assignfile(fromF,file2.SelectedFolder.PathName);

      {$I-}

        reset(fromF);

      {$I+}