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