Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Obrazets.doc
Скачиваний:
21
Добавлен:
10.06.2015
Размер:
3.99 Mб
Скачать

4.7. Команда cls и echo

Для очистки экрана надо ввести команду CLS а для вывода строки необходимо ввести команду ECHO. Выведем строки а затем очистим экран.

Рисунок 12. Результат работы ECHO

Рисунок 13. Результат работы CLS

4.8. Команда del | erase

Для удаления необходимо ввести в командной строке DEL или ERASE и указать параметр в качестве которого выступит файл или каталог в котором будет производится удаления данных.

Рисунок 14. Результат выполнения DELбез ключей

Для удаления всех файлов в подкаталогах необходимо ввести в командной строке DEL или ERASE и указать параметр в качестве которого выступит файл или каталог в котором будет производится удаления данных, а так же указать ключи.

Рисунок 15. Результат работы DELс ключем /S

5. Литература

1. Турбо Паскаль 7.0. – К.: Торгово-издательское бюро BHV, 1996.-448 c. ISBN 5-7733-0008-7

2. Кормен, Т., Лейзерсон, Ч., Ривест, Р., Штайн, К. Глава 7. Быстрая сортировка // Алгоритмы: построение и анализ = Introduction to Algorithms / Под ред. И. В. Красикова. — 2-е изд. — М.: Вильямс, 2005. — С. 198-219. — ISBN 5-8459-0857-4

3. Ананий В. Левитин Глава 4. Метод декомпозиции: Быстрая сортировка // Алгоритмы: введение в разработку и анализ = Introduction to The Design and Analysis of Algorithms. — М.:«Вильямс», 2006.  С. 174-179. — ISBN 5-8459-0987-2

4. Хавьер Пашеку. Программирование в Borland Delphi 2006 для профессионалов = Delphi for .NET Developer’s Guide. — М.: Вильямс, 2006. — 944 с. — ISBN 0-672-32443-X

5. А. Н. Вальвачев, К. А. Сурков, Д. А. Сурков, Ю. М. Четырько. Программирование на языке Delphi. Учебное пособие. — 2005.

6. Вирт Н. Алгоритмы + структуры данных = программы. — М.: Мир, 1985. — С. 406.

7. Культин Н.Б. Delphi 6. Программирование на Object Pascal. — СПб.: БХВ-Петербург, 2001. — С. 528. — ISBN 5-94157-112-7

8. Моргун А. Н. Программирование на языке Паскаль (Pascal). Основы обработки структур данных. — М.: Диалектика, 2005. — С. 576. — ISBN 5-8459-0935-X

9.  ГОСТ 19.003-80. Схемы алгоритмов и программ. Обозначения условные графические

10. www.intuit.ru

Приложение А. Исходный код программы

program V_21;

{$APPTYPE CONSOLE}

uses

SysUtils,

Classes,

DateUtils,

Windows,

RegExpr,

dm_sort in 'dm_sort.pas' {DataModule1: TDataModule};

type Attributs = record

rd : char;

hid : char;

sys : char;

arch : char;

dir : string;

ind : char;

end;

label g1;

const

// Некоторые стандартные цвета

YellowOnBlue = FOREGROUND_GREEN or FOREGROUND_RED or

FOREGROUND_INTENSITY or BACKGROUND_BLUE;

WhiteOnBlue = FOREGROUND_BLUE or FOREGROUND_GREEN or

FOREGROUND_RED or FOREGROUND_INTENSITY or

BACKGROUND_BLUE;

RedOnWhite = FOREGROUND_RED or FOREGROUND_INTENSITY or

BACKGROUND_RED or BACKGROUND_GREEN or BACKGROUND_BLUE

or BACKGROUND_INTENSITY;

WhiteOnRed = BACKGROUND_RED or BACKGROUND_INTENSITY or

FOREGROUND_RED or FOREGROUND_GREEN or FOREGROUND_BLUE

or FOREGROUND_INTENSITY;

var

rddd : Attributs;

tl : string;

i : integer;

help : string;

curpath: string;

podcur : string;

f: File;

f1 : TextFile;

rg, rg2 : TRegExpr;

attr_fn : string;

substrr : string;

flag : integer;

SR: TSearchRec;

SSizeDir : int64;

sum : Int64;

echo : Boolean;

output : Boolean;

strList : TStringList;

ConHandle: THandle; // Дескриптор консольного окна

Coord: TCoord; // Для хранения/установки позиции экрана

MaxX, MaxY: Word; // Для хранения максимальных размеров окна

CCI: TConsoleCursorInfo;

NOAW: Cardinal; // Для хранения результатов некоторых функций

ffd : TDataModule1;

attr, attr1 : integer;

command : string;

invcolor: Boolean;

filcol, pathcol : string;

filcount, pathcount : integer;

at_bol : boolean;

exist : Integer;

function Exists(path:string):Boolean;

var SR2 : TSearchRec;

begin

if FindFirst(path,faAnyFile,SR2) = 0

then Result := True

else Result := False;

end;

function GetFileNameWE(path:string):string;

var i : integer;

name : string;

res : string;

begin

Result := '';

name := '';

res := '';

for i := length(path) downto 1 do

begin

if path[i] <> '\'

then

begin

name := name + path[i];

end

else Break;

end;

name := trim(name);

for i := length(name) downto 1 do

begin

res := res + name[i];

end;

Result := res;

end;

function ExistsDel(path:string):integer;

var SR2 : TSearchRec;

begin

if FindFirst(path,faAnyFile,SR2) = 0

then

if (SR2.Attr and sysutils.faDirectory) = sysutils.faDirectory

then Result := 1

else Result := 2

else Result := 0;

end;

function ExistsDelA(path:string;name:string):Integer;

var

srr: TSearchRec;

ls : string;

begin

if FindFirst(path + '\*.*', faAnyFile, srr) = 0 then

repeat

if srr.Name = name

then

begin

if (srr.Attr and sysutils.faDirectory) = sysutils.faDirectory

then exist := 1

else exist := 2;

Break;

end

else

begin

ls := srr.Name;

if (((srr.Attr and SysUtils.faDirectory) = SysUtils.faDirectory) and not((ls = '.')or (ls = '..')))

