Ðåôåðàò: Ðàçðàáîòêà ôàéëîâîé îáîëî÷êè
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+':\');
