Смекни!
smekni.com

Эмуляция командного процессора ОС UNIX в среде Windows 9x (стр. 4 из 4)

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('&bsol;', f) = 0 then

begin

GetDir(0, f);

ChDir('..');

end

else

begin

for i := 1 to Length(f) do

if f[i] = '&bsol;' 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)] = '&bsol;' then

begin

f := fname1;

while pos('&bsol;', f) <> 0 do

delete(f, 1, pos('&bsol;', 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('Справкапо: 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.