Разработка файловой оболочки (стр. 4 из 6)
if Application.MessageBox(MStr,'Warning',1)<>1 then
begin
MainForm.TempCopyMove.Items[x]:=MainForm.TempCopyMove.Items[x]+'*';//.Delete(x);
ColFilesIn_TempCopyMove:=ColFilesIn_TempCopyMove-2;
end;
end;
end;
end;
Procedure DeleteEmptyDirectory(Dir:String);
//Удаление пустой директории
Var
i:integer;
begin
{$I-}
i:=MainForm.Directory.SelectedItem;
MainForm.Directory.Directory:=(MainForm.Directory.Drive+':\');
RmDir(Dir);
if IOResult <> 0 then
begin
GetFormToCenter(FDeleteDir);
FDeleteDir.LDir.Caption:=Dir;
FDeleteDir.ShowModal;
if Fdel then
begin
MainForm.Directory.Delete(i);
RmDir(Dir);
end
Else
begin
MainForm.Directory.SetDirectory(Dir);
MainForm.Directory.BuildTree;
end;
end
Else MainForm.Directory.Delete(i);
{$I+}
MainForm.Directory.Update;
MainForm.CMDirList.Items.Clear;
MainForm.CMFileList.Items.Clear;
end;
Function GetSizeAllFiles(List:TListBox):Integer;
// Определение размера всех файлов для прогресс формы
Var
i:integer;
Size:integer;
begin
Size:=0;
For i:=0 to List.Items.Count-1 do
begin
Size:=Size+GetFileSize(List.Items[i]);
end;
GetSizeAllFiles:=Size;
end;
Procedure PasteFileFromTemp;
//Вставка файлов
Var
StrPaste:string;
Str:string;
i:integer;
begin
//Формирование параметров для вставки файлов
If MainForm.Directory.Directory[Length(MainForm.Directory.Directory)]<>'\' then
begin
StrPaste:=MainForm.Directory.Directory+'\';
end
else
begin
StrPaste:=MainForm.Directory.Directory;
end;
//Проверка всего списка вставляемых файлов на перезапись
For i:=0 to MainForm.TempCopyMove.Items.Count-1 do
CheckForOverwrite(MainForm.TempCopyMove.Items[i],i);
For i:=0 to MainForm.TempCopyMove.Items.Count-1 do
begin
Str:=MainForm.TempCopyMove.Items[i];
//Определение действия над файлами копировать или перемещать
If FlagMoveFile then
begin
if Str[Length(str)]<>'*' then
MoveFile(MainForm.TempCopyMove.Items[i],StrPaste);
end
else
begin
if Str[Length(str)]<>'*' then
CopyFile(MainForm.TempCopyMove.Items[i],StrPaste);
end;
If Str[Length(str)]='*' then
begin
Str[Length(str)]:=#0;
MainForm.TempCopyMove.Items[i]:=Str;
end;
end;
MainForm.FileList.Update;
If FlagMoveFile then
begin
FlagMoveFile:=False;
MainForm.TempCopyMove.Clear;
end;
end;
Function CreateStringForTemp(i:integer):string;
//Создание строки для временного списка
Var
Str:string;
begin
Str:=MainForm.Directory.Directory;
If Str[Length(Str)]<>'\' then
begin
Str:=Str+'\';
end;
Str:=Str+MainForm.FileList.Items[i];
CreateStringForTemp:=Str;
end;
Procedure CopyPathFileInTemp;
//Создание временного списка файлов
Var
i:integer;
begin
ColFilesIn_TempCopyMove:=0;
MainForm.TempCopyMove.Clear;
for i:=0 to ColAllFiles-1 do
begin
if MainForm.FileList.Selected[i] then
begin
ColFilesIn_TempCopyMove:=ColFilesIn_TempCopyMove+1;
If FlagMoveFile then
begin
MainForm.TempCopyMove.Items.Add(CreateStringForTemp(i));
MainForm.FileList.Items[i]:='';
end
else
begin
MainForm.TempCopyMove.Items.Add(CreateStringForTemp(i));
end;
end;
end;
end;
Procedure SetUpComponents;
begin
MainForm.StatusBar.Panels[0].Width:=MainForm.Directory.Width;
end;
Procedure ReadIniOptions;
//Чтение параметров из ини файла
var tmpinteger:integer;
begin
with OptionsForm do
begin
AskOnExit.Checked:=MCIni.ReadBool('Options','AskOnExit',True);
CStatusBar.Checked:=MCIni.ReadBool('Options','StatusBar',True);
tmpinteger:=MCIni.ReadInteger('Options','FileListColumns',1);
Case tmpinteger of
1 : LFileList.Caption:=FL1;
2 : LFileList.Caption:=FL2;
3 : LFileList.Caption:=FL3;
end; //Case
end;
end;
Procedure WriteIniOptions;
// Запись параметров в ини файл
begin
with MCIni do
begin
WriteBool('Options','AskOnExit',OptionsForm.AskOnExit.Checked);
WriteBool('Options','StatusBar',OptionsForm.CStatusBar.Checked);
Case MainForm.FileList.Columns of
1 : WriteInteger('Options','FileListColumns',1);
2 : WriteInteger('Options','FileListColumns',2);
3 : WriteInteger('Options','FileListColumns',3);
end; //case
end;
end;
Procedure UpdateMC;
// Обновление интерфейсных параметров программы
begin
if OptionsForm.AskOnExit.Checked then AskExit:=True
else AskExit:=False;
If OptionsForm.CStatusBar.Checked then MainForm.StatusBar.Visible:=True
else MainForm.StatusBar.Visible:=False;
if OptionsForm.LFilelist.Caption=FL1 then
begin
MainForm.FileList.Columns:=1;
MainForm.FileList.Update;
end;
if OptionsForm.LFilelist.Caption=FL2 then
begin
MainForm.FileList.Columns:=2;
MainForm.FileList.Update;
end;
if OptionsForm.LFilelist.Caption=FL3 then
begin
MainForm.FileList.Columns:=3;
MainForm.FileList.Update;
end;
end;
Procedure SetUpMainForm;
begin
//Подключение файла параметров
MCIni:=TIniFile.Create('MC.Ini');
ReadIniMainForm;
end;
Procedure ReadIniMainForm;
begin
with MainForm do
begin
Top:=MCIni.ReadInteger('ASWindow','Top',100);
Left:=MCIni.ReadInteger('ASWindow','Left',100);
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);