LinuxForum.Fans
Тема

Реализация команд ksh на Pascal

Автор: u____________16 44 сообщений 7578 просмотров 🔒 закрыта
#350289

Всем доброго времени суток!очень нужна ваша помощь...мне интересно как реализовать работу с файлом (Создание(touch),удаление(rm),копирование(cp)) на паскале.Не подскажите как будут выглядеть процедуры?Помогите кто-нибудь, пожалуйста....
Имеется код с другими командами,могу отправить в лс,если нужно.

#350298

Вроде да...но у меня есть код с другими командами и мне нужно дописать процедуры работы с файлами..а не получается:(не поможете?
Вот код(паскаль):

Показать
text
Program unix_com;

Uses Dos;

Var comu:string;

s_or_f:text;

k:integer;

Function Unix_num (comu:string):integer;

const inp:array[1..9] of string[6] = (

'ls', 'dircmp', 'tr', 'comm', 'rmdir', 'cat', 'mv', 'man', 'exit');

var f:boolean;

i:integer;

Begin f:=False;

for i:=1 to 9 do

if (Copy(comu,1,Pos(' ',comu)-1)=inp[i]) or (comu=inp[i]) then

begin

f:=True;

Break;

end;

if not f then i:=11;

Unix_num:=i;

End;

Procedure Reout(var comu:string);

var Dev:string;

Flag:boolean;

Begin

Dev:='con';

Flag:=False;

if Pos ('>',comu) <> 0 then

begin

if Pos ('>>',comu) <> 0 then

begin

Delete (comu,Pos('>',comu),1);

Flag:=True;

end;

Dev:=Copy(comu,Pos('>',comu)+1, Length(comu)-Pos('>',comu)+1);

if Dev[1]='' then Delete(dev,1,1);

Delete(comu,Pos('>',comu), Length(comu)-Pos('>',comu)+1);

end;

Assign (s_or_f,dev);

if Flag then begin

{$I-} Append (s_or_f); {$I+}

if IOResult <> 0 then Rewrite (s_or_f);

end

else Rewrite(s_or_f);

End;

Function Error (comu:string):boolean;

Begin

Error:=False;

if Pos(' ',comu)=0 then

begin

WriteLn('Команда введена неверно!');

Error:=True;

end;

end;

Procedure Spaces (var s:string);

Begin

while Pos(' ',s)<>0 do Delete(s,Pos(' ',s),1);

while Pos(' ',s)=1 do Delete(s,1,1);

if s[Length(s)]=' ' then Delete (s,Length(s),1);

end;

Procedure Attr(at:byte);

const Ast:array[0..6] of string[5] = (

'-','R','H','S','V',' ','A');

A16:array[0..6] of byte = (

$00,$01,$02,$04,$08,$10,$20);

var i,i1,i2,i3,i4,i5:integer;

at1:byte;

ss:string[20];

Begin

for i:=0 to 1 do

for i:=1 to 2 do

for i:=2 to 3 do

for i:=3 to 4 do

for i:=4 to 5 do

for i:=5 to 6 do

begin

at1:=A16[i]+A16[i1]+A16[i2]+A16[i3]+A16[i4]+A16[i5];

if at1=at then

begin

ss:=Ast[i]+Ast[i1]+Ast[i2]+Ast[i3]+Ast[i4]+Ast[i5]+'';

write(s_or_f,ss);

Exit;

end;

end;

End;

Procedure Ls(comu: string);

var

Info: SearchRec;

dt: DateTime;

atr: byte;

keys, maska, cmd1: string;

o1, p1, a1, p, l, r: boolean;

nn, pos1: integer;

c0: string[1];

begin

atr := $3F;

Spaces(comu);

cmd1 := comu;

Delete(comu, 1, 3);

keys := '';

if Pos('-', comu) <> 0 then

begin

if Pos(' ', comu) = 0 then

pos1 := Length(comu)

else

pos1 := Pos(' ', comu);

keys := Copy(comu, 1, pos1);

Delete(comu, 1, pos1);

end;

if Pos('l', keys) <> 0 then

l := True

else

l := False;

if Pos('1', keys) <> 0 then

o1 := True

else

o1 := False;

if Pos('a', keys) <> 0 then

a1 := True

else

a1 := False;

if Pos('p', keys) <> 0 then

p1 := True

else

p1 := False;

if Pos('R', keys) <> 0 then

r := True

else

r := False;

if comu <> '' then

begin

if comu[Length(comu)] <> '\' then

maska := comu + '\*.*'

else

maska := comu + '*.*'

end

else

maska := '*.*';

FindFirst(maska, atr, Info);

if Info.Name = '.' then

FindNext(Info);

nn := 0;

repeat

if (DosError = 0) and a1 and (Info.Name ='..') then

begin

Write(s_or_f, Info.Name, ' ':(15 - Length(Info.Name)));

Inc(nn);

end;

if (DosError = 0) and (Info.Name <> '..') then

begin

if (Info.Attr = $10) and p1 then

Info.Name := Info.Name + '\';

if (Info.Attr = $02) or (Info.Attr = $10) then

begin

if a1 then

begin

Write(s_or_f, Info.Name, ' ':(15 - Length(Info.Name)));

Inc(nn);

end;

end

else

begin

Write(s_or_f, Info.Name, ' ':(15 - Length(Info.Name)));

Inc(nn);

end;

if l then

begin

Attr(Info.Attr);

UnpackTime(Info.Time, DT);

with DT do

begin

c0 := '';

if Day < 10 then

c0 := '0';

Write(s_or_f, c0, Day, '-');

c0 := '';

if Month < 10 then

c0 := '0';

Write(s_or_f, c0, Month, '-', Year);

c0 := '';

if Hour < 10 then

c0 := '0';

Write(s_or_f, ' ', c0, Hour, ':');

c0 := '';

if Min < 10 then

c0 := '0';

if o1 then

begin

WriteLn(s_or_f, c0, Min, ' ');

Inc(k);

end

else

begin

if nn = 3 then

begin

WriteLn(s_or_f, c0, Min, ' ');

nn := 0;

Inc(k);

end

else

Write(s_or_f, c0, Min, ' ')

end;

end;

end

else

begin

if o1 then

begin

WriteLn(s_or_f);

Inc(k);

end

else

if nn = 3 then

begin

WriteLn(s_or_f);

Inc(k);

nn := 0;

end;

end;

if (Info.Attr = $10) and r then

begin

WriteLn(s_or_f);

WriteLn(s_or_f, 'Просмотр каталога ', Info.Name);

Inc(k);

keys := '';

if p then

keys := ' |more';

if cmd1[Length(cmd1)] <> '\' then

begin

comu := cmd1;

Delete(comu, 1, 3);

if Pos('-', comu) <> 0 then

begin

if Pos(' ', comu) = 0 then

pos1 := Length(comu)

else

pos1 := Pos(' ', comu);

Delete(comu, 1, pos1);

end;

if comu = '' then

Ls(cmd1 + ' ' + Info.Name + keys)

else

Ls(cmd1 + '\' + Info.Name + keys);

end

else

Ls(cmd1 + Info.Name + keys);

end;

end;

FindNext(Info);

until DosError <> 0;

WriteLn(s_or_f);

Inc(k);

end;

Procedure Diff(comu: string);

var

fname1, fname2, f: string[80];

f1, f2: text;

s1, s2: string;

r, c: integer;

Function Compare(s1, s2: string): integer;

var

i, k: integer;

Begin

k := 0;

for i := 1 to Length(s2) do

begin

if i > Length(s1) then

Break;

if s2[i] = s1[i] then

k := k + 1;

end;

Compare := Round(100 * k / (Length(s2) +

Abs(Length(s1) - Length(s2))));

End;

Begin

Delete(comu, 1, 5);

fname1 := Copy(comu, 1, Pos(' ', comu) - 1);

Delete(comu, 1, Pos(' ', comu));

fname2 := comu;

Assign (f1, fname1); Reset (f1);

Assign (f2, fname2); Reset (f2);

r := 0;

while True do

begin

s1 := #0;

s2 := #0;

if not EOF(f1) then

ReadLn(f1, s1);

if not EOF(f2) then

ReadLn(f2, s2);

r := r + 1;

if s1 <> s2 then

begin

Write(r, ' ');

c := Compare(s1, s2);

if c > 80 theno

WriteLn('c')

else

WriteLn('d');

WriteLn('<', s1);

if c > 80 then

WriteLn('----')

else

WriteLn(r, ' a');

WriteLn('>', s2);

end;

if EOF(f1) and not EOF(f2) then

begin

WriteLn('Второй файл длинее первого!');

Break;

end;

if EOF(f2) and not EOF(f1) then

begin

WriteLn('Первый файл длинее второго!');

Break;

end;

if EOF(f1) and EOF(f2) then

Break;

end;

Close(f1);

Close(f2);

End;

Procedure Dircmp(cnp: string);

type

FileList = array [1..500] of string[12];

var

f1, f2: FileList;

Flag, w, p, d, s: boolean;

i, j, n1, n2, k, n, pos1, cod: integer;

dir1, dir2, keys: DirStr;

st: string;

Procedure Scan(dir: DirStr; var f: FileList; var n: integer);

var

Info: SearchRec;

begin

if dir[Length(dir)] = '\' then

dir := dir + '*.*'

else

dir := dir + '\*.*';

FindFirst(dir, $3F, Info);

if DosError <> 0 then

begin

WriteLn('Ошибка при задании каталога ', dir);

n := -1;

Exit;

end;

n := 0;

if Info.Name = '.' then

FindNext(Info);

repeat

if (DosError = 0) and (Info.Name <> '..') then

begin

if Info.Attr <> $10 then

begin

Inc(n);

f[n] := Info.Name;

end;

end;

FindNext(Info);

until DosError <> 0;

end;

begin

if Pos(' ', cnp) = 0 then

begin

WriteLn('Необходимо задать параметры!');

Exit;

end;

Delete(cnp, 1, 7);

n := 72;

keys := '';

if Pos('-', cnp) <> 0 then

begin

if Pos(' ', cnp) = 0 then

pos1 := Length(cnp)

else

pos1 := Pos(' ', cnp);

keys := Copy(cnp, 1, pos1);

Delete(keys, 1, 1);

Delete(cnp, 1, pos1);

end;

if Pos('d', keys) <> 0 then

begin

d := True;

Delete(keys, Pos('d', keys), 1);

end

else

d := False;

if Pos('s', keys) <> 0 then

begin

s := True;

Delete(keys, Pos('s', keys), 1);

end

else

s := False;

if Pos('w', keys) <> 0 then

begin

w := True;

Delete(keys, Pos('w', keys), 1);

while Pos(' ', keys) <> 0 do

Delete(keys, Pos(' ', keys), 1);

Val(keys, n, cod);

if cod <> 0 then

begin

WriteLn('Ошибка при задании длины строки!');

Exit;

end;

end

else

w := False;

dir1 := Copy(cnp, 1, Pos(' ', cnp) - 1);

Delete(cnp, 1, Pos(' ', cnp));

dir2 := cnp;

Scan(dir1, f1, n1);

if n1 = -1 then

Exit;

Scan(dir2, f2, n2);

if n2 = -1 then

Exit;

k := 0;

WriteLn(s_or_f, 'Файлы из первого каталога.');

for i := 1 to n1 do

begin

cod := 0;

for j := 1 to n2 do

if f1[i] = f2[j] then

cod := 1;

if cod = 0 then

begin

Inc(k);

WriteLn(s_or_f, f1[i]);

end;

end;

WriteLn(s_or_f, 'Файлы из второго каталога.');

for j := 1 to n2 do

begin

cod := 0;

for i := 1 to n1 do

if f2[j] = f1[i] then

cod := 1;

if cod = 0 then

begin

Inc(k);

WriteLn(s_or_f, f2[j]);

end;

end;

if s then

Exit;

WriteLn(s_or_f, 'Файлы общие для двух каталогов.');

for j := 1 to n2 do

begin

cod := 0;

for i := 1 to n1 do

if f2[j] = f1[i] then

cod := 1;

if cod = 1 then

begin

Inc(k);

WriteLn(s_or_f, f2[j]);

if d then

begin

st := dir1;

if st[Length(st)] = '\' then

st := st + f2[j]

else

st := st + '\' + f2[j];

st := st + ' ' + dir2;

if st[Length(st)] = '\' then

st := st + f2[j]

else

st := st + '\' + f2[j];

Diff(st);

end;

end;

end;

end;

Procedure Tr(comu: string);

var

p1, p2, s, s1: string;

k: integer;

begin

if Error(comu) then exit;

Delete(comu, 1, 3);

if Pos(' ', comu) = 0 then

begin

WriteLn('Недостаточно параметров!');

exit;

end;

p1 := Copy(comu, 1, Pos(' ', comu) - 1);

Delete(comu, 1, Pos(' ', comu));

p2 := comu; ReadLn(s);

while Pos(p1, s) <> 0 do

begin

k := Pos(p1, s); Delete(s, k, length(p1));

insert(p2, s, k);

end;

WriteLn(s_or_f, s);

end;

Procedure Comm(comu:string);

var

fname1, fname2, f: string[80];

f1, f2: text;

s1, s2: string;

par: string[10];

r1, r2, i: integer;

b, v1, v2, v3: boolean;

begin

if Pos(' ', comu) = 0 then

begin

WriteLn('Не указаны параметры команды!');

Exit;

end;

Delete(comu, 1, 5);

if Pos(' ', comu) = 0 then

begin

WriteLn('Недостаточно параметров!');

Exit;

end;

par := '';

if Pos('-', comu) <> 0 then

begin

par := Copy(comu, 2, Pos(' ', comu) - 2);

Delete(comu, 1, Pos(' ', comu));

end;

fname1 := Copy(comu, 1, Pos(' ', comu) - 1);

Delete(comu, 1, Pos(' ', comu));

fname2 := comu;

if fname1 = fname2 then

begin

WriteLn('Одинаковые имена файлов!');

Exit;

end;

{$I-}

Assign (f1, fname1); Reset (f1);

if IOResult <> 0 then

begin

Writeln ('Файл ', fname1, ' не найден!');

Exit;

end;

Assign (f2, fname2); Reset (f2);

{$I+}

if IOResult <> 0 then

begin

Writeln ('Файл ', fname2, ' не найден!');

Exit;

end;

r1 := 0; r2 := 0;

v1 := True;

v2 := True;

v3 := True;

if par = '1' then

v1 := False;

if par = '2' then

v2 := False;

if par = '3' then

v3 := False;

if par = '12' then

begin

v1 := False;

v2 := False;

end;

if par = '13' then

begin

v1 := False;

v3 := False;

end;

if par = '23' then

begin

v2 := False;

v3 := False;

end;

while True do

begin

Reset(f1);

for i := 1 to r1 do

ReadLn(f1, s1);

Inc(r1);

ReadLn(f1, s1);

Reset(f2);

b := False;

while not EOF(f2) do

begin

ReadLn(f2, s2);

if s1 = s2 then

begin

if v3 then

WriteLn(s_or_f, ' ', s1);

b := True;

Break;

end;

end;

if not b and v1 then

WriteLn(s_or_f, s1);

Reset(f2);

for i := 1 to r2 do

ReadLn(f2, s2);

Inc(r2);

ReadLn(f2, s2);

if EOF(f1) and EOF(f2) then

r1 := -1;

Reset(f1);

b := False;

while not EOF(f1) do

begin

ReadLn(f1, s1);

if s1 = s2 then

begin

b := True;

Break;

end;

end;

if not b and v2 then

WriteLn(s_or_f, ' ', s2);

if (r1 = -1) then

Break;

end;

Close(f1);

Close(f2);

end;

Procedure Rmcat(comu:string);

var

keys, f: string;

p, s: boolean;

n, i: integer;

BEGIN

if Error(comu) then exit;

Delete(comu, 1, 6);

keys := '';

if Pos('-', comu) <> 0 then

begin

keys := Copy(comu, 1, Pos(' ', comu));

Delete(comu, 1, Pos(' ', comu));

end;

if Pos('p', keys) <> 0 then

p := True

else

p := False;

if Pos('s', keys) <> 0 then

s := True

else

s := False;

f := comu;

{$I-} RmDir(f); {$I+}

if IOResult <> 0 then

begin

if not s then

WriteLn('Kаталог не существует или содержит файлы!');

Exit;

end;

WriteLn('Каталог ', f, ' удален.');

if p then

begin

if Pos('\', f) = 0 then

begin

GetDir(0, f);

ChDir('..');

end

else

begin

for i := 1 to Length(f) do

if f[i] = '\' then

n := i;

f[0] := Chr(n - 1);

end;

RmDir(f);

end;

End;

Procedure Cat(comu: string);

var

fname, fname2: string;

b: string;

f: text;

p, Flag: boolean;

k, f2: integer;

begin

if Error(comu) then Exit;

Delete(comu, 1, 4);

f2 := 0;

if Pos(' ', comu) = 0 then

fname := comu

else

begin

f2 := 1;

fname := Copy(comu, 1, Pos(' ', comu) - 1);

fname2 := Copy(comu, Pos(' ', comu) + 1, Length(comu) - Pos(' ', comu));

end;

if (fname = '-') or (fname = '') then

fname := 'con';

repeat

if f2 = 2 then

f2 := 0;

{$I-} Assign(f, fname); Reset(f); {$I+}

if IOResult <> 0 then

begin

WriteLn('Неверное имя файла!');

Exit;

end;

k := 0;

while not EOF(f) do

begin

ReadLn(f, b);

k := k + 1;

WriteLn(s_or_f, b);

end;

Close(f);

if f2 = 1 then

begin

fname := fname2;

f2 := 2;

end;

until f2 = 0;

end;

procedure Mv(comu:string);

{перенос файлов}

const rs = 512;

var

keys, fname1, fname2, f: string;

f1, f2: file;

nr, nw: word;

buf: array [1..rs] of char;

i, r: boolean;

yn: char;

Begin

if error(comu) then exit;

delete(comu, 1, 3);

if error(comu) then exit;

keys := '';

if pos('-', comu) <> 0 then

begin

keys := copy(comu, 1, pos(' ', comu));

delete(comu, 1, pos(' ', comu));

end;

if pos('i', keys) <> 0 then i := true

else i := false;

if pos('f', keys) <> 0 then r := true

else r := false;

fname1 := copy(comu, 1, pos(' ', comu) - 1);

delete(comu, 1, pos(' ', comu));

fname2 := comu;

if fname2[length(fname2)] = '\' then

begin

f := fname1;

while pos('\', f) <> 0 do

delete(f, 1, pos('\', f));

fname2 := fname2 + f;

end;

if fname1 = fname2 then

begin

writeln('Oдинаковые имена файла источника и приемника!');

exit;

end;

{$i-}

assign (f1, fname1); reset (f1, 1);

{$i+}

if ioresult <> 0 then

begin

writeln ('Файл - источник не найден!');

exit;

end;

assign (f2, fname2); {$i-} reset(f2); {$i+}

if (ioresult = 0) and (i or (not r)) then

begin

repeat

write('файл ', fname2, ' уже существует. перезаписать? (y/n) ');

readln(yn);

until upcase(yn) in ['y', 'n'];

if upcase(yn) = 'y' then

rewrite(f2, 1)

else

begin

close(f1); close(f2);

exit;

end;

end

else

rewrite(f2, 1);

repeat

blockread(f1, buf, rs, nr);

blockwrite(f2, buf, nr, nw);

until (nr = 0) or (nw <> nr);

close(f1); close(f2); erase(f1);

writeln ('Файл перенесен!');

End;

Procedure Man (comu:string);

Begin

Delete(comu,1,4);

case Unix_num (comu) of

1:begin

WriteLn('Справка по: LS');

WriteLn('Выводит список файлов в каталоге.');

WriteLn('Если каталог не указан, то исп. текущий каталог.');

WriteLn('Вызов:');

WriteLn('ls -1lRap каталог');

WriteLn('-R - рекурсивный просмотр');

WriteLn('-1 - вывод информации о каждом файле или каталоге с новой строки');

WriteLn('-l - расширенная информация о файлах');

WriteLn('-a - вывод информации о всех файлах и каталогах');

WriteLn('-p - вывод наклонной черты в конце имени каталога');

end;

2:begin

WriteLn('Справка по: DIRCMP');

WriteLn('Сравнение содержимого двух каталогов и');

WriteLn('вывод информации об отличиях.');

WriteLn('Вызов:');

WriteLn('dircmp каталог_1 каталог_2');

end;

3:begin

WriteLn('Справка по: TR');

WriteLn('Выполнение процедуры поиска и замены.');

WriteLn('Вызов:');

WriteLn('tr строка_1 строка_2');

end;

4:begin

WriteLn('Справка по: COMM');

WriteLn('Построчное сравнение содержимого 2-х текстовых файлов.');

WriteLn('Вывод производится в три столбца:');

WriteLn(' строки, содержащиеся в первом файле,');

WriteLn(' строки, содержащиеся во втором файле,');

WriteLn(' строки, содержащиеся в обоих файлах.');

WriteLn('Вызов:');

WriteLn('comm -123 файл_1 файл_2');

WriteLn('-1 - запрет вывода 1-ого столбца');

WriteLn('-2 - запрет вывода 2-ого столбца');

WriteLn('-3 - запрет вывода 3-его столбца');

WriteLn('-12 - вывод только 3-его столбца');

WriteLn('-13 - вывод только 2-ого столбца');

WriteLn('-23 - вывод только 1-ого столбца');

end;

5:begin

WriteLn('Справка по: RMDIR');

WriteLn('Удаление каталога. Удаляемый каталог не должен');

WriteLn('содержать файлов или подкаталогов.');

WriteLn('Вызов:');

WriteLn('rmdir -ps каталог');

WriteLn('-p - удалить указанный каталог и его род. каталог');

WriteLn('-s - запрет вывода сообщений об ошибках');

end;

6:begin

WriteLn('Справка по: CAT');

WriteLn('Вывод содержимого файлов.');

WriteLn('Вызов:');

WriteLn('cat имя_файла');

WriteLn('> - объединить несколько файлов в один,');

WriteLn('>> - присоединить файл к существующему,');

WriteLn('-s - запрет вывода пустых строк.');

end;

7:begin

WriteLn('Справка по: ÷ WriteLn('нескольких файлов в другой каталог.');

WriteLn('Вызов:');

WriteLn('mv -fi исходный_файл_1 конечный_файл_2');

WriteLn('-f - запрет запроса подтверждений,');

WriteLn('-i - требование запроса подтверждения.');

end;

8,10:begin

WriteLn('Описание команд ОС UNIX');

WriteLn('man имя_команды');

WriteLn('Список доступных команд: ');

WriteLn('ls, dircmp, tr, comm, rmdir, cat, mv');

WriteLn('Выход - команда exit');

end;

else WriteLn('Отсутствует описание этой команды.');

end;

End;

BEGIN

WriteLn('-> Эмулятор команд ОС UNIX <-');

Repeat

Write('$ ');

ReadLn(comu);

Spaces(comu);

Reout(comu);

case Unix_num (comu) of

1:Ls(comu);

2:Dircmp(comu);

3:Tr(comu);

4:Comm(comu);

5:Rmcat(comu);

6:Cat(comu);

7:Mv(comu);

8:Man(comu);

9:Break;

else WriteLn('Неизвестная команда!');

end;

Close(s_or_f);

Until False;

END.

Пользуйтесь тегами BBCode.

#350300

Юлия Крамар, я, к сожалению, Паскаль совсем не помню, ждите того, кто его знает. А пока оформите код отступами и выложите, например, на http://pastebin.kde.org/ , а то глаза сломать можно :) И опишите задачу подробнее.

#350310

Жаль:( Готово :)

Показать
text
Program unix_com;
Uses Dos;
Var comu:string;
      s_or_f:text;
      k:integer;

Function Unix_num (comu:string):integer; const inp:array[1..9] of string[6] = ('ls', 'dircmp', 'tr', 'comm', 'rmdir', 'cat', 'mv', 'man', 'exit'); var f:boolean; i:integer; Begin f:=False; for i:=1 to 9 do if (Copy(comu,1,Pos(' ',comu)-1)=inp[i]) or (comu=inp[i]) then begin f:=True; Break; end; if not f then i:=11; Unix_num:=i; End;

Procedure Reout(var comu:string); var Dev:string; Flag:boolean; Begin Dev:='con'; Flag:=False; if Pos ('>',comu) <> 0 then begin if Pos ('>>',comu) <> 0 then begin Delete (comu,Pos('>',comu),1); Flag:=True; end; Dev:=Copy(comu,Pos('>',comu)+1, Length(comu)-Pos('>',comu)+1); if Dev[1]='' then Delete(dev,1,1); Delete(comu,Pos('>',comu), Length(comu)-Pos('>',comu)+1); end; Assign (s_or_f,dev); if Flag then begin {$I-} Append (s_or_f); {$I+} if IOResult <> 0 then Rewrite (s_or_f); end else Rewrite(s_or_f); End;

Function Error (comu:string):boolean;

Begin Error:=False; if Pos(' ',comu)=0 then begin WriteLn('Команда введена неверно!'); Error:=True; end;

end;

Procedure Spaces (var s:string);

Begin while Pos(' ',s)<>0 do Delete(s,Pos(' ',s),1); while Pos(' ',s)=1 do Delete(s,1,1); if s[Length(s)]=' ' then Delete (s,Length(s),1); end;

Procedure Attr(at:byte); const Ast:array[0..6] of string[5] = ('-','R','H','S','V','','A'); A16:array[0..6] of byte = ($00,$01,$02,$04,$08,$10,$20); var i,i1,i2,i3,i4,i5:integer; at1:byte; ss:string[20]; Begin for i:=0 to 1 do for i:=1 to 2 do for i:=2 to 3 do for i:=3 to 4 do for i:=4 to 5 do for i:=5 to 6 do

begin at1:=A16[i]+A16[i1]+A16[i2]+A16[i3]+A16[i4]+A16[i5]; if at1=at then begin ss:=Ast[i]+Ast[i1]+Ast[i2]+Ast[i3]+Ast[i4]+Ast[i5]+''; write(s_or_f,ss); Exit; end; end; End;

Procedure Ls(comu: string); var Info: SearchRec; dt: DateTime; atr: byte; keys, maska, cmd1: string; o1, p1, a1, p, l, r: boolean; nn, pos1: integer; c0: string[1]; begin atr := $3F; Spaces(comu); cmd1 := comu; Delete(comu, 1, 3); keys := ''; if Pos('-', comu) <> 0 then begin if Pos(' ', comu) = 0 then pos1 := Length(comu) else pos1 := Pos(' ', comu); keys := Copy(comu, 1, pos1); Delete(comu, 1, pos1); end; if Pos('l', keys) <> 0 then l := True else l := False; if Pos('1', keys) <> 0 then o1 := True else o1 := False; if Pos('a', keys) <> 0 then a1 := True else a1 := False; if Pos('p', keys) <> 0 then p1 := True else p1 := False; if Pos('R', keys) <> 0 then r := True else r := False; if comu <> '' then begin if comu[Length(comu)] <> '\' then maska := comu + '\*.*' else maska := comu + '*.*' end else maska := '*.*'; FindFirst(maska, atr, Info); if Info.Name = '.' then FindNext(Info); nn := 0; repeat if (DosError = 0) and a1 and (Info.Name ='..') then begin Write(s_or_f, Info.Name, ' ':(15 - Length(Info.Name))); Inc(nn); end; if (DosError = 0) and (Info.Name <> '..') then begin if (Info.Attr = $10) and p1 then Info.Name := Info.Name + '\'; if (Info.Attr = $02) or (Info.Attr = $10) then begin if a1 then begin Write(s_or_f, Info.Name, ' ':(15 - Length(Info.Name))); Inc(nn); end; end else begin Write(s_or_f, Info.Name, ' ':(15 - Length(Info.Name))); Inc(nn); end; if l then begin Attr(Info.Attr); UnpackTime(Info.Time, DT); with DT do begin c0 := ''; if Day < 10 then c0 := '0'; Write(s_or_f, c0, Day, '-'); c0 := ''; if Month < 10 then c0 := '0'; Write(s_or_f, c0, Month, '-', Year); c0 := ''; if Hour < 10 then c0 := '0'; Write(s_or_f, ' ', c0, Hour, ':'); c0 := ''; if Min < 10 then c0 := '0'; if o1 then begin WriteLn(s_or_f, c0, Min, ' '); Inc(k); end else begin if nn = 3 then begin WriteLn(s_or_f, c0, Min, ' '); nn := 0; Inc(k); end else Write(s_or_f, c0, Min, ' ') end; end; end else begin if o1 then begin WriteLn(s_or_f); Inc(k); end else if nn = 3 then begin WriteLn(s_or_f); Inc(k); nn := 0; end; end; if (Info.Attr = $10) and r then begin WriteLn(s_or_f); WriteLn(s_or_f, 'Просмотр каталога ', Info.Name); Inc(k); keys := ''; if p then keys := ' |more'; if cmd1[Length(cmd1)] <> '\' then begin comu := cmd1; Delete(comu, 1, 3); if Pos('-', comu) <> 0 then begin if Pos(' ', comu) = 0 then pos1 := Length(comu) else pos1 := Pos(' ', comu); Delete(comu, 1, pos1); end; if comu = '' then Ls(cmd1 + ' ' + Info.Name + keys) else Ls(cmd1 + '\' + Info.Name + keys); end else Ls(cmd1 + Info.Name + keys); end; end; FindNext(Info); until DosError <> 0; WriteLn(s_or_f); Inc(k); end;

Procedure Diff(comu: string); var fname1, fname2, f: string[80]; f1, f2: text; s1, s2: string; r, c: integer; Function Compare(s1, s2: string): integer; var i, k: integer; Begin k := 0; for i := 1 to Length(s2) do begin if i > Length(s1) then Break; if s2[i] = s1[i] then k := k + 1; end; Compare := Round(100 * k / (Length(s2) + Abs(Length(s1) - Length(s2)))); End; Begin Delete(comu, 1, 5); fname1 := Copy(comu, 1, Pos(' ', comu) - 1); Delete(comu, 1, Pos(' ', comu)); fname2 := comu; Assign (f1, fname1); Reset (f1); Assign (f2, fname2); Reset (f2); r := 0; while True do begin s1 := #0; s2 := #0; if not EOF(f1) then ReadLn(f1, s1); if not EOF(f2) then ReadLn(f2, s2); r := r + 1; if s1 <> s2 then begin Write(r, ' '); c := Compare(s1, s2); if c > 80 then WriteLn('c') else WriteLn('d'); WriteLn('<', s1); if c > 80 then WriteLn('----') else WriteLn(r, ' a'); WriteLn('>', s2); end; if EOF(f1) and not EOF(f2) then begin WriteLn('Второй файл длиннее первого!'); Break; end; if EOF(f2) and not EOF(f1) then begin WriteLn('Первый файл длиннее второго!'); Break; end; if EOF(f1) and EOF(f2) then Break; end; Close(f1); Close(f2); End;

Procedure Dircmp(cnp: string); type FileList = array [1..500] of string[12]; var f1, f2: FileList; Flag, w, p, d, s: boolean; i, j,n1, n2, k, n, pos1, cod: integer; dir1, dir2, keys: DirStr; st: string;

Procedure Scan(dir: DirStr; var f: FileList; var n: integer); var Info: SearchRec; begin if dir[Length(dir)] = '\' then dir := dir + '*.*' else dir := dir + '\*.*'; FindFirst(dir, $3F, Info); if DosError <> 0 then begin WriteLn('Ошибка при задании каталога ', dir); n := -1; Exit; end; n := 0; if Info.Name = '.' then FindNext(Info); repeat if (DosError = 0) and (Info.Name <> '..') then begin if Info.Attr <> $10 then begin Inc(n); f[n] := Info.Name; end; end; FindNext(Info); until DosError <> 0; end; begin if Pos(' ', cnp) = 0 then begin WriteLn('Необходимо задать параметры!'); Exit; end; Delete(cnp, 1, 7); n := 72; keys := ''; if Pos('-', cnp) <> 0 then begin if Pos(' ', cnp) = 0 then pos1 := Length(cnp) else pos1 := Pos(' ', cnp); keys := Copy(cnp, 1, pos1); Delete(keys, 1, 1); Delete(cnp, 1, pos1); end; if Pos('d', keys) <> 0 then begin d := True; Delete(keys, Pos('d', keys), 1); end else d := False; if Pos('s', keys) <> 0 then begin s := True; Delete(keys, Pos('s', keys), 1); end else s := False; if Pos('w', keys) <> 0 then begin w := True; Delete(keys, Pos('w', keys), 1); while Pos(' ', keys) <> 0 do Delete(keys, Pos(' ', keys), 1); Val(keys, n, cod); if cod <> 0 then begin WriteLn('Ошибка при задании длины строки!'); Exit; end; end else w := False; dir1 := Copy(cnp, 1, Pos(' ', cnp) - 1); Delete(cnp, 1, Pos(' ', cnp)); dir2 := cnp; Scan(dir1, f1, n1); if n1 = -1 then Exit; Scan(dir2, f2, n2); if n2 = -1 then Exit; k := 0; WriteLn(s_or_f, 'Файлы из первого каталога.'); for i := 1 to n1 do begin cod := 0; for j := 1 to n2 do if f1[i] = f2[j] then cod := 1; if cod = 0 then begin Inc(k); WriteLn(s_or_f, f1[i]); end; end; WriteLn(s_or_f, 'Файлы из второго каталога.'); for j := 1 to n2 do begin cod := 0; for i := 1 to n1 do if f2[j] = f1[i] then cod := 1; if cod = 0 then begin Inc(k); WriteLn(s_or_f, f2[j]); end; end; if s then Exit; WriteLn(s_or_f, 'Файлы общие для двух каталогов.'); for j := 1 to n2 do begin cod := 0; for i := 1 to n1 do if f2[j] = f1[i] then cod := 1; if cod = 1 then begin Inc(k); WriteLn(s_or_f, f2[j]); if d then begin st := dir1; if st[Length(st)] = '\' then st := st + f2[j] else st := st + '\' + f2[j]; st := st + ' ' + dir2; if st[Length(st)] = '\' then st := st + f2[j] else st := st + '\' + f2[j]; Diff(st); end; end; end; end;

Procedure Tr(comu: string); var p1, p2, s, s1: string; k: integer; begin if Error(comu) then exit; Delete(comu, 1, 3); if Pos(' ', comu) = 0 then begin WriteLn('Недостаточно параметров!'); exit; end; p1 := Copy(comu, 1, Pos(' ', comu) - 1); Delete(comu, 1, Pos(' ', comu)); p2 := comu; ReadLn(s); while Pos(p1, s) <> 0 do begin k := Pos(p1, s); Delete(s, k, length(p1)); insert(p2, s, k); end; WriteLn(s_or_f, s); end;

Procedure Comm(comu:string); var fname1, fname2, f: string[80]; f1, f2: text; s1, s2: string; par: string[10]; r1, r2, i: integer; b, v1, v2, v3: boolean; begin if Pos(' ', comu) = 0 then begin WriteLn('Не указаны параметры команды!'); Exit; end; Delete(comu, 1, 5); if Pos(' ', comu) = 0 then begin WriteLn('Недостаточно параметров!'); Exit; end; par := ''; if Pos('-', comu) <> 0 then begin par := Copy(comu, 2, Pos(' ', comu) - 2); Delete(comu, 1, Pos(' ', comu)); end; fname1 := Copy(comu, 1, Pos(' ', comu) - 1); Delete(comu, 1, Pos(' ', comu)); fname2 := comu; if fname1 = fname2 then begin WriteLn('Одинаковые имена файлов!'); Exit; end; {$I-} Assign (f1, fname1); Reset (f1); if IOResult <> 0 then begin Writeln ('Файл ', fname1, ' не найден!'); Exit; end; Assign (f2, fname2); Reset (f2); {$I+} if IOResult <> 0 then begin Writeln ('Файл ', fname2, ' не найден!'); Exit; end; r1 := 0; r2 := 0; v1 := True; v2 := True; v3 := True; if par = '1' then v1 := False; if par = '2' then v2 := False; if par = '3' then v3 := False; if par = '12' then begin v1 := False; v2 := False; end; if par = '13' then begin v1 := False; v3 := False; end; if par = '23' then begin v2 := False; v3 := False; end; while True do begin Reset(f1); for i := 1 to r1 do ReadLn(f1, s1); Inc(r1); ReadLn(f1, s1); Reset(f2); b := False; while not EOF(f2) do begin ReadLn(f2, s2); if s1 = s2 then begin if v3 then WriteLn(s_or_f, ' ', s1); b := True; Break; end; end; if not b and v1 then WriteLn(s_or_f, s1); Reset(f2); for i := 1 to r2 do ReadLn(f2, s2); Inc(r2); ReadLn(f2, s2); if EOF(f1) and EOF(f2) then r1 := -1; Reset(f1); b := False; while not EOF(f1) do begin ReadLn(f1, s1); if s1 = s2 then begin b := True; Break; end; end; if not b and v2 then WriteLn(s_or_f, ' ', s2); if (r1 = -1) then Break; end; Close(f1);Close(f2); end;

Procedure Rmcat(comu:string); var keys, f: string; p, s: boolean; n, i: integer; BEGIN if Error(comu) then exit; Delete(comu, 1, 6); keys := ''; if Pos('-', comu) <> 0 then begin keys := Copy(comu, 1, Pos(' ', comu)); Delete(comu, 1, Pos(' ', comu)); end; if Pos('p', keys) <> 0 then p := True else p := False; if Pos('s', keys) <> 0 then s := True else s := False; f := comu; {$I-} RmDir(f); {$I+} if IOResult <> 0 then begin if not s then WriteLn('Каталог не существует или содержит файлы!'); Exit; end; WriteLn('Каталог ', f, ' удален.'); if p then begin if Pos('\', f) = 0 then begin GetDir(0, f); ChDir('..'); end else begin for i := 1 to Length(f) do if f[i] = '\' then n := i; f[0] := Chr(n - 1); end; RmDir(f); end; End;

Procedure Cat(comu: string); var fname, fname2: string; b: string; f: text; p, Flag: boolean; k, f2: integer; begin if Error(comu) then Exit; Delete(comu, 1, 4); f2 := 0; if Pos(' ', comu) = 0 then fname := comu else begin f2 := 1; fname := Copy(comu, 1, Pos(' ', comu) - 1); fname2 := Copy(comu, Pos(' ', comu) + 1, Length(comu) - Pos(' ', comu)); end; if (fname = '-') or (fname = '') then fname := 'con'; repeat if f2 = 2 then f2 := 0; {$I-} Assign(f, fname); Reset(f); {$I+} if IOResult <> 0 then begin WriteLn('Неверное имя файла!'); Exit; end; k := 0; while not EOF(f) do begin ReadLn(f, b); k := k + 1; WriteLn(s_or_f, b); end; Close(f); if f2 = 1 then begin fname := fname2; f2 := 2; end; until f2 = 0; end;

procedure Mv(comu:string); {перенос файлов} const rs = 512; var keys, fname1, fname2, f: string; f1, f2: file; nr, nw: word; buf: array [1..rs] of char; i, r: boolean; yn: char; Begin if error(comu) then exit; delete(comu, 1, 3); if error(comu) then exit; keys := ''; if pos('-', comu) <> 0 then begin keys := copy(comu, 1, pos(' ', comu)); delete(comu, 1, pos(' ', comu)); end; if pos('i', keys) <> 0 then i := true else i := false; if pos('f', keys) <> 0 then r := true else r := false; fname1 := copy(comu, 1, pos(' ', comu) - 1); delete(comu, 1, pos(' ', comu)); fname2 := comu; if fname2[length(fname2)] = '\' then begin f := fname1; while pos('\', f) <> 0 do delete(f, 1, pos('\', f)); fname2 := fname2 + f; end; if fname1 = fname2 then begin writeln('Одинаковые имена файла источника и приемника!'); exit; end; {$i-} assign (f1, fname1); reset (f1, 1); {$i+} if ioresult <> 0 then begin writeln ('Файл - источник не найден!'); exit; end; assign (f2, fname2); {$i-} reset(f2); {$i+} if (ioresult = 0) and (i or (not r)) then begin repeat write('файл ', fname2, ' уже существует. перезаписать? (y/n) '); readln(yn); until upcase(yn) in ['y', 'n']; if upcase(yn) = 'y' then rewrite(f2, 1) else begin close(f1); close(f2); exit; end; end else rewrite(f2, 1); repeat blockread(f1, buf, rs, nr); blockwrite(f2, buf, nr, nw); until (nr = 0) or (nw <> nr); close(f1); close(f2); erase(f1); writeln ('Файл перенесен!'); End;

Procedure Man (comu:string); Begin Delete(comu,1,4); case Unix_num (comu) of 1:begin WriteLn('Справка по: LS'); WriteLn('Выводит список файлов в каталоге.'); WriteLn('Если каталог не указан, то исп. текущий каталог.'); WriteLn('Вызов:'); WriteLn('ls -1lRap каталог'); WriteLn('-R - рекурсивный просмотр'); WriteLn('-1 - вывод информации о каждом файле или каталоге с новой строки'); WriteLn('-l - расширенная информация о файлах'); WriteLn('-a - вывод информации о всех файлах и каталогах'); WriteLn('-p - вывод наклонной черты в конце имени каталога'); end;

2:begin WriteLn('Справка по: DIRCMP'); WriteLn('Сравнение содержимого двух каталогов и'); WriteLn('вывод информации об отличиях.'); WriteLn('Вызов:'); WriteLn('dircmp каталог_1 каталог_2'); end;

3:begin WriteLn('Справка по: TR'); WriteLn('Выполнение процедуры поиска и замены.'); WriteLn('Вызов:'); WriteLn('tr строка_1 строка_2'); end;

4:begin WriteLn('Справка по: COMM'); WriteLn('Построчное сравнение содержимого 2-х текстовых файлов.'); WriteLn('Вывод производится в три столбца:'); WriteLn(' строки, содержащиеся в первом файле,'); WriteLn(' строки, содержащиеся во втором файле,'); WriteLn(' строки, содержащиеся в обоих файлах.'); WriteLn('Вызов:'); WriteLn('comm -123 файл_1 файл_2'); WriteLn('-1 - запрет вывода 1-ого столбца'); WriteLn('-2 - запрет вывода 2-ого столбца'); WriteLn('-3 - запрет вывода 3-его столбца'); WriteLn('-12 - вывод только 3-его столбца'); WriteLn('-13 - вывод только 2-ого столбца'); WriteLn('-23 - вывод только 1-ого столбца'); end;

5:begin WriteLn('Справка по: RMDIR'); WriteLn('Удаление каталога. Удаляемый каталог не должен'); WriteLn('содержать файлов или подкаталогов.'); WriteLn('Вызов:'); WriteLn('rmdir -ps каталог'); WriteLn('-p - удалить указанный каталог и его род. каталог'); WriteLn('-s - запрет вывода сообщений об ошибках'); end;

6:begin WriteLn('Справка по: CAT'); WriteLn('Вывод содержимого файлов.'); WriteLn('Вызов:'); WriteLn('cat имя_файла'); WriteLn('> - объединить несколько файлов в один,'); WriteLn('>> - присоединить файл к существующему,'); WriteLn('-s - запрет вывода пустых строк.'); end;

7:begin WriteLn('Справка по: MV'); WriteLn('Переименование файла или перемещение одного либо'); WriteLn('нескольких файлов в другой каталог.'); WriteLn('Вызов:'); WriteLn('mv -fi исходный_файл_1 конечный_файл_2'); WriteLn('-f - запрет запроса подтверждений,'); WriteLn('-i - требование запроса подтверждения.'); end;

8,10:begin WriteLn('Описание команд ОС UNIX'); WriteLn('man имя_команды'); WriteLn('Список доступных команд: '); WriteLn('ls, dircmp, tr, comm, rmdir, cat, mv'); WriteLn('Выход - команда exit'); end; else WriteLn('Отсутствует описание этой команды.'); end; End; BEGIN WriteLn('-> Эмулятор команд ОС UNIX <-'); Repeat Write('$ '); ReadLn(comu); Spaces(comu); Reout(comu); case Unix_num (comu) of 1:Ls(comu); 2:Dircmp(comu); 3:Tr(comu); 4:Comm(comu); 5:Rmcat(comu); 6:Cat(comu); 7:Mv(comu); 8:Man(comu); 9:Break; else WriteLn('Неизвестная команда!'); end; Close(s_or_f); Until False; END.

#350442

Юлия Крамар, Вам написали - оформите нормально код, никто за Вас это не сделает. А насиловать свой мозг чтением этого ужаса вряд ли будут желающие. С ходу вижу одно непонятное место:

"Юлия Крамар" написал:
text
Begin
for i:=0 to 1 do
  for i:=1 to 2 do
    for i:=2 to 3 do
      for i:=3 to 4 do
        for i:=4 to 5 do
          for i:=5 to 6 do

Это что за ужас такой? :)

#350496

Мне написали оформить код отступами! Я и скорректировала отступы...а как нормально в вашем понимании я не знаю. Что мне нужно сделать,чтобы код стал легко читаемым?

#350498

rizado, Я просто не знаю как надо...Вы подскажите,я сделаю...не вопрос

#350499

Это уже не про отступы, а про портянку циклов for, использующих одну и ту же переменную. К вашему сведению, я хоть и не программист, но знаю, что это грубейшая ошибка. И еще сдается мне, что так вы свою реализацию ksh не напишете...

#350503

Юлия Крамар, вам уже ответил yars насчёт одной и той же переменной в циклах.

#350509

rizado, yars, код писала не я!!! Код нашла на сайте!http://do.gendocs.ru/docs/index-236477.html И мне интересно в нем разобраться! я не профи программист,чтобы находить ошибки в чужих программах...
Потихоньку разбираюсь с имеющимся кодом. Интересно знать еще как реализуются процедуры работы с файлами,какие именно описала выше

#350513

Юлия Крамар, не нужно кричать и ставить столько восклицательных знаков :) .
ИМХО, проще с нуля написать, чем этот хинди изучать.

#350527

rizado, просто я в панике. ничего не получается.
Проще с нуля?...не про меня,увы... :(

#350555

Я не знаком с FreePascal, но вроде в документации вполне ясно написано что к чему

"Юлия Крамар" написал:
Создание(touch)

http://www.freepascal.org/docs-html/rtl/sysutils/filecreate.html

"Юлия Крамар" написал:
удаление(rm)

http://www.freepascal.org/docs-html/rtl/sysutils/deletefile.html

"Юлия Крамар" написал:
копирование(cp)

В случае с Lazarus, как я понял,
http://wiki.freepascal.org/Category:fileutil
http://wiki.freepascal.org/copyfile
А если "вбить в гугл" запрос из трех слов, можно найти вот это
http://freepascalanswers.wordpress.com/2012/01/18/copy-files/
Ну или файл 1 открыть для чтения, файл 2 для записи, циклом пройтись по файлу 1 и каждую его строку добавить в файл 2, после оба файла закрыть :)
Хотя в fpc наверняка есть какой-то более изящный путь для копирования файлов.

#350565

Юлия Крамар,
привет.
Раз интересно разобраться, давайте будем разбираться. Для начала неплохо было бы привести в рабочее состояние предмет "разборок", согласны? Сейчас он содержит значительное количество ошибок. Для этого придётся уловить идею того или иного фрагмента от автора. Давайте договорился так: вы спрашиваете о непонятном куске, поясняя, что по-вашему имелось в виду и что именно не понятно, а я поясню, годится?

Неплохо было бы уточнить используемую среду. Приведенный здесь исходный код изначально сделан для Turbo/Borland Pascal 6/7.

По поводу реализации команд. Изначально реализовано весьма малое количество возможностей команд, это и понятно, автору нужно было сделать курсовую работу и получить свою оценку. Каких возможностей нет? В первую очередь возможности задавать команде много файловых параметров (например, mv файл1 файл2 файл... каталог). Поэтому в возможностях команд нужно в первую очередь ориентироваться на встроенную в программу справку, если вы хотите просто расширить возможности показанного кода (и успешно сдать свою курсовую работу).

Приведённый код с точки зрения учебной дисциплины, в том или ином виде предполагающей оценивание умения программировать на паскале, содержит несколько явных поводов для снижения оценки, имейте это в виду. В первую очередь бросается в глаза, что тема о логических (булевых переменных) автором не освоена в полной мере, смотрите сами, достаточно часто у него встречается такой "индусский код":

text

if условие then
  переменная := true
else
  переменная := false;

По поводу команд:
touch: создание несуществующего файла либо обновление даты модификации существующего без изменения его содержимого.
cp: копирование файлов и каталогов. Для копирования файлов подойдут нетипизированные файлы (var f1, f2: file;) и blockread/blockwrite в цикле.
rm: удаление файлов/каталогов, см. Erase().

Итак, что скажете?

#350619
rizado написал:
А насиловать свой мозг чтением этого ужаса вряд ли будут желающие. С ходу вижу одно непонятное место:
[quote="Юлия Крамар"]
text
Begin
for i:=0 to 1 do
  for i:=1 to 2 do
    for i:=2 to 3 do
      for i:=3 to 4 do
        for i:=4 to 5 do
          for i:=5 to 6 do

Это что за ужас такой? :)[/quote]
Скажем так, это попытка реализации побитовой арифметики перебором -- ещё одна неосвоенная автором тема в части программирования на паскале:

text

var
  s_or_f:text;
...
Procedure Attr(at:byte);
const
  Ast: array[0..6] of string[5] = ('-','R','H','S','V','<DIR>','A');
  A16: array[0..6] of byte =      ($00,$01,$02,$04,$08,$10,    $20);
var
  i,i1,i2,i3,i4,i5:integer;
  at1:byte;
  ss:string[20];
begin
  for i:=0 to 1 do
    for i1:=1 to 2 do
      for i2:=2 to 3 do
        for i3:=3 to 4 do
          for i4:=4 to 5 do
            for i5:=5 to 6 do begin
              at1:=A16[i]+A16[i1]+A16[i2]+A16[i3]+A16[i4]+A16[i5];
              if at1=at then begin
                ss:=Ast[i]+Ast[i1]+Ast[i2]+Ast[i3]+Ast[i4]+Ast[i5]+'';
                write(s_or_f,ss);
                Exit;
              end;
            end;
end;
#350623
bormant написал:
В первую очередь бросается в глаза, что тема о логических (булевых переменных) автором не освоена в полной мере, смотрите сами, достаточно часто у него встречается такой "индусский код":
text

if условие then
  переменная := true
else
  переменная := false;

Да, здесь можно сделать проще, в одну строку:

text
переменная := (условие);

Кстати, Юлия Крамар, под какую ОС вы это пишете?

#350624

"rizado" написал:
переменная := (условие);
Скобки допустимы, но не нужны.
#350636
"bormant" написал:
Скобки допустимы, но не нужны.

Видел ситуации, когда из-за отсутствия скобок подобные операции неправильно обрабатывались. Потому и указал.

#350638

"rizado" написал:
Видел ситуации, когда из-за отсутствия скобок подобные операции неправильно обрабатывались.
Возможно я не слишком наблюдателен, либо одно из двух 8) А можно хотя бы один пример, когда приводило к ошибке отсутствие скобок вокруг всего выражения в правой части оператора присваивания (то есть сразу после ":=" и сразу перед ";"), скобки внутри выражения, задающие приоритет операций, не в счёт?
Войдите или зарегистрируйтесь, чтобы ответить.