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

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

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

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

 end;

 end;

Procedure SaveIniMainForm;

 begin

 if MainForm.Top<>-4 then

 begin

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

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

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

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

 end;

 end;

Function FloatToInt(x:real):integer;

 begin

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

 end;

Procedure GetFormToCenter(Form:TForm);

 begin

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

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

 end;

Function FormatSize(S:String):String;

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

 Var

 i,j,n:integer;

 Tmp,Temp:String;

 begin

 Tmp:='';

 for i:=Length(S) downto 1 do

 tmp:=tmp+S[i];

 n:=0;

 for i:=1 to Length(tmp) do

 begin

 if n=3 then

 begin

 n:=0;

 Temp:=Temp+',';

 end;

 Temp:=Temp+Tmp[i];

 n:=n+1;

 end;

 Tmp:='';

 for i:=Length(Temp) downto 1 do

 Tmp:=Tmp+Temp[i];

 FormatSize:=Tmp;

 end;

end.

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

interface

Uses

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

 StdCtrls, Buttons;

Var

 IndexDelDir:integer;

 CurDeleteDir:string;

 Yes,No,All:boolean;

 SourseDir:String;

 DestinationDir:String;

 IndexDeleteDirectory:integer;

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

Procedure DelNotEmptyDirectory(Dir:String);

Procedure PasteDirectory(SDir,DDir:string);

Procedure CreateDirInDestin(S,D:string);

Procedure SortCMDirList;

implementation

Uses

 UMainForm, UMainForm_, UDeleteDir, DirOutLn, UAskDeleteCurrentFile,

 FMXUtils,UProgressForm;

Procedure DelNotEmptyDirectory(Dir:string);

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

 Var

 i:integer;

 Max:integer;

 EndFor:integer;

 begin

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

 GreateCopyMoveDirList(dir);

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

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

 begin

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

 FDeleteDir.Label1.Visible:=False;

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

 FdeleteDir.Update;

 end;

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

 SortCMDirList;

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

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

 begin

 {$I-}

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

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

 FDeleteDir.Label1.Visible:=False;

 FdeleteDir.Update;

 if IOResult<>0 then

 begin

 MainForm.CMDirList.Items.Clear;

 MainForm.CMFileList.Items.Clear;

 Exit;

 end;

 MainForm.CMDirList.Items.Delete(i);

 end;

 end;

Function DesideSlash(str:string):integer;

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

 Var

 D,r:integer;

 begin

 d:=0;

 for r:=0 to Length(str) do

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

 DesideSlash:=D;

 end;

Procedure SortCMDirList;

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

 Var i:integer;

 Strl,StrH:string;

 Flag:Boolean;

 begin

 Flag:=False;

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

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

 repeat

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

 begin

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

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

 if DesideSlash(StrL)>DesideSlash(StrH) then

 begin

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

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

 end;

 end;

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

 begin

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

 begin

 Flag:=True;

 end

 else

 begin

 Flag:=False;

 Break;

 end;

 end;

 Until (Flag);

 end;

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

 Var i,Point:integer;

 begin

 For i:=0 to Length(str) do

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

 begin

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

 else break;

 end;

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

 For i:=Point to Length(str) do

 d:=d+str[i];

 if not CreateDir(D) then

 begin

 end

 else

 begin

 MainForm.Directory.SetDirectory(D);

 MainForm.Directory.BuildTree;

 end;

 end;

Procedure CreateDirInDestin(S,D:string);

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

 Var

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

 EndFor:integer;

 begin

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

 SortCMDirList;

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

 begin

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

 CreateOneDirInDes(D,S,str);

 end;

 end;

Function CheskSizeInDestination:boolean;

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

 Var

 i:integer;

 Size:integer;

 begin

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

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

 if DiskFree(0) < size then

 CheskSizeInDestination:=False

 else

 CheskSizeInDestination:=True;

 end;

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

 Var

 Point,i:integer;

 begin

 For i:=0 to Length(s) do

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

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

 For i:=Point to Length(f) do

 d:=d+f[i];

 For i:=Length(d) downTo 0 do

 if D[i]='\' then

 begin

 D[i+1]:=#0;

 Break;

 end;

 CreateDestinPathForFile:=d;

 end;

Procedure PasteFileInDest(S,D:string);

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

 Var

 i:integer;

 Str:string;

 F:String;

 begin

 MainForm.Directory.Repaint;

 GetFormToCenter(ProgressForm);

 ProgressForm.Show;

 SizeAllCopy:=GetSizeAllFiles(MainForm.CMFileList);

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

 begin

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

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

 If not DoingWithDir then

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

 MainForm.CMFileList.Items.Delete(0);

 end;

 ProgressForm.Close;

 MainForm.FileList.Update;

 end;