then ExistsDelA(path+'\'+srr.Name, name);

end;

until FindNext(srr) <> 0;

FindClose(srr.FindHandle);

end;

Function String_Reverse(S : String): String;

Var

st : string;

Begin

Result := '';

st := '';

for i:= length(S) downto 1 do

begin

st := st + S[i];

end;

Result := st;

End;

function FindText_v1 (expr, strin : string):Boolean;

var rg3 : TRegExpr;

begin

rg3 := TRegExpr.Create;

rg3.Expression := expr;

rg3.Exec(strin);

if rg3.Match[0] <> ''

then Result := True

else Result := False;

end;

function SetTime(DateTime:TDateTime): boolean;

var

st: TSystemTime;

ZoneTime: TTimeZoneInformation;

begin

try

GetTimeZoneInformation(ZoneTime);

DateTime:=DateTime+ZoneTime.Bias/1440;

with st do

begin

DecodeDate(DateTime, wYear, wMonth, wDay);

DecodeTime(DateTime, wHour, wMinute, wSecond, wMilliseconds);

end;

Result:=SetSystemTime(st);

except

end;

end;

function GetDiskSize(disk: string):string;

var

FreeBytesAvailableToCaller: TLargeInteger;

FreeSize: TLargeInteger;

TotalSize: TLargeInteger;

begin

GetDiskFreeSpaceEx(PAnsiChar(disk),FreeBytesAvailableToCaller,Totalsize,@FreeSize);

result := 'Всего на диске '+disk+' '+IntToStr(Trunc(Totalsize/1000))+' Б Свободного места: '+inttostr(Trunc(FreeSize/1000))+' Б';

end;

function CreationTime (Times : _FILETIME): TDateTime;

var

LTime: TFileTime;

Systemtime: TSystemtime;

begin

FileTimeToLocalFileTime(Times, LTime);

FileTimeToSystemTime( LTime, SystemTime );

result := SystemTimeToDateTime( SystemTime);

end;

function GetConOutputHandle : THandle;

begin

Result := GetStdHandle(STD_OUTPUT_HANDLE);

end;

procedure WriteLogFile (str: string);

begin

AssignFile(f1,'C:\OUTPUT.txt');

{$I-} Append(f1);

if IOResult<>0 then

begin

{$I-}

Rewrite(f1);

{$I+}

if IOResult<>0 then// ошибка создания файла

begin

Exit;

end;

end;

WriteLn(f1,str);

CloseFile(f1);

end;

procedure Init;

begin

ConHandle := GetConOutputHandle;

Coord := GetLargestConsoleWindowSize(ConHandle);

MaxX := Coord.X;

MaxY := Coord.Y;

echo := True;

output := False;

flag := 0;

SetConsoleOutputCP(1251);

invcolor := false;

ffd := TDataModule1.Create(nil);

end;

procedure MyWriteln(const S: string);

var

NewStr: string;

begin

try

SetLength(NewStr, Length(S));

CharToOem(PChar(S), PChar(NewStr));

Writeln(NewStr);

except

end;

end;

function DecodeToOEM(const S: string):string;

var

NewStr: string;

begin

SetLength(NewStr, Length(S));

CharToOem(PChar(S), PChar(NewStr));

Result:= NewStr;

end;

procedure ShowCursor(Show: Bool);

begin

CCI.bVisible := Show;

SetConsoleCursorInfo(ConHandle, CCI);

end;

procedure GotoXY(X, Y: Word);

begin

Coord.X := X;

Coord.Y := Y;

SetConsoleCursorPosition(ConHandle, Coord);

end;

procedure Cls;

begin

Coord.X := 0;

Coord.Y := 0;

FillConsoleOutputCharacter(ConHandle, ' ', MaxX * MaxY, Coord, NOAW);

GotoXY(0, 0);

end;

function GetSize(Path:string):Int64; overload;

var

RS1, RS2: TSearchRec;

ls : string;

attr1 : Integer;

begin

if copy(Path, length(path),1) <> '\' then Path:= Path+'\';

if FindFirst(Path+'*.*',faAnyFile, RS1) = 0 Then

Repeat

ls := RS1.Name;

if (((RS1.Attr and SysUtils.faDirectory) = SysUtils.faDirectory) and not((ls = '.')or (ls = '..')))

then GetSize := GetSize (Path+RS1.Name)

else

begin

if not((ls = '.')or (ls = '..'))

then sum := sum + int64(RS1.FindData.nFileSizeLow) or (int64(RS1.FindData.nFileSizeHigh) shl 32);

end;

Until FindNext(RS1) <> 0;

Result := sum;

end;

procedure RemoveAll(path: string);

var

srr: TSearchRec;

name : string;

begin

if FindFirst(path + '\*.*', faAnyFile, srr) = 0 then

begin

repeat

if (srr.Attr and sysutils.faDirectory) <> sysutils.faDirectory then

begin

name := path + '\' + srr.name;

FileSetAttr(name,not(faReadOnly));

DeleteFile(PAnsiChar(name));

end

else

begin

if not ((srr.name = '.') or (srr.name = '..'))

then RemoveAll(path + '\' + srr.name);

end;

until

FindNext(srr) <> 0;

end;

FindClose(srr.FindHandle);

RemoveDirectory(PChar(path));

end;

procedure RemoveAllRA(path: string;ra:Integer);

var

srr: TSearchRec;

name : string;

begin

if FindFirst(path + '\*.*', faAnyFile, srr) = 0 then

begin

repeat

if (srr.Attr and sysutils.faDirectory) <> sysutils.faDirectory then

begin

name := path + '\' + srr.name;

if ra = 1 then FileSetAttr(name,not(faReadOnly));

DeleteFile(PAnsiChar(name));

end

else

begin

if not ((srr.name = '.') or (srr.name = '..'))

then RemoveAllRA(path + '\' + srr.name,ra);

end;

until

FindNext(srr) <> 0;

end;

FindClose(srr.FindHandle);

RemoveDirectory(PChar(path));

end;

procedure RemoveAllFRA(path: string; ra:Integer; nam:string; ss:integer);

var

srr: TSearchRec;

name : string;

Wr :Cardinal;

begin

if FindFirst(path + '\*.*', faAnyFile, srr) = 0 then

begin

repeat

if (srr.Attr and sysutils.faDirectory) <> sysutils.faDirectory then

begin

name := path + '\' + srr.name;

if ra = 1 then FileSetAttr(name,not(faReadOnly));

if not (nam = '') and (nam = srr.Name) then

begin

DeleteFile(PAnsiChar(name));

end;

end

else

begin

if not ((srr.name = '.') or (srr.name = '..'))

then

begin

if not (ss = 0) then

RemoveAllFRA(path + '\' + srr.name,ra,nam,ss);

end;

end;

until

FindNext(srr) <> 0;

end;

FindClose(srr.FindHandle);

end;

begin

Init;

sum := 0;

rg2 := TRegExpr.Create;

rg2.Expression := '[.][A-Za-z0-9]*$';

rg := TRegExpr.Create;

curpath := 'C:\>';

MyWriteln('WELCOM TO THE CMD-TEST V1');

MyWriteln('STUDENT: PLAKOSH A. V.');

MyWriteln('GROUP: 16P 2U IVT FZO');

MyWriteln('Нажмите <Enter> для начала работы с консолью');

g1: Readln;

if echo = True then Write(curpath)

else Write('');

Read(tl);

rg.Expression := 'HELP |INVERTCOLOR |ATTRIB |DATE |CD |DIR |TIME |CLS |ECHO |MKDIR |RD |TYPE |DEL |ERASE |SORT |OUTPUT ';

command := tl+' ';

rg.Exec(UpperCase(command));

if rg.Match[0] = '' then

begin

MyWriteln('Не правильно введена команда');

end;

if UpperCase(rg.Match[0]) = 'INVERTCOLOR ' then

begin

rg.Expression := '\/\?';

rg.Exec(tl);

if rg.Match[0] = '/?' then

begin

MyWriteln('INVERTCOLOR - Инвертирует цвета консоли');

goto g1;

end

else

begin

if invcolor = False

then

begin

Coord.X := 0; Coord.Y := 0;

FillConsoleOutputAttribute(ConHandle, 4+236, MaxX * MaxY, Coord, NOAW);

SetConsoleTextAttribute(ConHandle,4+236);

invcolor := true;

end

else

begin

Coord.X := 0; Coord.Y := 0;

FillConsoleOutputAttribute(ConHandle, 7+1*0, MaxX * MaxY, Coord, NOAW);

SetConsoleTextAttribute(ConHandle,7+1*0);

invcolor := False;

end;

end;

end;

if UpperCase(rg.Match[0]) = 'ATTRIB ' then

begin

rg.Expression := '\/\?';

rg.Exec(tl);

if rg.Match[0] = '/?' then

begin

MyWriteln('ATTRIB [+R|-R] [+A|-A ] [+S|-S] [+H|-H] [DISK:][PATH:][FILE_NAME:]'

+#13#10+'Задает атрибуты файлу либо по полному, либо по ркаткому пути');

goto g1;

end

else

begin

if Length(Trim(tl)) = Length(Trim('ATTRIB')) then

begin

Writeln(DecodeToOEM('R'):3,DecodeToOEM('H'):3,DecodeToOEM('S'):3,DecodeToOEM('A'):3,DecodeToOEM('I'):3,DecodeToOEM('TYPE'):7,DecodeToOEM('NAME'):25);

help := Copy(curpath,1,length(curpath)-1);

if FindFirst(help+'*.*',SysUtils.faAnyFile,SR) = 0 then

repeat

attr := SysUtils.faReadOnly;

if (SR.Attr and attr) = attr

then rddd.rd := 'r'

else rddd.rd := ' ';

attr := SysUtils.faDirectory;

if (SR.Attr and attr) = attr

then rddd.dir := '<DIR>'

else rddd.dir := '<FILE>';

attr := SysUtils.faHidden;

if (SR.Attr and attr) = attr

then rddd.hid := 'h'

else rddd.hid := ' ';

attr := SysUtils.faSysFile;

if (SR.Attr and attr) = attr

then rddd.sys := 's'

else rddd.sys := ' ';

attr := SysUtils.faSymLink;

if (SR.Attr and attr) = attr

then rddd.ind := 'i'

else rddd.ind := ' ';

attr := SysUtils.faArchive;

if (SR.Attr and attr) = attr

then rddd.arch := 'a'

else rddd.arch := ' ';

Writeln(DecodeToOEM(rddd.rd):3,DecodeToOEM(rddd.hid):3,DecodeToOEM(rddd.sys):3,DecodeToOEM(rddd.arch):3,DecodeToOEM(rddd.ind):3,DecodeToOEM(rddd.dir):7,DecodeToOEM(SR.Name):30);

until FindNext(SR) <> 0;

goto g1;

end;

rg.Expression := '[A-Za-z][:][\\A-Za-z0-9]*[.A-Za-z0-9]*';

rg.Exec(tl);

if rg.Match[0] <> '' then

begin

attr_fn := rg.Match[0];

if not Exists(attr_fn)

then

begin

MyWriteln('Объект не существует');

goto g1;

end;

at_bol := True;

for i := 0 to 3 do

begin

case i of

0: rg.Expression := '\/R+[\+\-]';

1: rg.Expression := '\/A+[\+\-]';

2: rg.Expression := '\/S+[\+\-]';

3: rg.Expression := '\/H+[\+\-]';

end;

rg.Exec(UpperCase(tl));

if rg.Match[0] <> '' then at_bol:= False;

help := rg.Match[0];

if Trim(help) = '' then Continue;

case help[2] of

'R': begin

if help[3] = '+'

then SetFileAttributes(PAnsiChar(attr_fn),faReadOnly)

else FileSetAttr(PAnsiChar(attr_fn),not(faReadOnly));

end;

'A': begin

if help[3] = '+'

then SetFileAttributes(PAnsiChar(attr_fn),faArchive)

else FileSetAttr(PAnsiChar(attr_fn),not(faArchive));

end;

'S': begin

if help[3] = '+'

then SetFileAttributes(PAnsiChar(attr_fn),faSysFile)

else FileSetAttr(PAnsiChar(attr_fn),not(faSysFile));

end;

'H': begin

if help[3] = '+'

then SetFileAttributes(PAnsiChar(attr_fn),faHidden)

else FileSetAttr(PAnsiChar(attr_fn),not(faHidden));

end;

end;

end;

if at_bol = true

then

begin

if not Exists(attr_fn)

then

begin

MyWriteln('Объект не существует');

goto g1;

end;

FindFirst(attr_fn,faAnyFile,SR);

attr := SysUtils.faReadOnly;

attr1 := SR.Attr;

if (attr1 and attr) = attr

then rddd.rd := 'r'

else rddd.rd := ' ';

attr := SysUtils.faDirectory;

attr1 := SR.Attr;

if (attr1 and attr) = attr

then rddd.dir := '<DIR>'

else rddd.dir := '<FILE>';

attr := SysUtils.faHidden;

attr1 := SR.Attr;

if (attr1 and attr) = attr

then rddd.hid := 'h'

else rddd.hid := ' ';

attr := SysUtils.faSysFile;

attr1 := SR.Attr;

if (attr1 and attr) = attr

then rddd.sys := 's'

else rddd.sys := ' ';

attr := SysUtils.faSymLink;

attr1 := SR.Attr;

if (attr1 and attr) = attr

then rddd.ind := 'i'

else rddd.ind := ' ';

attr := SysUtils.faArchive;

attr1 := SR.Attr;

if (attr1 and attr) = attr

then rddd.arch := 'a'

else rddd.arch := ' ';

Writeln(DecodeToOEM(rddd.rd):3,DecodeToOEM(rddd.hid):3,DecodeToOEM(rddd.sys):3,DecodeToOEM(rddd.arch):3,DecodeToOEM(rddd.ind):3,DecodeToOEM(rddd.dir):7,DecodeToOEM(ExtractFileName(attr_fn)):30);

end;

goto g1;

end

else

begin

rg.Expression := '[ ]+[ \\A-Za-z0-9]+[.A-Za-z0-9]+';

rg.Exec(trimleft(tl));

if rg.Match[0] <> ''

then

begin

rg2.Exec(rg.Match[0]);

if rg2.Match[0] <> ''

then

begin

attr_fn := Copy(curpath,1,length(curpath)-1);

if Trim(attr_fn[Length(attr_fn)]) <> '\'

then attr_fn :=attr_fn + TrimLeft(rg.Match[0])

else

begin

if trimleft(rg.Match[0][1]) <> '\'

then attr_fn :=attr_fn + trimleft(rg.Match[0])

else attr_fn :=copy(attr_fn,1,Length(attr_fn)-1) + trimleft(rg.Match[0]);

end;

if not Exists(attr_fn)

then

begin

MyWriteln('Объект не существует');

goto g1;

end;

at_bol:= True;

for i := 0 to 3 do

begin

case i of

0: rg.Expression := '\/R+[\+\-]';

1: rg.Expression := '\/A+[\+\-]';

2: rg.Expression := '\/S+[\+\-]';

3: rg.Expression := '\/H+[\+\-]';

end;

rg.Exec(UpperCase(tl));

if rg.Match[0] <> '' then at_bol:= False;

help := rg.Match[0];

if Trim(help) = '' then Continue;

case help[2] of

'R': begin

if help[3] = '+'

then SetFileAttributes(PAnsiChar(attr_fn),faReadOnly)

else FileSetAttr(PAnsiChar(attr_fn),not(faReadOnly));

end;

'A': begin

if help[3] = '+'

then SetFileAttributes(PAnsiChar(attr_fn),faArchive)

else FileSetAttr(PAnsiChar(attr_fn),not(faArchive));

end;

'S': begin

if help[3] = '+'

then SetFileAttributes(PAnsiChar(attr_fn),faSysFile)

else FileSetAttr(PAnsiChar(attr_fn),not(faSysFile));

end;

'H': begin

if help[3] = '+'

then SetFileAttributes(PAnsiChar(attr_fn),faHidden)

else FileSetAttr(PAnsiChar(attr_fn),not(faHidden));

end;

end;

end;

if at_bol = true

then

begin

if not Exists(attr_fn)

then

begin

MyWriteln('Объект не существует');

goto g1;

end;

FindFirst(attr_fn,faAnyFile,SR);

attr := SysUtils.faReadOnly;

attr1 := SR.Attr;

if (attr1 and attr) = attr

then rddd.rd := 'r'

else rddd.rd := ' ';

attr := SysUtils.faDirectory;

attr1 := SR.Attr;

if (attr1 and attr) = attr

then rddd.dir := '<DIR>'

else rddd.dir := '<FILE>';

attr := SysUtils.faHidden;

attr1 := SR.Attr;

if (attr1 and attr) = attr

then rddd.hid := 'h'

else rddd.hid := ' ';

attr := SysUtils.faSysFile;

attr1 := SR.Attr;

if (attr1 and attr) = attr

then rddd.sys := 's'

else rddd.sys := ' ';

attr := SysUtils.faSymLink;

attr1 := SR.Attr;

if (attr1 and attr) = attr

then rddd.ind := 'i'

else rddd.ind := ' ';

attr := SysUtils.faArchive;

attr1 := SR.Attr;

if (attr1 and attr) = attr

then rddd.arch := 'a'

else rddd.arch := ' ';

Writeln(DecodeToOEM(rddd.rd):3,DecodeToOEM(rddd.hid):3,DecodeToOEM(rddd.sys):3,DecodeToOEM(rddd.arch):3,DecodeToOEM(rddd.ind):3,DecodeToOEM(rddd.dir):7,DecodeToOEM(ExtractFileName(attr_fn)):30);

end;

goto g1;

end

else

begin

attr_fn := Copy(curpath,1,length(curpath)-1);

if Trim(attr_fn[Length(attr_fn)]) <> '\'

then attr_fn :=attr_fn + TrimLeft(rg.Match[0])

else

begin

if trimleft(rg.Match[0][1]) <> '\'

then attr_fn :=attr_fn + trimleft(rg.Match[0])

else attr_fn :=copy(attr_fn,1,Length(attr_fn)-1) + trimleft(rg.Match[0]);

end;

if not Exists(attr_fn)

then

begin

MyWriteln('Объект не существует');

goto g1;

end;

at_bol:= True;

for i := 0 to 3 do

begin

case i of

0: rg.Expression := '\/R+[\+\-]';

1: rg.Expression := '\/A+[\+\-]';

2: rg.Expression := '\/S+[\+\-]';

3: rg.Expression := '\/H+[\+\-]';

end;

rg.Exec(UpperCase(tl));

if rg.Match[0] <> '' then at_bol:= False;

help := rg.Match[0];

if Trim(help) = '' then Continue;

case help[2] of

'R': begin

if help[3] = '+'

then SetFileAttributes(PAnsiChar(attr_fn),faReadOnly)

else FileSetAttr(PAnsiChar(attr_fn),not(faReadOnly));

end;

'A': begin

if help[3] = '+'

then SetFileAttributes(PAnsiChar(attr_fn),faArchive)

else FileSetAttr(PAnsiChar(attr_fn),not(faArchive));

end;

'S': begin

if help[3] = '+'

then SetFileAttributes(PAnsiChar(attr_fn),faSysFile)

else FileSetAttr(PAnsiChar(attr_fn),not(faSysFile));

end;

'H': begin

if help[3] = '+'

then SetFileAttributes(PAnsiChar(attr_fn),faHidden)

else FileSetAttr(PAnsiChar(attr_fn),not(faHidden));

end;

end;

end;

if at_bol = true

then

begin

if not Exists(attr_fn)

then

begin

MyWriteln('Объект не существует');

goto g1;

end;

FindFirst(attr_fn,faAnyFile,SR);

attr := SysUtils.faReadOnly;

attr1 := SR.Attr;

if (attr1 and attr) = attr

then rddd.rd := 'r'

else rddd.rd := ' ';

attr := SysUtils.faDirectory;

attr1 := SR.Attr;

if (attr1 and attr) = attr

then rddd.dir := '<DIR>'

else rddd.dir := '<FILE>';

attr := SysUtils.faHidden;

attr1 := SR.Attr;

if (attr1 and attr) = attr

then rddd.hid := 'h'

else rddd.hid := ' ';

attr := SysUtils.faSysFile;

attr1 := SR.Attr;

if (attr1 and attr) = attr

then rddd.sys := 's'

else rddd.sys := ' ';

attr := SysUtils.faSymLink;

attr1 := SR.Attr;

if (attr1 and attr) = attr

then rddd.ind := 'i'

else rddd.ind := ' ';

attr := SysUtils.faArchive;

attr1 := SR.Attr;

if (attr1 and attr) = attr

then rddd.arch := 'a'

else rddd.arch := ' ';

Writeln(DecodeToOEM(rddd.rd):3,DecodeToOEM(rddd.hid):3,DecodeToOEM(rddd.sys):3,DecodeToOEM(rddd.arch):3,DecodeToOEM(rddd.ind):3,DecodeToOEM(rddd.dir):7,DecodeToOEM(ExtractFileName(attr_fn)):30);

end;

goto g1;

end;

end

else

begin

help := stringreplace(tl, 'ATTRIB ','',[rfIgnoreCase,rfReplaceAll]);

help := Trim(help);

attr_fn := Copy(curpath,1,length(curpath)-1);

if Trim(attr_fn[Length(attr_fn)]) <> '\'

then attr_fn :=attr_fn + TrimLeft(help)

else

begin

if trimleft(help[1]) <> '\'

then attr_fn :=attr_fn + trimleft(help)

else attr_fn :=copy(attr_fn,1,Length(attr_fn)-1) + trimleft(help);

end;

if not Exists(attr_fn)

then

begin

MyWriteln('Объект не существует');

goto g1;

end;

at_bol:= True;

for i := 0 to 3 do

begin

case i of

0: rg.Expression := '\/R+[\+\-]';

1: rg.Expression := '\/A+[\+\-]';

2: rg.Expression := '\/S+[\+\-]';

3: rg.Expression := '\/H+[\+\-]';

end;

rg.Exec(UpperCase(tl));

if rg.Match[0] <> '' then at_bol:= False;

help := rg.Match[0];

if Trim(help) = '' then Continue;

case help[2] of

'R': begin

if help[3] = '+'

then SetFileAttributes(PAnsiChar(attr_fn),faReadOnly)

else FileSetAttr(PAnsiChar(attr_fn),not(faReadOnly));

end;

'A': begin

if help[3] = '+'

then SetFileAttributes(PAnsiChar(attr_fn),faArchive)

else FileSetAttr(PAnsiChar(attr_fn),not(faArchive));

end;

'S': begin

if help[3] = '+'

then SetFileAttributes(PAnsiChar(attr_fn),faSysFile)

else FileSetAttr(PAnsiChar(attr_fn),not(faSysFile));

end;

'H': begin

if help[3] = '+'

then SetFileAttributes(PAnsiChar(attr_fn),faHidden)

else FileSetAttr(PAnsiChar(attr_fn),not(faHidden));

end;

end;

end;

if at_bol = true

then

begin

if not Exists(attr_fn)

then

begin

MyWriteln('Объект не существует');

goto g1;

end;

FindFirst(attr_fn,faAnyFile,SR);

attr := SysUtils.faReadOnly;

attr1 := SR.Attr;

if (attr1 and attr) = attr

then rddd.rd := 'r'

else rddd.rd := ' ';

attr := SysUtils.faDirectory;

attr1 := SR.Attr;

if (attr1 and attr) = attr

then rddd.dir := '<DIR>'

else rddd.dir := '<FILE>';

attr := SysUtils.faHidden;

attr1 := SR.Attr;

if (attr1 and attr) = attr

then rddd.hid := 'h'

else rddd.hid := ' ';

attr := SysUtils.faSysFile;

attr1 := SR.Attr;

if (attr1 and attr) = attr

then rddd.sys := 's'

else rddd.sys := ' ';

attr := SysUtils.faSymLink;

attr1 := SR.Attr;

if (attr1 and attr) = attr

then rddd.ind := 'i'

else rddd.ind := ' ';

attr := SysUtils.faArchive;

attr1 := SR.Attr;

if (attr1 and attr) = attr

then rddd.arch := 'a'

else rddd.arch := ' ';

Writeln(DecodeToOEM(rddd.rd):3,DecodeToOEM(rddd.hid):3,DecodeToOEM(rddd.sys):3,DecodeToOEM(rddd.arch):3,DecodeToOEM(rddd.ind):3,DecodeToOEM(rddd.dir):7,DecodeToOEM(ExtractFileName(attr_fn)):30);

end;

goto g1;

end;

end;

end;

goto g1;

end;

if UpperCase(rg.Match[0]) = 'HELP ' then

begin

rg.Expression := '\/\?';

rg.Exec(tl);

if rg.Match[0] = '/?' then

begin

MyWriteln('HELP'

+#13#10+'Выводит справку по командам');

goto g1;

end

else

begin

MyWriteln('[TYPE]'+' Позволяет просмотреть содержимое файла');

MyWriteln('[DATE]'+' Позволяет вывести текущую дату');

MyWriteln('[TIME]'+' Позволяет вывести текущее время');

MyWriteln('[MKDIR]'+' Позволяет созать каталог');

MyWriteln('[RD]'+' Позволяет удалить каталог');

MyWriteln('[CD]'+' Позволяет переключаться между каталогами');

MyWriteln('[ATTRIB]'+' Позволяет установить атрибуты файлу');

MyWriteln('[CLS]'+' Позволяет очистить экран');

MyWriteln('[SORT]'+' Производит сортировку файла, либо входной строки');

MyWriteln('[ECHO]'+' Позволяет переключаться между режимами отображения');

MyWriteln('[OUTPUT]'+' Позволяет создать командный файл');

MyWriteln('[DEL][ERASE]'+' Позволяет удалить файл');

MyWriteln('[DIR]'+' Позволяет просмотреть каталог');

MyWriteln('[INVERTCOLOR]'+' Позволяет переключаться между цветовыми режимами');

end;

goto g1;

end;

if UpperCase(rg.Match[0]) = 'DATE ' then

begin

rg.Expression := '\/\?';

rg.Exec(tl);

if rg.Match[0] = '/?' then

begin

MyWriteln('DATE'

+#13#10+'Выводит текущую системную дату в формате dd-mm-yyyy');

goto g1;

end

else

begin

MyWriteln(FormatDateTime('DD-MM-YYYY', NOW));

MyWriteln('Установить новую дату Y/N');

Readln;

Readln(tl);

if UpperCase(Trim(tl)) = 'Y'

then

begin

MyWriteln('Укажите новую системную дату');

Read(tl);

try

if SetTime(StrToDateTime(tl)+now)

then

begin

MyWriteln('Новая дата успешно установлена');

end

else

begin

MyWriteln('Не удалось установить новую дату');

end;

except

MyWriteln('Не удалось установить новую дату');

end;

end

else

begin

MyWriteln('Отмена команды. Для продолжения работы нажмите <ENTER>');

Read(tl);

MyWriteln('Перенаправление');

goto g1;

end;

end;

goto g1;

end;

if UpperCase(rg.Match[0]) = 'TIME ' then

begin

rg.Expression := '\/\?';

rg.Exec(tl);

if rg.Match[0] = '/?' then

begin

MyWriteln('TIME'

+#13#10+'Выводит текущее системное время в формате H:MM:SS');

goto g1;

end

else

begin

MyWriteln(FormatDateTime('HH:MM:SS', NOW));

MyWriteln('Установить новую дату Y/N');

Readln;

Readln(tl);

if UpperCase(Trim(tl)) = 'Y'

then

begin

MyWriteln('Укажите новое системное время');

Read(tl);

try

if SetTime(now+StrToDateTime(tl))

then

begin

MyWriteln('Новое время успешно установлено');

end

else

begin

MyWriteln('Не удалось установить новое время');

end;

except

MyWriteln('Не удалось установить новое время');

end;

end

else

begin

MyWriteln('Отмена команды. Для продолжения работы нажмите <ENTER>');

Read(tl);

MyWriteln('Перенаправление');

goto g1;

end;

end;

goto g1;

end;

if rg.Match[0] = 'OUTPUT' then

begin

rg.Expression := '\/\?';

rg.Exec(tl);

if rg.Match[0] = '/?' then

begin

MyWriteln('OUTPUT [ON|OFF]'

+#13#10+'VIVOD DANNIH V FIYL');

goto g1;

end

else

begin

rg.Expression := 'OFF';

rg.Exec(tl);

if rg.Match[0] <> ''

then output := False

else

begin

if length(Trim(tl)) > 6

then

begin

rg.Expression := 'ON';

rg.Exec(tl);

if rg.Match[0] <> ''

then

begin

output := True;

MyWriteln('OUTPUT ON');

end;

end

else

begin

output := True;

MyWriteln('OUTPUT ON');

end;

end;

end;

goto g1;

end;

if UpperCase(rg.Match[0]) = 'ECHO ' then

begin

rg.Expression := '\/\?';

rg.Exec(tl);

if rg.Match[0] = '/?' then

begin

MyWriteln('ECHO [SOOBSHENIE]'

+#13#10+'Задает отображение вывода, выводит сообщение');

goto g1;

end

else

begin

rg.Expression := ' OFF';

rg.Exec(UpperCase(tl));

if rg.Match[0] <> ''

then echo := False

else

begin

if length(Trim(tl)) > 4

then

begin

rg.Expression := ' ON';

rg.Exec(UpperCase(tl));

if rg.Match[0] = ''

then MyWriteln(Copy(TL,6,Length(TL)))

else

begin

MyWriteln('ECHO ON');

echo := True;

end;

end

else

begin

MyWriteln('ECHO ON');

echo := True;

end;

end;

end;

goto g1;

end;

if UpperCase(rg.Match[0]) = 'CLS ' then

begin

rg.Expression := '\/\?';

rg.Exec(tl);

if rg.Match[0] = '/?' then

begin

MyWriteln('CLS'

+#13#10+'Очистка экрана');

goto g1;

end

else

begin

Cls;

end;

goto g1;

end;

if UpperCase(rg.Match[0]) = 'SORT ' then

begin

rg.Expression := '\/\?';

rg.Exec(tl);

if rg.Match[0] = '/?' then

begin

MyWriteln('SORT [STROKA]'

+#13#10+'Сортировка');

goto g1;

end

else

begin

rg.Expression := '[A-Za-z][:][ \\A-Za-z0-9]*[.A-Za-z0-9]+';

rg.Exec(tl);

if rg.Match[0] <> ''

then

begin

strList := TStringList.Create;

try

strList.LoadFromFile(rg.Match[0]);

except

MyWriteln('Запрашиваемый файл либо каталог не существует');

end;

strList.Sort;

if FindText_v1(' /R',UpperCase(tl))

then

begin

for i := strList.Count-1 downto 0 do

begin

MyWriteln(strList.strings[i]);

end;

end

else

begin

for i := 0 to strList.Count-1 do

begin

MyWriteln(strList.strings[i]);

end;

end;

strList.Free;

end

else

begin

rg.Expression := '[ ]+[ \\A-Za-z0-9]+[.A-Za-z0-9]+';

rg.Exec(trimleft(tl));

if rg.Match[0] <> ''

then

begin

rg2.Exec(rg.Match[0]);

if rg2.Match[0] <> ''

then

begin

strList := TStringList.Create;

try

help := Copy(curpath,1,length(curpath)-1);

if help[Length(help)] <> '\'

then help :=help + rg.Match[0]

else

begin

if trimleft(rg.Match[0][1]) <> '\'

then help :=help + trimleft(rg.Match[0])

else help :=copy(help,1,Length(help)-1) + trimleft(rg.Match[0]);

end;

strList.LoadFromFile(help);

except

MyWriteln('Запрашиваемый файл либо каталог не существует');

end;

strList.Sort;

if FindText_v1(' /R',UpperCase(tl))

then

begin

for i := strList.Count-1 downto 0 do

begin

MyWriteln(strList.strings[i]);

end;

end

else

begin

for i := 0 to strList.Count-1 do

begin

MyWriteln(strList.strings[i]);

end;

end;

strList.Free;

end

else

begin

if Length(Trim(tl)) > 4 then

begin

strList := TStringList.Create;

if FindText_v1(' /R',UpperCase(tl))

then

begin

help := StringReplace(UpperCase(tl),' /R','',[rfReplaceAll]);

help := StringReplace(uppercase(help),'SORT ','',[rfReplaceAll]);

help := StringReplace(help,' ','',[rfReplaceAll]);

for i := 1 to Length(help) do

begin

strList.Add(help[i]);

end;

help := '';

strList.Sort;

for i := strList.Count-1 downto 0 do

begin

MyWriteln(strList.strings[i]);

end;

end

else

begin

help := StringReplace(uppercase(tl),'SORT ','',[rfReplaceAll]);

help := StringReplace(help,' ','',[rfReplaceAll]);

for i := 1 to Length(help) do

begin

strList.Add(help[i]);

end;

help := '';

strList.Sort;

for i := 0 to strList.Count-1 do

begin

MyWriteln(strList.strings[i]);

end;

end;

strList.Free;

end

else

begin

MyWriteln('Не введено параметров для сортировки');

end;

end;

end;

end;

goto g1;

end;

end;

if UpperCase (rg.Match[0]) = 'MKDIR ' then

begin

rg.Expression := '\/\?';

rg.Exec(tl);

if rg.Match[0] = '/?' then

begin

MyWriteln('MKDIR [DISK:][PATH:]'

+#13#10+'Создает дирректории даже в том случае если нет промежуточных дирректорий');

goto g1;

end

else

begin

rg.Expression := '[A-Za-z][:][ \\A-Za-z0-9]*';

rg.Exec(tl);

if rg.Match[0] <> ''

then

begin

ForceDirectories(rg.Match[0]);

end

else

begin

rg.Expression := '[ ]+[ \\A-Za-z0-9]+';

rg.Exec(trimleft(tl));

if rg.Match[0] <> ''

then

begin

help := copy(curpath,1,length(curpath)-1);

if help[Length(help)] <> '\'

then help:=help+trimleft(rg.Match[0])

else

begin

if (rg.Match[0][2])<>'\'

then

begin

help := '';

for i := 2 to Length((rg.Match[0])) do

begin

if ((rg.Match[0][i]) = ' ') OR (i = Length((rg.Match[0])))

then

begin

if i = Length(rg.Match[0])

then help := help + rg.Match[0][i];

help:=copy(curpath,1,length(curpath)-2)+'\'+help;

ForceDirectories(help);

help := '';

end

else help := help + (rg.Match[0][i]);

end;

goto g1;

end

else help:=copy(help,1,length(help)-1)+trimleft(rg.Match[0]);

end;

ForceDirectories(help);

goto g1;

end;

end;

end;

goto g1;

end;

if UpperCase (rg.Match[0]) = 'RD ' then

begin

rg.Expression := '\/\?';

rg.Exec(tl);

if rg.Match[0] = '/?' then

begin

MyWriteln('RD [DISK:][PATH:][/S][/Q]'

+#13#10+'/S выводит подтверждение на удалени каталогов'

+#13#10+'/Q отключает вывод подтверждения при включенном /S'

+#13#10+'Удаляет дирректории');

goto g1;

end

else

begin

rg.Expression := '[A-Za-z][:][ \\A-Za-z0-9]*';

rg.Exec(tl);

if rg.Match[0] <> ''

then

begin

if FindText_v1 (' /Q',UpperCase(tl))

then

begin

RemoveAll(trim(rg.Match[0]));

goto g1;

end

else

begin

if FindText_v1 (' /S',UpperCase(tl))

then

begin

MyWriteln('Вы действительно хотите удалить все входящие в этот'+#13#10+

' каталог файлы и папки Y/N');

Readln;

Readln(tl);

if Trim(UpperCase(tl)) = 'Y'

then

begin

RemoveAll(trim(rg.Match[0]));

MyWriteln('Для продолжения раоты нажмити <ENTER>');

goto g1;

end;

end

else

begin

RemoveAll(trim(rg.Match[0]));

goto g1;

end;

end;

end

else

begin

rg.Expression := '[ ]+[ \\A-Za-z0-9]+';

rg.Exec(trimleft(tl));

if rg.Match[0] <> ''

then

begin

help := copy(curpath,1,length(curpath)-1);

if help[Length(help)] <> '\'

then help:=help+trimleft(rg.Match[0])

else

begin

if (rg.Match[0][2])<>'\'

then

begin

help := '';

for i := 2 to Length((rg.Match[0])) do

begin

if ((rg.Match[0][i]) = ' ') OR (i = Length((rg.Match[0])))

then

begin

if i = Length(rg.Match[0])

then help := help + rg.Match[0][i];

help:=copy(curpath,1,length(curpath)-2)+'\'+help;

if FindText_v1 (' /Q',UpperCase(tl))

then

begin

RemoveAll(trim(help));

end

else

begin

if FindText_v1 (' /S',UpperCase(tl))

then

begin

MyWriteln('Вы действительно хотите удалить все входящие в этот'+#13#10+

' каталог файлы и папки Y/N');

Readln;

Readln(tl);

if Trim(UpperCase(tl)) = 'Y'

then

begin

RemoveAll(trim(help));

MyWriteln('Для продолжения раоты нажмити <ENTER>');

end;

end

else

begin

RemoveAll(trim(help));

end;

end;

help := '';

end

else help := help + (rg.Match[0][i]);

end;

goto g1;

end

else help:=copy(help,1,length(help)-1)+trimleft(rg.Match[0]);

end;

if FindText_v1 (' /Q',UpperCase(tl))

then

begin

RemoveAll(trim(help));

goto g1;

end

else

begin

if FindText_v1 (' /S',UpperCase(tl))

then

begin

MyWriteln('Вы действительно хотите удалить все входящие в этот'+#13#10+

' каталог файлы и папки Y/N');

Readln;

Readln(tl);

if Trim(UpperCase(tl)) = 'Y'

then

begin

RemoveAll(trim(help));

MyWriteln('Для продолжения раоты нажмити <ENTER>');

goto g1;

end;

end

else

begin

RemoveAll(trim(help));

goto g1;

end;

end;

goto g1;

end;

end;

end;

goto g1;

end;

if UpperCase (rg.Match[0]) = 'TYPE ' then

begin

help := '';

rg.Expression := '\/\?';

rg.Exec(tl);

if rg.Match[0] = '/?' then

begin

MyWriteln('TYPE [DISK:][PATH:][FILE:]'

+#13#10+'Открывает документ по полному или краткому пути');

goto g1;

end

else

begin

rg.Expression := '[A-Za-z][:][ \\A-Za-z0-9]*[.A-Za-z0-9]*';

rg.Exec(tl);

if rg.Match[0] <> ''

then

begin

strList := TStringList.Create;

try

strList.LoadFromFile(rg.Match[0]);

except

MyWriteln('Запрашиваемый файл либо каталог не существует');

end;

for i := 0 to strList.Count-1 do

begin

MyWriteln(strList.strings[i]);

end;

strList.Free;

end

else

begin

rg.Expression := '[ ]+[ \\A-Za-z0-9]+[.A-Za-z0-9]*';

rg.Exec(trimleft(tl));

if rg.Match[0] <> ''

then

begin

strList := TStringList.Create;

try

help := Copy(curpath,1,length(curpath)-1);

if help[Length(help)] <> '\'

then help :=help + rg.Match[0]

else

begin

if rg.Match[0][1] <> '\'

then help :=help + trimleft(rg.Match[0])

else help :=copy(help,1,Length(help)-1) + trimleft(rg.Match[0]);

end;

strList.LoadFromFile(help);

except

MyWriteln('Запрашиваемый файл либо каталог не существует');

end;

for i := 0 to strList.Count-1 do

begin

MyWriteln(strList.strings[i]);

end;

strList.Free;

end

else

begin

rg.Expression := '[ ]+[A-Za-z0-9]+[.\]+[A-Za-z0-9]+';

rg.Exec(trimleft(tl));

if rg.Match[0] <> ''

then

begin

strList := TStringList.Create;

try

help := Copy(curpath,1,length(curpath)-1);

if help[Length(help)] <> '\'

then help :=help + rg.Match[0]

else help :=copy(help,1,Length(help)-1) + trimleft(rg.Match[0]);

strList.LoadFromFile(help);

except

MyWriteln('Запрашиваемый файл либо каталог не существует');

end;

for i := 0 to strList.Count-1 do

begin

MyWriteln(strList.strings[i]);

end;

strList.Free;

end

else

begin

MyWriteln('Не указаны параметры');

goto g1;

end;

end;

end;

end;

goto g1;

end;

if UpperCase (rg.Match[0]) = 'DEL ' then

begin

rg.Expression := '\/\?';

rg.Exec(tl);

if rg.Match[0] = '/?' then

begin

MyWriteln('DEL [DISK:][PATH:][FILE:]'

+#13#10+'Удаляет файл'

+#13#10+'/P'+'запрос перед каждым удалением файла'

+#13#10+'/F'+'принудительное удаление файло только для чтения'

+#13#10+'/S'+'удаление файлов из всех подкаталогов'

+#13#10+'/Q'+'отключение запроса на удаление файла'

+#13#10+'/A:R'+'удалять файлы с параметром только для чтения'

+#13#10+'/A:H'+'удалять файлы с параметром скрытый'

+#13#10+'/A:S'+'удалять файлы с параметром системный'

+#13#10+'/A:A'+'удалять файлы с параметром фрхивный');

goto g1;

end

else

begin

rg.Expression := '[A-Za-z][:][\\A-Za-z0-9]*[.A-Za-z0-9]*';

rg.Exec(tl);

if rg.Match[0] <> ''

then

begin

exist := 0;

help := trimleft(rg.Match[0]);

ExistsDelA(stringreplace(trim(help),'\'+GetFileNameWE(trim(help)),'\',[]),GetFileNameWE(trim(help)));

case exist of

0: begin

MyWriteln('Объект не существует');

end;

1: begin//папка

if pos(' /P',uppercase(tl)) <> 0

then

begin

if pos(' /Q',uppercase(tl)) <> 0

then

begin

if pos(' /F',uppercase(tl)) <> 0

then

begin

RemoveAllRA(help,1);

ForceDirectories(trim(help));

end

else

begin

RemoveAllRA(help,0);

ForceDirectories(trim(help));

end;

goto g1;

end

else

begin

MyWriteln('Вы точно хотите удалить все папки и файлы? y/n');

Readln;

Readln(tl);

if trim(uppercase(tl)) = 'Y'

then

begin

if pos(' /F',uppercase(tl)) <> 0

then

begin

RemoveAllRA(help,1);

ForceDirectories(trim(help));

end

else

begin

RemoveAllRA(help,0);

ForceDirectories(trim(help));

end;

goto g1;

end

else goto g1;

end;

end

else

begin

if pos(' /F',uppercase(tl)) <> 0

then

begin

RemoveAllRA(help,1);

ForceDirectories(trim(help));

end

else

begin

RemoveAllRA(help,0);

ForceDirectories(trim(help));

end;

goto g1;

end;

end;

2: begin//ôàéë

podcur := tl;

if pos(' /P',uppercase(podcur)) <> 0

then

begin

if pos(' /Q',uppercase(podcur)) <> 0

then

begin

if pos(' /F',uppercase(podcur)) <> 0

then

begin

if pos(' /S',uppercase(podcur)) <> 0

then RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),1,GetFileNameWE(help),1)

else RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),1,GetFileNameWE(help),0);

end

else

begin

if pos(' /S',uppercase(tl)) <> 0

then RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),0,GetFileNameWE(help),1)

else RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),0,GetFileNameWE(help),0);

end;

goto g1;

end

else

begin

MyWriteln('Вы точно хотите удалить все папки и файлы? y/n');

Readln;

Readln(tl);

if trim(uppercase(tl)) = 'Y'

then

begin

if pos(' /F',uppercase(podcur)) <> 0

then

begin

if pos(' /S',uppercase(podcur)) <> 0

then RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),1,GetFileNameWE(help),1)

else RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),1,GetFileNameWE(help),0);

end

else

begin

if pos(' /S',uppercase(podcur)) <> 0

then RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),0,GetFileNameWE(help),1)

else RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),0,GetFileNameWE(help),0);

end;

goto g1;

end

else goto g1;

end;

end

else

begin

if pos(' /F',uppercase(podcur)) <> 0

then

begin

if pos(' /S',uppercase(podcur)) <> 0

then RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),1,GetFileNameWE(help),1)

else RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),1,GetFileNameWE(help),0);

end

else

begin

if pos(' /S',uppercase(podcur)) <> 0

then RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),0,GetFileNameWE(help),1)

else RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),0,GetFileNameWE(help),0);

end;

goto g1;

end;

end;

end;

goto g1;

end

else

begin

rg.Expression := '[ ]+[ \\A-Za-z0-9]+[.A-Za-z0-9]*';

rg.Exec(trimleft(tl));

if rg.Match[0] <> ''

then

begin

help := stringreplace(curpath,'>','',[rfReplaceAll]);

if help[Length(help)] <> '\'

then help :=help + rg.Match[0]

else

begin

if trimleft(rg.Match[0])[1] <> '\'

then help := help+ trimleft(rg.Match[0])

else help := copy(help,1,Length(help)-1) + trimleft(rg.Match[0])

end;

exist := 0;

ExistsDelA(stringreplace(trim(help),'\'+GetFileNameWE(trim(help)),'\',[]),GetFileNameWE(trim(help)));

case exist of

0: begin

MyWriteln('Объект не существует');

end;

1: begin

if pos(' /P',uppercase(tl)) <> 0

then

begin

if pos(' /Q',uppercase(tl)) <> 0

then

begin

if pos(' /F',uppercase(tl)) <> 0

then

begin

RemoveAllRA(trim(help),1);

ForceDirectories(trim(help));

end

else

begin

RemoveAllRA(trim(help),0);

ForceDirectories(trim(help));

end;

goto g1;

end

else

begin

MyWriteln('Вы точно хотите удалить все папки и файлы? y/n');

Readln;

Readln(tl);

if trim(uppercase(tl)) = 'Y'

then

begin

if pos(' /F',uppercase(tl)) <> 0

then

begin

RemoveAllRA(trim(help),1);

ForceDirectories(trim(help));

end

else

begin

RemoveAllRA(trim(help),0);

ForceDirectories(trim(help));

end;

goto g1;

end

else goto g1;

end;

end

else

begin

if pos(' /F',uppercase(tl)) <> 0

then

begin

RemoveAllRA(trim(help),1);

ForceDirectories(trim(help));

end

else

begin

RemoveAllRA(trim(help),0);

ForceDirectories(trim(help));

end;

goto g1;

end;

end;

2: begin

podcur := tl;

if pos(' /P',uppercase(podcur)) <> 0

then

begin

if pos(' /Q',uppercase(podcur)) <> 0

then

begin

if pos(' /F',uppercase(podcur)) <> 0

then

begin

if pos(' /S',uppercase(podcur)) <> 0

then RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),1,GetFileNameWE(help),1)

else RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),1,GetFileNameWE(help),0);

end

else

begin

if pos(' /S',uppercase(tl)) <> 0

then RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),0,GetFileNameWE(help),1)

else RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),0,GetFileNameWE(help),0);

end;

goto g1;

end

else

begin

MyWriteln('Вы точно хотите удалить все папки и файлы? y/n');

Readln;

Readln(tl);

if trim(uppercase(tl)) = 'Y'

then

begin

if pos(' /F',uppercase(podcur)) <> 0

then

begin

if pos(' /S',uppercase(podcur)) <> 0

then RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),1,GetFileNameWE(help),1)

else RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),1,GetFileNameWE(help),0);

end

else

begin

if pos(' /S',uppercase(podcur)) <> 0

then RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),0,GetFileNameWE(help),1)

else RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),0,GetFileNameWE(help),0);

end;

goto g1;

end

else goto g1;

end;

end

else

begin

if pos(' /F',uppercase(podcur)) <> 0

then

begin

if pos(' /S',uppercase(podcur)) <> 0

then RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),1,GetFileNameWE(help),1)

else RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),1,GetFileNameWE(help),0);

end

else

begin

if pos(' /S',uppercase(podcur)) <> 0

then RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),0,GetFileNameWE(help),1)

else RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),0,GetFileNameWE(help),0);

