home *** CD-ROM | disk | FTP | other *** search
/ Megaware 1 / Megaware Volume 1.iso / utils / infoplus / page_01.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-12-08  |  8.1 KB  |  306 lines
  1. procedure page_01;
  2.   const
  3.     BIOScseg = $C000;
  4.     BIOSext = $AA55;
  5.     PCROMseg = $F000;
  6.     dells: array [2..$11] of string[5] = ('200', '300', '?', '220', '310', '325',
  7.              '?', '310A', '316', '220E', '210', '316SX', '316LT', '320LX',
  8.              '?', '425E');
  9.     dellnums: set of 0..$FF = [2, 3, 5..7, 9..$0F, $11];
  10.  
  11.   var
  12.     xbool : boolean;
  13.     xbyte : byte;
  14.     xchar : char;
  15.     xlong : longint;
  16.     xword1 : word;
  17.     xword2 : word;
  18.     s: string;
  19.  
  20.   function BIOSscan(a, b, c : word; var d : word) : boolean;
  21.     const
  22.       max = 3;
  23.       notice : array[1..max] of string = ('(C)', 'COPR.', 'COPYRIGHT');
  24.  
  25.     var
  26.       i : 1..max;
  27.       len : byte;
  28.       target : string;
  29.       xbool : boolean;
  30.       xlong : longint;
  31.       xword : word;
  32.  
  33.     function scan(a : string; b, c, d : word; var e : word) : boolean;
  34.       var
  35.         i : longint;
  36.         j : byte;
  37.         len : byte;
  38.         xbool1 : boolean;
  39.         xbool2 : boolean;
  40.  
  41.       begin
  42.       i:=c;
  43.       len:=length(a);
  44.       xbool1:=false;
  45.       repeat
  46.         if i <= longint(d) - len + 1 then
  47.           begin
  48.           j:=0;
  49.           xbool2:=false;
  50.           repeat
  51.             if j < len then
  52.               if upcase(chr(mem[b : i + j])) = a[j + 1] then
  53.                 inc(j)
  54.               else
  55.                 begin
  56.                 xbool2:=true;
  57.                 inc(i)
  58.                 end
  59.             else
  60.               begin
  61.               xbool2:=true;
  62.               xbool1:=true;
  63.               e:=i;
  64.               scan:=true
  65.               end
  66.           until xbool2
  67.           end
  68.         else
  69.           begin
  70.           xbool1:=true;
  71.           scan:=false
  72.           end
  73.       until xbool1
  74.       end; {scan}
  75.  
  76.     begin (* function BIOSscan *)
  77.     xlong:=c;
  78.     xbool:=false;
  79.     for i:=1 to max do
  80.       begin
  81.       target:=notice[i];
  82.       len:=length(target);
  83.       if xbool then
  84.         xlong:=longint(xword) - 2 + len;
  85.       if (xlong >= b) and (xlong <= c) and (scan(target, a, b, xlong, xword))
  86.         then
  87.           xbool:=true
  88.       end;
  89.     if xbool then
  90.       begin
  91.       while (xword > b) and (chr(mem[a : xword - 1]) in pchar) do
  92.         dec(xword);
  93.       d:=xword
  94.       end;
  95.     BIOSscan:=xbool
  96.     end; {biosscan}
  97.  
  98.   procedure showBIOS(a, b : word);
  99.     var
  100.       xbool : boolean;
  101.       xchar : char;
  102.  
  103.     begin
  104.     xbool:=false;
  105.     repeat
  106.       xchar:=chr(mem[a : b]);
  107.       if xchar in pchar then
  108.         begin
  109.         write(xchar);
  110.         if b < $FFFF then
  111.           inc(b)
  112.         else
  113.           xbool:=true
  114.         end
  115.       else
  116.         xbool:=true
  117.     until xbool;
  118.     writeln
  119.     end; {showbios}
  120.  
  121.   begin (* procedure page_01 *)
  122.   caption2('Machine type');
  123.   if UpCase(Chr(Mem[$F000:$E076])) = 'D' then
  124.     begin
  125.     s:='';
  126.     for xword1:=$E077 to $E079 do
  127.       s:=s + UpCase(Chr(Mem[$F000:xword1]));
  128.     if s = 'ELL' then
  129.       begin
  130.       Write('Dell ');
  131.       xbool:=true;
  132.       xbyte:=Mem[$F000:$E845];
  133.       if xbyte in dellnums then
  134.         Write(dells[xbyte])
  135.       else
  136.         begin
  137.         Write('(unknown - ID is ', hex(xbyte, 2));
  138.         xbool:=false
  139.         end;
  140.       if xbool then
  141.         begin
  142.         caption3('BIOS Revision');
  143.         for xword1:=$E845 to $E847 do
  144.           Write(Chr(Mem[$F000:xword1]))
  145.         end;
  146.       Writeln;
  147.       caption2('Standard BIOS call says');
  148.       Writeln
  149.       end
  150.     end;
  151.   with regs do
  152.     begin
  153.     AH:=$C0;
  154.     intr($15, regs);
  155.     if nocarry then
  156.       begin
  157.       xword1:=memw[ES : BX + 2];
  158.       xbyte:=MemW[ES:BX + 4];
  159.       case xword1 of
  160.         $00FC:        if xbyte = 1 then
  161.                         Writeln('PC-AT 2x9')
  162.                       else
  163.                         Writeln('Industrial AT 7531/2');
  164.         $01FC:        case xbyte of
  165.                         $00: Writeln('PC-AT 3x9 or clone');
  166.                         $30: Writeln('Tandy 3000NL')
  167.                       else
  168.                         Writeln('Compaq 286/386 or clone');
  169.                       end;
  170.         $00FB:        if xbyte = 1 then
  171.                         Writeln('PC-XT w/ Enh kbd, 3.5" support')
  172.                       else
  173.                         Writeln('PC-XT');
  174.         $01FB:        Writeln('PC-XT/2');
  175.         $02FC:        Writeln('PC-XT/286');
  176.         $00F9:        Writeln('PC-Convertible');
  177.         $00FA:        Writeln('PS/2 Model 30');
  178.         $01FA:        Writeln('PS/2 Model 25');
  179.         $09FC:        Writeln('PS/2 Model 30-286');
  180.         $04FC:        if xbyte = 3 then
  181.                         Writeln('PS/2 Model 50Z')
  182.                       else
  183.                         Writeln('PS/2 Model 50');
  184.         $05FC:        Writeln('PS/2 Model 60');
  185.         $04F8, $09F8: Writeln('PS/2 Model 70');
  186.         $0CF8:        Writeln('PS/2 Model 55SX');
  187.         $1BF8:        Writeln('PS2 Model 70-486');
  188.         $00F8:        Writeln('PS/2 Model 80 16MHz');
  189.         $01F8:        Writeln('PS/2 Model 80 20MHz');
  190.         $06FC:        Writeln('7552 Gearbox');
  191.         $81FC:        Writeln('AT clone with Phoenix 386 BIOS');
  192.       else
  193.         unknown('machine - model/type word', xword1, 4);
  194.       end; {case}
  195.       caption3('BIOS revision level');
  196.       writeln(mem[ES : BX + 4]);
  197.       xbyte:=mem[ES : BX + 5];
  198.       caption3('DMA channel 3 used');
  199.       yesorno(xbyte and $80 = $80);
  200.       caption3('Slave 8259 present');
  201.       yesorno(xbyte and $40 = $40);
  202.       caption3('Real-time clock');
  203.       yesorno(xbyte and $20 = $20);
  204.       caption3('Keyboard intercept available');
  205.       yesorno(xbyte and $10 = $10);
  206.       caption3('Wait for external event available');
  207.       yesorno(xbyte and $08 = $08);
  208.       caption3('Extended BIOS data area segment');
  209.       if xbyte and $04 = $04 then
  210.         begin
  211.         AH:=$C1;
  212.         intr($15, regs);
  213.         if nocarry then
  214.           writeln(hex(ES, 4))
  215.         else
  216.           dontknow
  217.         end
  218.       else
  219.         writeln('(none)');
  220.       caption3('Micro Channel');
  221.       yesorno(xbyte and $02 = $02)
  222.       end
  223.     else
  224.       begin
  225.       xbyte:=mem[$FFFF : $000E];
  226.       s:='';
  227.       for xword1:=$FFF5 to $FFFC do
  228.         s:=s + Chr(Mem[$F000:xword1]);
  229.       case xbyte of
  230.         $FF : begin
  231.               Write('PC ');
  232.               if s = '04/24/81' then
  233.                 Write('(original)');
  234.               if s = '10/19/81' then
  235.                 Write('(revised BIOS)');
  236.               if s = '10/27/82' then
  237.                 Write('(HD, 640K, EGA supported)');
  238.               Writeln;
  239.               end;
  240.         $FE : begin
  241.               Write('PC-XT');
  242.               if s = '11/08/82' then
  243.                 Write(' or Portable');
  244.               Writeln;
  245.               end;
  246.         $FD : writeln('PCjr');
  247.         $FC : writeln('PC-AT');
  248.         $9A : Writeln('Compaq XT or Compaq Plus');
  249.         $30 : Writeln('Sperry PC');
  250.         $2D : Writeln('Compaq PC or Compaq Deskpro')
  251.         else
  252.           unknown('machine - model byte', xbyte, 2)
  253.       end
  254.       end
  255.   end;
  256. (*  Byte 12:12 p. 174  *)
  257.   caption2('BIOS source');
  258.   if BIOSscan(PCROMseg, $C000, $FFFF, xword1) then
  259.     showBIOS(PCROMseg, xword1)
  260.   else
  261.     dontknow;
  262.   caption2('BIOS date');
  263.   i:=$0005;
  264.   xbool:=false;
  265.   xchar:=chr(mem[$FFFF : i]);
  266.   while (i < $0010) and (xchar in pchar) do
  267.     begin
  268.     xbool:=true;
  269.     write(xchar);
  270.     inc(i);
  271.     xchar:=chr(mem[$FFFF : i])
  272.     end;
  273.   if xbool then
  274.     writeln
  275.   else
  276.     dontknow;
  277.   caption2('BIOS extensions');
  278.   xword1:=BIOScseg;
  279.   xbool:=false;
  280.   for i:=0 to 94 do
  281.     begin
  282.     if (memw[xword1 : 0] = BIOSext) then
  283.       begin
  284.       if not xbool then
  285.         begin
  286.         writeln;
  287.         window(3, wherey + hi(windmin), twidth, tlength - 2);
  288.         caption1('Segment Size  Copyright notice');
  289.         writeln;
  290.         xbool:=true
  291.         end;
  292.       pause2;
  293.       if endit then
  294.         Exit;
  295.       Write(hex(xword1, 4), '    ', ((longint(512) * Mem[xword1: 2]) div 1024):3, 'K  ');
  296.       if BIOSscan(xword1, $0000, $1FFF, xword2) then
  297.         showBIOS(xword1, xword2)
  298.       else
  299.         dontknow
  300.       end;
  301.     inc(xword1, $0080)
  302.     end;
  303.   if not xbool then
  304.     writeln('(none)')
  305.   end;
  306.