Procedure PasteDirectory(SDir,DDir:string);

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

 Var

 i:integer;

 begin

 if CheskSizeInDestination then

 begin

 CreateDirInDestin(SDir,DDir);

 PasteFileInDest(Sdir,DDir);

 if not DoingWithDir then

 begin

 end;

 end

 else

 begin

 if DoingWithDir then

 begin

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

 end

 else

 begin

 end;

 end;

 end;

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

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

 Var

 F:TSearchRec;

 begin

 if flag then

 begin

 FileSetAttr(dFile,faArchive);

 DeleteFile(dFile)

 end

 else

 begin

 FindFirst(dFile,faAnyFile,F);

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

 DeleteFile(dFile)

 else

 begin

 AskDeleteCurrentFile.FileName.Caption:=F.Name;

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

 AskDeleteCurrentFile.ShowModal;

 if not No Then

 begin

 FileSetAttr(dFile,faArchive);

 DeleteFile(dFile);

 end;

 end;

 end;

 FindClose(f);

 end;

end.

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

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

interface

uses

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

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

type

 TFindForm = class(TForm)

 FileWasFind: TListBox;

 StatusFind: TStatusBar;

 Table: TTabbedNotebook;

 BitBtn1: TBitBtn;

 CBFindMask: TComboBox;

 Label1: TLabel;

 GroupBox1: TGroupBox;

 RBCurDir: TRadioButton;

 RBCurDrive: TRadioButton;

 RBAllDrives: TRadioButton;

 GroupBox2: TGroupBox;

 LCurDir: TLabel;

 ExitSearch: TButton;

 Label2: TLabel;

 Label3: TLabel;

 DateIsAfter: TDateTimePicker;

 DateIsBefore: TDateTimePicker;

 Label4: TLabel;

 Label5: TLabel;

 SGreater: TEdit;

 SLess: TEdit;

 CBAdvSearch: TCheckBox;

 Menu: TPopupMenu;

 Run1: TMenuItem;

 GoTo1: TMenuItem;

 CBCase: TCheckBox;

 B2: TBitBtn;

 B1: TButton;

 Timer1: TTimer;

 procedure FormActivate(Sender: TObject);

 procedure BitBtn1Click(Sender: TObject);

 procedure CBFindMaskDropDown(Sender: TObject);

 procedure RBCurDirClick(Sender: TObject);

 procedure RBCurDriveClick(Sender: TObject);

 procedure RBAllDrivesClick(Sender: TObject);

 procedure ExitSearchClick(Sender: TObject);

 procedure CBAdvSearchClick(Sender: TObject);

 procedure MenuPopup(Sender: TObject);

 procedure Run1Click(Sender: TObject);

 procedure GoTo1Click(Sender: TObject);

 procedure B2Click(Sender: TObject);

 procedure B1Click(Sender: TObject);

 procedure Timer1Timer(Sender: TObject);

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

 private

 public

 Procedure FindInCurrentDir(CurDir:string);

 end;

Type

 PRec = ^TRec;

 TRec = record

 Name:TSearchRec;

 SubDir:string;

 Next:PRec;

 end;

var

 FindForm: TFindForm;

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

 EndFindFlag:boolean;

Procedure ZdvigMask(s:string);

Procedure InitFileMask;

Procedure WhereFind;

Procedure FindFile;

Procedure FindInAllDr;

function CompareFileWithMask(FileName:string):boolean;

implementation

uses UMainForm,FmxUtils;

{$R *.DFM}