end;

goto g1;

end;

end;

end;

goto g1;

end

else

begin

rg.Expression := '[\[]{1}[\,\.A-Za-z0-9]*[\]]{1}';

rg.Exec(trimleft(tl));

if rg.Match[0]<>''

then

begin

end

else

begin

end;

goto g1;

end;

end;

end;

goto g1;

end;

if UpperCase (rg.Match[0]) = 'ERASE ' then

begin

rg.Expression := '\/\?';

rg.Exec(tl);

if rg.Match[0] = '/?' then

begin

MyWriteln('ERASE [DISK:][PATH:][FILE:]'

+#13#10+'Удаляет файл'

+#13#10+'/P'+'запрос перед каждым удалением файла'

+#13#10+'/F'+'принудительное удаление файло только для чтения'

+#13#10+'/S'+'удаление файлов из всех подкаталогов'

+#13#10+'/Q'+'отключение запроса на удаление файла'

+#13#10+'/A:R'+'удалять файлы с параметром только для чтения'

+#13#10+'/A:H'+'удалять файлы с параметром скрытый'

+#13#10+'/A:S'+'удалять файлы с параметром системный'

+#13#10+'/A:A'+'удалять файлы с параметром фрхивный');

goto g1;

end

else

begin

rg.Expression := '[A-Za-z][:][\\A-Za-z0-9]*[.A-Za-z0-9]*';

rg.Exec(tl);

if rg.Match[0] <> ''

then

begin

exist := 0;

help := trimleft(rg.Match[0]);

ExistsDelA(stringreplace(trim(help),'\'+GetFileNameWE(trim(help)),'\',[]),GetFileNameWE(trim(help)));

case exist of

0: begin

MyWriteln('Объект не существует');

end;

1: begin//папка

if pos(' /P',uppercase(tl)) <> 0

then

begin

if pos(' /Q',uppercase(tl)) <> 0

then

begin

if pos(' /F',uppercase(tl)) <> 0

then

begin

RemoveAllRA(help,1);

ForceDirectories(trim(help));

end

else

begin

RemoveAllRA(help,0);

ForceDirectories(trim(help));

end;

goto g1;

end

else

begin

MyWriteln('Вы точно хотите удалить все папки и файлы? y/n');

Readln;

Readln(tl);

if trim(uppercase(tl)) = 'Y'

then

begin

if pos(' /F',uppercase(tl)) <> 0

then

begin

RemoveAllRA(help,1);

ForceDirectories(trim(help));

end

else

begin

RemoveAllRA(help,0);

ForceDirectories(trim(help));

end;

goto g1;

end

else goto g1;

end;

end

else

begin

if pos(' /F',uppercase(tl)) <> 0

then

begin

RemoveAllRA(help,1);

ForceDirectories(trim(help));

end

else

begin

RemoveAllRA(help,0);

ForceDirectories(trim(help));

end;

goto g1;

end;

end;

2: begin//ôàéë

podcur := tl;

if pos(' /P',uppercase(podcur)) <> 0

then

begin

if pos(' /Q',uppercase(podcur)) <> 0

then

begin

if pos(' /F',uppercase(podcur)) <> 0

then

begin

if pos(' /S',uppercase(podcur)) <> 0

then RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),1,GetFileNameWE(help),1)

else RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),1,GetFileNameWE(help),0);

