{* Администратор учета машинного времени *}

Unit ADMINISTRATOR;
Interface
Implementation
Begin
 writeln('

Программа учета перезагрузки.

');
End.

Program administrator;

Uses administrator.pas; {* Эту строку можно удалить *}
Uses Crt, Dos; {* Вызов внешних функций *}
Type {* Создание новых типов данных *}
  inf = (Boot, Reboot, Exit, Info, Init);
  fr = Record            dat : longint;
  d_s : byte; { Hi - dow, Lo - stat }
  End;
Const {* Константы *}
  copr : Array [1..26] Of byte =              (114, 149, 27, 193, 242, 122, 193, 193, 62, 161, 149, 107, 180, 141, 99,               160, 140, 106, 161, 149, 44, 173, 132, 116, 184, 133);
  msk : Array [1..3] Of byte = ($5A, $8D, $B5);
  mon : Array [1..12] Of String[8] =            ('января  ', 'февраля ', 'марта   ', 'апреля  ', 'мая     ', 'июня    ',             'июля    ', 'августа ', 'сентября', 'октября ', 'ноября  ', 'декабря ');
  wee : Array [0..6] Of String[11] =              ('воскресенье', 'понедельник', 'вторник    ', 'среда      ',               'четверг    ', 'пятница    ', 'суббота    ');
  wer : Array [0..6] Of String[11] =              ('воскресенье', 'понедельник', 'вторник', 'среду',               'четверг', 'пятницу', 'субботу');
Var {* Необходимые переменные *}
  f     : File Of fr;
  g     : text;
  next  : fr;
  i     : integer;
  j     : integer;
  fs    : longint;
  lp    : word;
  a     : word;
  lpk   : String;
  nstat : inf;
  dt    : DateTime;
  dev   : char;
  k     : byte;
  rg    : registers;
  buf   : Array [0..511] Of byte;
  load  : boolean;
Procedure cansel;
Begin
write(#10,#10,#13, '    "Adminstrator Of mashine-time using"    ');
rg.ah := $0E;
rg.bx := 0;
For i := 1 To 26 Do {* Увеличиваем i от 1 до 26 с шагом 1 *}
Begin
  rg.al := copr[i] Xor msk [(i Mod 3) + 1];
  intr($10, rg);
End;
writeln(          #10,#10,#13, 'Для работы с администратором используйте следующие ключи:',          #10,#10,#13, '    / b - загрузка системы;
',              #10,#13, '    / e - конец работы;
',              #10,#13, '    / n - инициализация протокола;
',              #10,#13, '    / i File.nam - формирование отчета в файл File.nam, ',              #10,#13, '                  допускаются стандартные "файлы" : ',              #10,#13, '                  prn - принтер, ',              #10,#13, '                  con - дисплей (по умолчанию).',          #10,#10,#10,#13);
halt;
End;
Procedure wrt(i : word);
Begin
If i > 9 Then
  write(i : 2)
Else write('0', i : 1);
  End;
Begin
fillchar(buf, sizeof(buf), 0);
rg.ax := $201; { ADM ? }
rg.cx := 4;
rg.dx := $80;
rg.es := seg(buf);
rg.bx := ofs(buf);
intr($13, rg);
rg.ax := $0301;
intr($13, rg);
load := (rg.ah = 3);
lp := ParamCount;
If lp = 0 Then
  cansel;
lpk := ParamStr(1);
If lpk[1]'/' Then
  cansel;
k := 1;
If upcase(lpk[2]) = 'D' Then
Begin
  dev := lpk[3];
  lpk := paramstr(2);
  inc(k); {* Прибавим к k единицу *}
End;
Else dev := 'e';
  assign(f, concat(dev, ':workadm.inf')); {* Связывание f с файлом concat(dev, ':workadm.inf' *}
setfattr(f,$00);
reset(f); {* Чтение из файла через переменную f *}
Case IOresult Of     0:
Begin
End;
2 : rewrite(f); {* Открытие файла для записи *}
3:
Begin
  MkDir(concat(dev, ':work'));
  rewrite(f); {* Подготовка переменной f для записи в файл *}
End;
Else write(' I/O Error...');
  End;
fs := FileSize(f);
Case UpCase(lpk[2]) Of     'A':
  Begin
fillchar(buf, sizeof(buf), 0);
rg.dx := $FFFF; { Open }
rg.ax := $1000;
If load Then
  Repeat              rg.di := 0;
    intr($13, rg);
Until rg.di = $12;
rg.ax := $0201; { Read }
rg.cx := $0002;
rg.dx := $0080;
rg.es := seg(buf);
rg.bx := ofs(buf);
intr($13, rg);
buf[497] := 1; { Security ON ! }
rg.ax := $0301; { Write }
rg.cx := $0002;
rg.dx := $0080;
rg.es := seg(buf);
rg.bx := ofs(buf);
intr($13, rg);
rg.ah := $11; { Recalibrate }
intr($13, rg);
End;
'B':
Begin
seek(f, fs - 1);
read(f, next);
If next.d_s Mod 16 = 2 Then
  nstat := Boot
Else nstat := Reboot;
  End;
'E' : nstat := Exit;
'N':
Begin
close(f); {* Закрытие файла *}
rewrite(f); {* Открытие файла для записи *}
nstat := Init;
fs := 0;
End;
'I':
Begin
GetTime(dt.Hour, dt.Min, dt.Sec, a);
GetDate(dt.Year, dt.Month, dt.Day, a);
If k0 Then
  cansel;
writeln(g);
writeln(g, 'Протокол работы на ', wer[a], ', ', dt.Day, '-е ',             mon[dt.Month], ' ', dt.year, ', ', dt.Hour, ':', dt.Min, ':', dt.Sec);
For i := 0 To fs - 1 Do {* Переменная i увеличивается с 0 до fs *}
Begin
  seek(f, i);
  read(f, next);
  UnpackTime(next.dat, dt);
  write(g, wee[next.d_s Div 16] : 11, dt.Day : 3, '-го ',                   mon[dt.Month] : 8, dt.year : 6, ', ');
  wrt(dt.Hour);
  write(':');
  wrt(dt.Min);
  write(':');
  wrt(dt.Sec);
  Case next.d_s Mod 16 Of              0 : writeln(g, ' - загрузка системы.');
    1 : writeln(g, ' - перезагрузка.');
  2 : writeln(g, ' - окончание работы.');
  3 : writeln(g, ' - выдача протокола.');
  4 : writeln(g, ' - инициализация протокола.');
End;

End;
close(g); {* Закрытие файла *}
nstat := Info;
End;

End;
next.d_s := ord(nstat);
GetDate(dt.Year, dt.Month, dt.Day, a);
next.d_s := next.d_s + a * 16;
GetTime(dt.Hour, dt.Min, dt.Sec, a);
PackTime(dt, next.dat);
seek(f, fs);
write(f, next);
close(f); {* Закрыть файл f *}
setfattr(f,$27);
If nstat = Exit Then
  Begin
fillchar(buf, sizeof(buf), 0);
rg.dx := $FFFF; { Open }
rg.ax := $1000;
If load Then
  Repeat        rg.di := 0;
    intr($13, rg);
Until rg.di = $12;
rg.ax := $0201; { Read }
rg.cx := $0002;
rg.dx := $0080;
rg.es := seg(buf);
rg.bx := ofs(buf);
intr($13, rg);
buf[497] := 1; { Security ON ! }
rg.ax := $0301; { Write }
rg.cx := $0002;
rg.dx := $0080;
rg.es := seg(buf);
rg.bx := ofs(buf);
intr($13, rg);
rg.ah := $11; { Recalibrate }
intr($13, rg);
textcolor(0); {* Выбрать 0 цвет текста *}
clrscr; {* Очищаем экран *}
sound(477);
delay(200);
nosound;
Inline($FA { cli }
/$F4 { hlt }
); { / $EB / $FD);
}
End;

End....