function CompareFileWithMask(FileName:string):boolean;

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

 Var

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

 EndFor,i,j:integer;

 tmp,R:boolean;

 begin

 FN:='';

 Mask:=FindForm.CBFindMask.Text;

 if not FindForm.CBCase.Checked then

 begin

 Mask:=UpperCase(Mask);

 FileName:=UpperCase(FileName);

 end;

 FR:=ExtractFileExt(FileName);

 For i:=1 to Length(FileName) do

 if FileName[i]<>'.' then

 FN:=FN+FileName[i]

 else break;

 For i:=1 to Length(Mask) do

 if Mask[i]<>'.' then

 MaskN:=MaskN+Mask[i]

 else break;

 MaskR:=ExtractFileExt(Mask);

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

 if Length(MaskR)< Length(FR) then

 EndFor:=Length(MaskR)

 else

 EndFor:=Length(FR);

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

 begin

 j:=Length(MaskR);

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

 begin

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

 begin

 j:=j-1;

 R:=True;

 end

 Else

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

 begin

 break;

 end

 else

 begin

 R:=False;

 Break;

 end;

 end;

 end;

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

 begin

 j:=1;

 for i:=1 to EndFor do

 begin

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

 begin

 j:=j+1;

 R:=True;

 end

 else

 begin

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

 begin

 break;

 end

 else

 begin

 R:=False;

 Break;

 end;

 end;

 end;

 end;

 for i:=0 to Length(MaskR) do

 if MaskR[i]<>'*' then

 tmp:=True

 else

 begin

 tmp:=False;

 break;

 end;

 if tmp then

 if Length(MaskR)=Length(FR) then

 begin

 for i:=0 to Length(FR) do

 if MaskR[i]=FR[i] then

 R:=True

 else

 begin

 R:=False;

 break;

 end;

 end

 else

 begin

 R:=False;

 end;

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

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

 if R then

 begin

 if Length(MaskN)<Length(FN) then

 EndFor:=Length(MaskN)

 else EndFor:=Length(FN);

 if MaskN[1]='*' then

 begin

 j:=Length(MaskN);

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

 begin

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

 begin

 j:=j-1;

 R:=True;

 end

 else

 begin

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

 begin

 break;

 end

 else

 begin

 r:=false;

 break;

 end;

 end;

 end;

 end;

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

 begin

 j:=0;

 for i:=0 to EndFor do

 begin

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

 begin

 j:=j+1;

 r:=True;

 end

 else

 begin

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

 break

 else

 begin

 R:=False;

 break;

 end;

 end;

 end;

 end;

 for i:=0 to Length(MaskN) do

 if MaskN[i]<>'*' then

 tmp:=True

 else

 begin

 tmp:=False;

 break;

 end;

 if tmp then

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

 r:=False

 else

 begin

 for i:=0 to Length(MaskN) do

 if MaskN[i]=FN[i] then

 r:=True

 else

 begin

 r:=False;

 break;

 end;

 end;

 end;

 CompareFileWithMask:=R;

 end;

Procedure FindFile;

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

 Var

 Dir:string;

 SubDir:string;

 Dr:Char;

 begin

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

 If FindForm.RBCurDir.Checked then

 begin

 Dir:=FindForm.LCurDir.Caption;

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

 Dir:=Dir+'\';

 FindForm.FindInCurrentDir(Dir);

 end;

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

 If FindForm.RBCurDrive.Checked then

 begin

 Dir:=FindForm.LCurDir.Caption;

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

 Dir:=Dir+'\';

 FindForm.FindInCurrentDir(Dir);

 end;

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

 If FindForm.RBAllDrives.Checked then

 begin

 FindInAllDr;

 end;

 end;

Procedure TFindForm.FindInCurrentDir(CurDir:string);

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

 Var

 SizeF:integer;

 i:integer;

 EndList:boolean;

 F:TSearchRec;

 D:string;

 Key:Char;

 begin

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

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

 FindNext(F);

 repeat

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

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

 begin

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

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

 end;

 if F.Attr=faDirectory then

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

 begin

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

 end;

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

 if CompareFileWithMask(F.Name) then

 begin

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

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

 FindForm.FileWasFind.Refresh;

 end;

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

 FindClose(F);

 end;

Procedure FindInAllDr;

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

 Var

 Dir:string;

 i:integer;

 begin

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

 begin

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

 dir:=UpperCase(dir[1]);

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

 end;

 end;

Procedure WhereFind;

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

 Var

 i:integer;

 begin

 if FindForm.RBCurDir.Checked then

 begin

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

 end;

 if FindForm.RBCurDrive.Checked then

 begin

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

 end;

 if FindForm.RBAllDrives.Checked then

 begin

 FindForm.LCurDir.Caption:='';

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

 begin

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

 end;

 end;

 end;

Procedure InitFileMask;

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

 Var

 i:integer;

 tempStr:string;

 begin

 tempStr:=FindForm.CBFindMask.Text;

 FindForm.CBFindMask.Clear;

 for i:=1 to 10 do

 begin

 if FileMaskToFind[i]<>'' then

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

 end;

 FindForm.CBFindMask.Text:=tempStr;

 end;

Procedure ZdvigMask(s:string);

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

 Var

 i:integer;

 tmp:boolean;

 begin

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

 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.

Краткое руководство пользователя.

 Программа предназначена для управления файловой системой операционной системы Windows’95/’98, в программе предусмотрены следующие возможности:

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

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

Расширенный поиск файлов по маске;

Запуск программ со строкой параметров;

Применение маски-фильтра при просмотре списка файлов;

Создание директорий;

Определение размера директории;

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

Получение информации о текущем диске;

Запуск внешних программ редакторов для просмотра и редактирования файлов;