end

else

begin

if pos(' /S',uppercase(tl)) <> 0

then RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),0,GetFileNameWE(help),1)

else RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),0,GetFileNameWE(help),0);

end;

goto g1;

end

else

begin

MyWriteln('Вы точно хотите удалить все папки и файлы? y/n');

Readln;

Readln(tl);

if trim(uppercase(tl)) = 'Y'

then

begin

if pos(' /F',uppercase(podcur)) <> 0

then

begin

if pos(' /S',uppercase(podcur)) <> 0

then RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),1,GetFileNameWE(help),1)

else RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),1,GetFileNameWE(help),0);

end

else

begin

if pos(' /S',uppercase(podcur)) <> 0

then RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),0,GetFileNameWE(help),1)

else RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),0,GetFileNameWE(help),0);

end;

goto g1;

end

else goto g1;

end;

end

else

begin

if pos(' /F',uppercase(podcur)) <> 0

then

begin

if pos(' /S',uppercase(podcur)) <> 0

then RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),1,GetFileNameWE(help),1)

else RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),1,GetFileNameWE(help),0);

end

else

begin

if pos(' /S',uppercase(podcur)) <> 0

then RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),0,GetFileNameWE(help),1)

else RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),0,GetFileNameWE(help),0);

end;

goto g1;

