Program  AboutPC; {903944 891958 900468 /\ 923410
  947714 947320 946644 947264}
Uses DOS, CRT;
const
  N = 10;
var
  R : Registers;
  k : Integer;
  b : Byte;
  a, d, j : Word;
  Time, i : Longint;
  m, e : LongInt;
begin
  ClrScr;
  Write('Тип ПК: ');
  case Mem[$F000:$FFFE] of
    $FF: WriteLn('PC');
    $FE: WriteLn('XT');
    $FD: WriteLn('PCjr');
    $FC: WriteLn('AT');
  else
    WriteLn('Нестандартный тин ПК ||| ', Mem[$F000:$FFFE]);
  end;
  with R do
  begin
    ah := $30;
    MSDOS(R);
    WriteLn('Версия ДОС - ',al,'.',ah);
  end;
  Write('ПЗУ изготовлено(MM/DD/YY) ');
  for k := 0 to 7 do
    Write(chr(Mem[$F000:$FFF5+k]));
    WriteLn;
  WriteLn('Память...');
  if Mem[$F000:$FFFE]=$FC then
    begin
      WriteLn('(Основная )');
      Port[$70]:= $15;
      m := Port[$71];
      WriteLn(' $15 : ', m, ' Кб' );
      Port[$70]:=$16;
      m := m + Port[$71] shl 8;
      WriteLn('+ $16 : ', m, ' Кб' );
      WriteLn('(Дополнительная )');
      Port[$70]:= $17;
      Word(e) := Port[$71];
      WriteLn(' $17 : ', e, ' Кб' );
      Port[$70]:=$18;
      e := e +Word( Port[$71] shl 8);
      WriteLn('+ $18 : ', e, ' Кб' );
      WriteLn('Всего: ', m+e, ' Кб' );
    end;
  WriteLn('Тест на аналичие памяти...');
  m := 1;
  for k := 1 to 9 do
    begin
      j := k shl 12;
      if Mem[j:0] = 233 then inc(m)
      else
        begin
          Mem[j:0] := 0;
          if Mem[j:0] = 0 then
          begin
            inc(m);
            Mem[j:0] := 233
          end
        end
    end;
  m := m * 64;
  WriteLn('Тестирование основной памяти показало наличие ', m, ' Кб ');
  Write('Определение производительности ПК... ||| ');
  i := 0;
  for k := 1 to N do
  begin
    Time := MemL[0:$046C];
    While  MemL[0:$046C] = Time do
      ;
    inc (Time, 2);
    While  MemL[0:$046C] <> Time do
      inc(i);
  end;
  WriteLn(i div N);
  WriteLn(MemW[0:$413], ' Кбайт оперативной памяти');
  WriteLn('Для AT( обращение к CMOS ):');
  Port[$70] := $14;
  a := Port[$71];
  if a and 1 <> 0 then
  case (a shr 6) and 3 of
    0: WriteLn(' - один НГМД');
    1: WriteLn(' - два НГМД');
  end;
  if a and 2 <> 0 then
      WriteLn(' - арифметический сопроцессор');
  case (a shr 4) and 3 of
    0:  WriteLn(' - адаптер EGA или VGA');
    1:  WriteLn(' - цветной адаптер 40x25');
    2:  WriteLn(' - цветной адаптер 80x25');
    3:  WriteLn(' - монохромный дисплей ');
  end;
  a := 0;
  for d := 0 to 3 do
    if MemW[0:$400+d shl 2]<>0 then inc(a);
  WriteLn(' - ', a, ' последовательных порта');
  a := 0;
  for d := 0 to 3 do
    if MemW[0:$408+d shl 2]<>0 then
      inc(a);
  WriteLn(' - ', a, ' параллельных порта');
  ReadKey;
  WriteLn('С помощью расшифровки слова в ПЗУ (для XT):');
  a := MemW[0:$410];
  if a and 1 <> 0 then
    WriteLn(' - ', (a shr 6) and 3, ' накопитель(-лей) ГМД');
  if a and 2 <> 0 then
    WriteLn(' - арифметический сопроцессор ');
  if a and 12 <> 0 then
    WriteLn(' - базовую память 64K');
  case (a shr 4) and 3 of
    0:  WriteLn(' - адаптер EGA или VGA');
    1:  WriteLn(' - цветной адаптер 40x25');
    2:  WriteLn(' - цветной адаптер 80x25');
    3:  WriteLn(' - монохромный дисплей ');
  end;
  WriteLn(' - ', (a shr 9) and 7, ' каналов связи');
  if (a shr 12) and 1 <> 0 then
    WriteLn(' - игровой порт');
  WriteLn(' - ', (a shr 14), ' принтеров');
  WriteLn('Значение слова: ', a);{(50211)}
  ReadKey;
end.

Назад