Реферат: Разработка файловой оболочки
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);
Страницы: 1, 2, 3, 4, 5, 6, 7, 8