end;

end;

end;

goto g1;

end

else

begin

rg.Expression := '[ ]+[ \\A-Za-z0-9]+[.A-Za-z0-9]*';

rg.Exec(trimleft(tl));

if rg.Match[0] <> ''

then

begin

help := stringreplace(curpath,'>','',[rfReplaceAll]);

if help[Length(help)] <> '\'

then help :=help + rg.Match[0]

else

begin

if trimleft(rg.Match[0])[1] <> '\'

then help := help+ trimleft(rg.Match[0])

else help := copy(help,1,Length(help)-1) + trimleft(rg.Match[0])

end;

exist := 0;

ExistsDelA(stringreplace(trim(help),'\'+GetFileNameWE(trim(help)),'\',[]),GetFileNameWE(trim(help)));

case exist of

0: begin

MyWriteln('Объект не существует');

end;

1: begin

if pos(' /P',uppercase(tl)) <> 0

then

begin

if pos(' /Q',uppercase(tl)) <> 0

then

begin

if pos(' /F',uppercase(tl)) <> 0

then

begin

RemoveAllRA(trim(help),1);

ForceDirectories(trim(help));

end

else

begin

RemoveAllRA(trim(help),0);

ForceDirectories(trim(help));

end;

goto g1;

end

else

begin

MyWriteln('Вы точно хотите удалить все папки и файлы? y/n');

Readln;

Readln(tl);

if trim(uppercase(tl)) = 'Y'

then

begin

if pos(' /F',uppercase(tl)) <> 0

then

begin

RemoveAllRA(trim(help),1);

ForceDirectories(trim(help));

end

else

begin

RemoveAllRA(trim(help),0);

ForceDirectories(trim(help));

end;

goto g1;

end

else goto g1;

end;

end

else

begin

if pos(' /F',uppercase(tl)) <> 0

then

begin

RemoveAllRA(trim(help),1);

ForceDirectories(trim(help));

end

else

begin

RemoveAllRA(trim(help),0);

ForceDirectories(trim(help));

end;

goto g1;

end;

end;

2: begin

podcur := tl;

if pos(' /P',uppercase(podcur)) <> 0

then

begin

if pos(' /Q',uppercase(podcur)) <> 0

then

begin

if pos(' /F',uppercase(podcur)) <> 0

then

begin

if pos(' /S',uppercase(podcur)) <> 0

then RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),1,GetFileNameWE(help),1)

else RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),1,GetFileNameWE(help),0);

end

else

begin

if pos(' /S',uppercase(tl)) <> 0

then RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),0,GetFileNameWE(help),1)

else RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),0,GetFileNameWE(help),0);

end;

goto g1;

end

else

begin

MyWriteln('Вы точно хотите удалить все папки и файлы? y/n');

Readln;

Readln(tl);

if trim(uppercase(tl)) = 'Y'

then

begin

if pos(' /F',uppercase(podcur)) <> 0

then

begin

if pos(' /S',uppercase(podcur)) <> 0

then RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),1,GetFileNameWE(help),1)

else RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),1,GetFileNameWE(help),0);

end

else

begin

if pos(' /S',uppercase(podcur)) <> 0

then RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),0,GetFileNameWE(help),1)

else RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),0,GetFileNameWE(help),0);

end;

goto g1;

end

else goto g1;

end;

end

else

begin

if pos(' /F',uppercase(podcur)) <> 0

then

begin

if pos(' /S',uppercase(podcur)) <> 0

then RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),1,GetFileNameWE(help),1)

else RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),1,GetFileNameWE(help),0);

end

else

begin

if pos(' /S',uppercase(podcur)) <> 0

then RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),0,GetFileNameWE(help),1)

else RemoveAllFRA(stringreplace(help,GetFileNameWE(help),'',[]),0,GetFileNameWE(help),0);

end;

goto g1;

end;

end;

end;

goto g1;

end

else

begin

rg.Expression := '[\[]{1}[\,\.A-Za-z0-9]*[\]]{1}';

rg.Exec(trimleft(tl));

if rg.Match[0]<>''

then

begin

end

else

begin

end;

goto g1;

end;

end;

end;

goto g1;

end;

if UpperCase (rg.Match[0]) = 'CD ' then

begin

rg.Expression := '\/\?';

rg.Exec(tl);

if rg.Match[0] = '/?' then

begin

