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