home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / HARDWARE / INFOP120.ZIP / PAGE_01.INC < prev    next >
Encoding:
Text File  |  1990-07-29  |  6.6 KB  |  272 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.       case xword1 of
  167.         $00FC, $01FC: Writeln('PC-AT 3x9');
  168.         $00FB, $01FB: Writeln('PC-XT/2');
  169.         $02FC:        Writeln('PC-XT/286');
  170.         $00F9:        Writeln('PC-COnvertible');
  171.         $00FA:        Writeln('PS/2 Model 30');
  172.         $04FC:        Writeln('PS/2 Model 50');
  173.         $05FC:        Writeln('PS/2 Model 60');
  174.         $04F8, $09F8: Writeln('PS/2 Model 70');
  175.         $00F8, $01F8: Writeln('PS/2 Model 80');
  176.         $06FC:        Writeln('7552 Gearbox');
  177.         $81FC:        Writeln('Micronics 386/25');
  178.       else
  179.         unknown('machine - model/type word', xword1, 4);
  180.       end; {case}
  181.       caption3('BIOS revision level');
  182.       writeln(mem[ES : BX + 4]);
  183.       xbyte:=mem[ES : BX + 5];
  184.       caption3('DMA channel 3 used');
  185.       yesorno(xbyte and $80 = $80);
  186.       caption3('Slave 8259 present');
  187.       yesorno(xbyte and $40 = $40);
  188.       caption3('Real-time clock');
  189.       yesorno(xbyte and $20 = $20);
  190.       caption3('Keyboard intercept available');
  191.       yesorno(xbyte and $10 = $10);
  192.       caption3('Wait for external event available');
  193.       yesorno(xbyte and $08 = $08);
  194.       caption3('Extended BIOS data area segment');
  195.       if xbyte and $04 = $04 then
  196.         begin
  197.         AH:=$C1;
  198.         intr($15, regs);
  199.         if nocarry then
  200.           writeln(hex(ES, 4))
  201.         else
  202.           dontknow
  203.         end
  204.       else
  205.         writeln('(none)');
  206.       caption3('Micro Channel');
  207.       yesorno(xbyte and $02 = $02)
  208.       end
  209.     else
  210.       begin
  211.       xbyte:=mem[$FFFF : $000E];
  212.       case xbyte of
  213.         $FF : writeln('PC');
  214.         $FE : writeln('PC-XT');
  215.         $FD : writeln('PCjr');
  216.         $FC : writeln('PC-AT')
  217.         else
  218.           unknown('machine - model byte', xbyte, 2)
  219.       end
  220.       end
  221.   end;
  222. (*  Byte 12:12 p. 174  *)
  223.   caption2('BIOS source');
  224.   if BIOSscan(PCROMseg, $C000, $FFFF, xword1) then
  225.     showBIOS(PCROMseg, xword1)
  226.   else
  227.     dontknow;
  228.   caption2('BIOS date');
  229.   i:=$0005;
  230.   xbool:=false;
  231.   xchar:=chr(mem[$FFFF : i]);
  232.   while (i < $0010) and (xchar in pchar) do
  233.     begin
  234.     xbool:=true;
  235.     write(xchar);
  236.     inc(i);
  237.     xchar:=chr(mem[$FFFF : i])
  238.     end;
  239.   if xbool then
  240.     writeln
  241.   else
  242.     dontknow;
  243.   caption2('BIOS extensions');
  244.   xword1:=BIOScseg;
  245.   xbool:=false;
  246.   for i:=0 to 94 do
  247.     begin
  248.     if (memw[xword1 : 0] = BIOSext) then
  249.       begin
  250.       if not xbool then
  251.         begin
  252.         writeln;
  253.         window(3, wherey + hi(windmin), twidth, tlength - 2);
  254.         caption1('Segment Size  Copyright notice');
  255.         writeln;
  256.         xbool:=true
  257.         end;
  258.       pause2;
  259.       if endit then
  260.         Exit;
  261.       Write(hex(xword1, 4), '    ', ((longint(512) * Mem[xword1: 2]) div 1024):3, 'K  ');
  262.       if BIOSscan(xword1, $0000, $1FFF, xword2) then
  263.         showBIOS(xword1, xword2)
  264.       else
  265.         dontknow
  266.       end;
  267.     inc(xword1, $0080)
  268.     end;
  269.   if not xbool then
  270.     writeln('(none)')
  271.   end;
  272.