MyWriteln('CD [DISK:][PATH]'

+#13#10+'Смена дирректории');

end

else

begin

if Length(Trim(tl)) = Length(Trim('CD')) then

begin

MyWriteln('Не указан каталог для смены');

goto g1;

end;

rg.Expression := '[A-Za-z][:][\\A-Za-z0-9]*';

rg.Exec(tl);

if rg.Match[0] <> ''

then

begin

if DirectoryExists(rg.Match[0])

then

begin

if rg.Match[0][Length(rg.Match[0])] <> '\'

then curpath := rg.Match[0]+'\>'

else curpath := rg.Match[0]+'>';

end

else

begin

MyWriteln('Данного каталога не существует, неправильно указан путь');

goto g1;

end;

goto g1;

end

else

begin

rg.Expression := '[ ]+[ \\A-Za-z0-9]+';

rg.Exec(trimleft(tl));

if rg.Match[0] <> ''

then

begin

help := '';

if rg.Match[0][Length(rg.Match[0])] <> '\'

then help := Copy(curpath,1,length(curpath)-1)+trimleft(rg.Match[0])

else help := Copy(curpath,1,length(curpath)-2)+trimleft(rg.Match[0]);

if DirectoryExists(help)

then

begin

if help[Length(help)] <> '\'

then curpath := help+'\>'

else curpath := help+'>';

end

else

begin

MyWriteln('Данного каталога не существует, неправильно указан путь');

goto g1;

end;

end

else

begin

if FindText_v1(' \[\.\.\]',tl)

then

begin

help := '';

if Length(curpath) = 4

then

begin

MyWriteln('Нельзя перейти на уровень выше от текущего корня');

goto g1;

end;

for i := Length (Copy(curpath,1,Length(curpath)-2)) downto 1 do

begin

if Copy(curpath,1,Length(curpath)-2)[i] = '\'

then

begin

help:= String_Reverse(help+Copy(curpath,1,Length(curpath)-2)[i]);

curpath:= StringReplace(curpath,help,'',[rfReplaceAll]);

goto g1;

end

else

begin

help := help + Copy(curpath,1,Length(curpath)-2)[i];

end;

end;

end;

end;

goto g1;

end;

end;

goto g1;

end;

if UpperCase (rg.Match[0]) = 'DIR ' then

begin

rg.Expression := '\/\?';

rg.Exec(tl);

if rg.Match[0] = '/?' then

begin

MyWriteln('DIR [DISK:] [PATH] [FILE NAME] [/A[[:[R][H][D][S][A]]]][/O[:[N][D][S][E][G]]]]'

+#13#10+'/NF показывать объем папок'

+#13#10+'/A:R показывать только для чтения'

+#13#10+'/A:H показывать только скрытые'

+#13#10+'/A:D показывать только каталоги'

+#13#10+'/A:S показывать только системные'

+#13#10+'/A:A показывать только архивные'

+#13#10+'/O:N сортировать по имени'

+#13#10+'/O:D сортировать по дате'

+#13#10+'/O:S сортировать по размеру'

+#13#10+'/O:E сортировать по расширению'

+#13#10+'/O:G сортировать по типу(каталоги вверх выводятся)'

+#13#10+'Просмотр содержимого каталога');

goto g1;

end

else

begin

rg.Expression := '[ ][A-Za-z][:][\\A-Za-z0-9]*';

rg.Exec(tl);

if rg.Match[0] = ''

then

begin

rg.Expression := '[ ]+[\\A-Za-z0-9]+';

rg.Exec(trimleft(tl));

if rg.Match[0] = ''

then

begin

help := StringReplace(curpath,'>','',[rfReplaceAll]);

if help[Length(help)] <> '\'

then help := help + '\';

if not DirectoryExists(help)

then

begin

MyWriteln('Данная директория не существует');

goto g1;

end;

end

else

begin

help := rg.Match[0];

help:= StringReplace(curpath,'\>','',[rfReplaceAll])+help;

help := StringReplace(help,' ','',[rfReplaceAll]);

if help[Length(help)] <> '\'

then help := help + '\';

if not DirectoryExists(help)

then

begin

MyWriteln('Данная директория не существует');

goto g1;

end;

end;

end

else

begin

help := trim(rg.Match[0]);

if help[Length(help)] <> '\'

then help := help + '\';

if not DirectoryExists(help)

then

begin

MyWriteln('Данная директория не существует');

goto g1;

end;

end;

ffd.vrtltbl1.Open;

ffd.vrtltbl1.Clear;

rg.Expression := '\/A:[-RHDSA]+';

rg.Exec(UpperCase(tl));

if rg.Match[0] <> ''

then

begin

if Length(rg.Match[0])>4

then

begin

flag := 0;

for i := 4 to Length(rg.Match[0]) do

begin

case rg.Match[0][i] of

'R':begin

if not (rg.Match[0][i-1] = '-')

then flag := flag + faReadOnly

else flag := flag -(faReadOnly);

end;

'H':begin

if not (rg.Match[0][i-1] = '-')

then flag := flag + faHidden

else flag := flag -(faHidden);

end;

'D':begin

if not (rg.Match[0][i-1] = '-')

then flag := flag + faDirectory

else flag := flag -(faDirectory);

end;

'S':begin

if not (rg.Match[0][i-1] = '-')

then flag := flag + faSysFile

else flag := flag -(faSysFile);

end;

'A':begin

if not (rg.Match[0][i-1] = '-')

then flag := flag + faArchive

else flag := flag -(faArchive);

end;

end;

end;

end

else

begin

case rg.Match[0][Length(rg.Match[0])] of

'R':begin

flag := SysUtils.faReadOnly;

end;

'H':begin

flag := SysUtils.faHidden;

end;

'D':begin

flag := SysUtils.faDirectory;

end;

'S':begin

flag := SysUtils.faSysFile;

end;

'A':begin

flag := SysUtils.faArchive;

end;

end;

end;

end

else flag := 0;

attr := 0;

attr := faAnyFile;

if FindFirst(help+'*.*', attr, SR) = 0 Then

Repeat

sum := 0;

rg2.Exec(Trim(rg.Match[0])+SR.Name);

if ((sr.Attr and SysUtils.faDirectory) = SysUtils.faDirectory) and ((SR.Name <> '.')or (SR.Name <> '..'))

then SSizeDir := GetSize(Trim(help)+SR.Name)

else SSizeDir := int64(SR.FindData.nFileSizeLow) or (int64(SR.FindData.nFileSizeHigh) shl 32);

if flag <> 0

then

begin

if (SR.Attr and flag) = flag

then

begin

if not ((SR.Name = '.')or (SR.Name = '..'))

then

begin

ffd.vrtltbl1.Append;

if (sr.Attr and SysUtils.faDirectory) = SysUtils.faDirectory

then ffd.vrtltbl1.FieldByName('KAT').Value := '<D>'

else ffd.vrtltbl1.FieldByName('KAT').Value := '<F>';

ffd.vrtltbl1.FieldByName('NAME').Value := SR.Name;

ffd.vrtltbl1.FieldByName('DATE').Value := CreationTime(SR.FindData.ftCreationTime);

ffd.vrtltbl1.FieldByName('SIZE').Value := SSizeDir/1000;

ffd.vrtltbl1.FieldByName('EXTEN').Value := ExtractFileExt(SR.Name);

ffd.vrtltbl1.FieldByName('TYPE').Value := SR.Attr;

ffd.vrtltbl1.Post;

end;

end;

end

else

begin

if not ((SR.Name = '.')or (SR.Name = '..'))

then

begin

ffd.vrtltbl1.Append;

if (sr.Attr and SysUtils.faDirectory) = SysUtils.faDirectory

then ffd.vrtltbl1.FieldByName('KAT').Value := '<D>'

else ffd.vrtltbl1.FieldByName('KAT').Value := '<F>';

ffd.vrtltbl1.FieldByName('NAME').Value := SR.Name;

ffd.vrtltbl1.FieldByName('DATE').Value := CreationTime(SR.FindData.ftCreationTime);

ffd.vrtltbl1.FieldByName('SIZE').Value := SSizeDir/1000;

ffd.vrtltbl1.FieldByName('EXTEN').Value := ExtractFileExt(SR.Name);

ffd.vrtltbl1.FieldByName('TYPE').Value := SR.Attr;

ffd.vrtltbl1.Post;

end;

end;

Until FindNext(SR) <> 0;

rg.Expression := '\/O:[NDSEG]{1}';

rg.Exec(UpperCase(tl));

if rg.Match[0] <> ''

then

begin

case rg.Match[0][Length(rg.Match[0])] of

'N':begin

ffd.vrtltbl1.IndexFieldNames := 'NAME';

end;

'D':begin

ffd.vrtltbl1.IndexFieldNames := 'DATE';

end;

'S':begin

ffd.vrtltbl1.IndexFieldNames := 'SIZE';

end;

'E':begin

ffd.vrtltbl1.IndexFieldNames := 'EXTEN';

end;

'G':begin

ffd.vrtltbl1.IndexFieldNames := 'EXTEN';

end;

end;

end;

pathcol := '0';

filcol := '0';

filcount := 0;

pathcount := 0;

ffd.vrtltbl1.First;

for i := 0 to ffd.vrtltbl1.RecordCount - 1 do

begin

if (ffd.vrtltbl1.FieldbyName('TYPE').AsInteger and SysUtils.faDirectory) = SysUtils.faDirectory

then

begin

pathcol := inttostr(strtoint64(pathcol)+ffd.vrtltbl1.FieldbyName('SIZE').AsInteger);

Inc(pathcount);

end

else

begin

filcol := inttostr(strtoint64(filcol)+ffd.vrtltbl1.FieldbyName('SIZE').AsInteger);

Inc(filcount);

end;

Writeln(formatdatetime('DD-MM-YYYY HH:MM',ffd.vrtltbl1.FieldbyName('DATE').AsDateTime):20,inttostr(ffd.vrtltbl1.FieldByName('SIZE').asInteger):15,ffd.vrtltbl1.FieldByName('KAT').asString:5,DecodeToOEM(ffd.vrtltbl1.FieldByName('NAME').asString):30);

ffd.vrtltbl1.Next;

end;

MyWriteln('----------------------------------------------------------------------');

Writeln(DecodeToOEM('Количесто папок'):19,inttostr(pathcount):6,DecodeToOEM('Общий размер папок'):22,pathcol:15,DecodeToOEM('Б'):2);

Writeln(DecodeToOEM('Количество файлов'):19,inttostr(filcount):6,DecodeToOEM('Общий размер файлов'):22,filcol:15,DecodeToOEM('Б'):2);

Writeln;

MyWriteln(GetDiskSize(copy(help,1,2)));

end;

goto g1;

end;

goto g1;

end.

125

Соседние файлы в предмете [НЕСОРТИРОВАННОЕ]