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