Установка интерфейсных параметров программы.

Обзор интерфейса программы МС.

 Интерфейс программы на четыре функциональные части

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

Панель инструментов;

Список файлов;

Список директорий;

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

 File

 View

 Options

Компонента File содержит в себе основные функции управления файлами и директориями (см. рис. 1). Функция запуска программ Run доступна только тогда, когда выделенный файл является исполняемой программой. При выборе данного пункта. Появляется форма, содержащая строку параметров, а также параметр запуска – вид формы окна запуска (см. рис. 2).

Рис 1. Меню File.

Рис 2. Форма запуска файлов со строкой параметров.

Функции Cut, Copy, Paste, Delete (Вырезать, Копировать, Вставить, Удалить) – стандартные функции управления файлами/директориями. При невозможности выполнения выше перечисленных действий, данные функции недоступны. Функция Rename (Переименовать) запрашивает у пользователя новое имя для файла / директории в форме показанной на рисунке 3.

Рис 3. Переименование файлов / директорий

Функция Delete (Удаления), удаляет выделенные элементы в зависимости от активной рабочей области. Если последнее, перед вызовом этой функции, выделение производилось в области файлов, то будут удалены выделенные файлы, если же активная область директорий то удалена будет директория.

Функция Find (Найти) обеспечивает расширенный поиск файлов по маске в области поиска указанной пользователем. Параметры и маска поиска задается в форме показанной на рисунке 4

Рис 4. Поиск файлов.

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

Функция Exit (Выход) производит выход из программы.

Всем выше описанным функциям сопоставлены горячие клавиши.

Компонента View содержит в себе функции фильтра, получения информации о диске, получение и установка атрибутов файла, получение размера текущей директории, выделения всех файлов находящихся в текущей директории и инверсное выделение файлов.

Функция File Mask (Маска фильтра) запрашивает у пользователя в форме Get File Mask маску для отображения файлов. Для отмены маски необходим повторный вызов функции и задание маски предлагаемой по умолчанию.

Функция Info (Информация) предоставляет пользователю информацию о текущем диске (объём свободного и занятого пространства), а также информацию о текущей директории.

Функция File Attributes (Атрибуты файла) дает возможность просмотра текущих атрибутов файла и изменения этих атрибутов. В случае нескольких файлов возможно групповое присвоение новых атрибутов.

Функция Size Directory (Размер директории) выводит в статус строке списка директорий размер текущей директории.

Функция Select All выделяет все файлы, находящиеся в данной директории.

Функция Invert Select инвертирует выделение файлов. С файлов которые были выделены, выделение снимается, а остальные файлы выделяются.

Компонента Options (Параметры) выводит на экран форму параметров программы см рис 5, в которой пользователь

Рис 5. Параметры программы

может установить параметры интерфейса программы.

Параметры – наличие статус строки, количество колонок в списке файлов (от 1 до 3), запрашивать подтверждение при выходе из программы. Так же существует механизм установки значения параметров по умолчанию (Запрашивать подтверждение при выходе, Наличие статус строки, 1 колонка в списке файлов).

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

Рис 6 Панель инструментов.

Список Файлов, предназначен для просмотра списка файлов расположенных в текущей директории. При нажатии правой кнопки мыши вызывается контекстное меню, в котором имеются функции копирования, удаления, переименования, вставки. Также у списка файлов существует статус-строка в которой выводится информация о отмеченном файле (имя, размер, дату и время создания). В случае группы отмеченных файлов статус–строка показывает какой суммарный объём байт занимают отмеченные файлы на диске.

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

Использование функций:

Как упоминалось выше программа имеет набор функций работы с файлами. Некоторые требующие определённой последоваьтельности действий будут рассмотрены в данном разделе.

Копирование / Перенос.

Для копирования файлов / директории (в дальнейшем будем говорить только о файлах, так как процессы идентичны) необходимо выполнить следующую последовательность действий:

Выделить файлы которые необходимо скопировать

Существуют несколько способов выделения группы файлов, (те кто хорошо знаком в операционной системой Windows’95 этот раздел, как и все последующие могут пропустить) выделение мышкой с применением клавиш Ctrl и Shift, клавиша Ctrl предназначена для выделения в группу файлов отдельно стоящих в списке, а клавиша Shift предназначена для выделения “от начального файла, до конечного”.

Выполнить функцию копировать посредством выбора её из любого выше описанного места интерфейса

Выбрать место назначения копирования и выполнить функцию вставить.

Далее на экране будет отражён процесс копирования в форме Progress …

Удаление.

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

Переименование.

При переименовании на экран выводиться форма, предлагающая ввести новое имя для файла.