home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / ifp1s157 / page_01.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-06-25  |  13.5 KB  |  446 lines
  1. unit page_01;
  2.  
  3. interface
  4.  
  5. uses Crt, Dos, ifpglobl, ifpcomon;
  6.  
  7. procedure page01;
  8.  
  9. implementation
  10.  
  11. procedure page01;
  12.   const
  13.     BIOScseg = $C000;
  14.     BIOSext = $AA55;
  15.     PCROMseg = $F000;
  16.     dells: array [2..$11] of string[5] = ('200', '300', '?', '220', '310', '325',
  17.              '?', '310A', '316', '220E', '210', '316SX', '316LT', '320LX',
  18.              '?', '425E');
  19.     dellnums: set of 0..$FF = [2, 3, 5..7, 9..$0F, $11];
  20.     searchstr = '**Searching for Copyright message**';
  21.  
  22.   var
  23.     xbool : boolean;
  24.     xbyte : byte;
  25.     xchar : char;
  26.     xlong : longint;
  27.     xword1 : word;
  28.     xword2 : word;
  29.     s: string;
  30.     romdate: string[8];
  31.     rominfoseg, rominfoofs: word;
  32.  
  33.   function BIOSscan(a, b, c: word; var d: word): boolean;
  34.     const
  35.       max = 3;
  36.       notice : array[1..max] of string = ('(C)', 'COPR.', 'COPYRIGHT');
  37.  
  38.     var
  39.       i : 1..max;
  40.       len : byte;
  41.       target : string;
  42.       xbool : boolean;
  43.       xlong : longint;
  44.       xword : word;
  45.       oldx, oldy, oldattr: byte;
  46.  
  47.     function scan(a: string; b, c, d: word; var e: word): boolean;
  48.       var
  49.         i : longint;
  50.         j : byte;
  51.         len : byte;
  52.         xbool1 : boolean;
  53.         xbool2 : boolean;
  54.  
  55.       begin
  56.       i:=c;
  57.       len:=Length(a);
  58.       xbool1:=false;
  59.       repeat
  60.         if i <= longint(d) - len + 1 then
  61.           begin
  62.           j:=0;
  63.           xbool2:=false;
  64.           repeat
  65.             if j < len then
  66.               if UpCase(Chr(Mem[b : i + j])) = a[j + 1] then
  67.                 Inc(j)
  68.               else
  69.                 begin
  70.                 xbool2:=true;
  71.                 Inc(i)
  72.                 end
  73.             else
  74.               begin
  75.               xbool2:=true;
  76.               xbool1:=true;
  77.               e:=i;
  78.               scan:=true
  79.               end
  80.           until xbool2
  81.           end
  82.         else
  83.           begin
  84.           xbool1:=true;
  85.           scan:=false
  86.           end
  87.       until xbool1
  88.       end; {scan}
  89.  
  90.     begin (* function BIOSscan *)
  91.     xlong:=c;
  92.     xbool:=false;
  93.     oldx:=WhereX;
  94.     oldy:=WhereY;
  95.     oldattr:=TextAttr;
  96.     TextColor(LightRed + Blink);
  97.     Write(searchstr);
  98.     for i:=1 to max do
  99.       begin
  100.       target:=notice[i];
  101.       len:=Length(target);
  102.       if xbool then
  103.         xlong:=longint(xword) - 2 + len;
  104.       if (xlong >= b) and (xlong <= c) and (scan(target, a, b, xlong, xword))
  105.         then
  106.           xbool:=true
  107.       end;
  108.     if xbool then
  109.       begin
  110.       while (xword > b) and (chr(mem[a : xword - 1]) in pchar) do
  111.         Dec(xword);
  112.       d:=xword
  113.       end;
  114.     GotoXY(oldx, oldy);
  115.     TextAttr:=oldattr;
  116.     for len:=1 to Length(searchstr) do
  117.       Write(' ');
  118.     GotoXY(oldx, oldy);
  119.     BIOSscan:=xbool
  120.     end; {biosscan}
  121.  
  122.   procedure showBIOS(a, b: word);
  123.     var
  124.       xbool : boolean;
  125.       xchar : char;
  126.  
  127.     begin
  128.     xbool:=false;
  129.     repeat
  130.       xchar:=Chr(Mem[a : b]);
  131.       if xchar in pchar then
  132.         begin
  133.         Write(xchar);
  134.         if b < $FFFF then
  135.           Inc(b)
  136.         else
  137.           xbool:=true
  138.         end
  139.       else
  140.         xbool:=true
  141.     until xbool;
  142.     Writeln
  143.     end; {showbios}
  144.  
  145.   begin (* procedure page01 *)
  146.   caption2('Machine type');
  147.   if UpCase(Chr(Mem[$F000:$E076])) = 'D' then
  148.     begin
  149.     s:='';
  150.     for xword1:=$E077 to $E079 do
  151.       s:=s + UpCase(Chr(Mem[$F000:xword1]));
  152.     if s = 'ELL' then
  153.       begin
  154.       Write('Dell ');
  155.       xbool:=true;
  156.       xbyte:=Mem[$F000:$E845];
  157.       if xbyte in dellnums then
  158.         Write(dells[xbyte])
  159.       else
  160.         begin
  161.         Write('(unknown - ID is ', hex(xbyte, 2));
  162.         xbool:=false
  163.         end;
  164.       if xbool then
  165.         begin
  166.         caption3('BIOS Revision');
  167.         for xword1:=$E845 to $E847 do
  168.           Write(Chr(Mem[$F000:xword1]))
  169.         end;
  170.       Writeln;
  171.       caption2('Standard BIOS call says');
  172.       Writeln
  173.       end
  174.     end;
  175.   romdate:='';
  176.   for xword1:=$FFF5 to $FFFC do
  177.     romdate:=romdate + Chr(Mem[$F000:xword1]);
  178.   with regs do
  179.     begin
  180.     AX:=$6F00;
  181.     BX:=0;
  182.     Flags:=Flags and FCarry;
  183.     Intr($16, regs);
  184.     if nocarry(regs) and (BX = $4850) then
  185.       begin
  186.       Writeln('HP Vectra series');
  187.       caption2('Standard BIOS call says');
  188.       end;
  189.     end;
  190.   with regs do
  191.     begin
  192.     AX:=$4DD4;
  193.     BX:=0;
  194.     Intr($15, regs);
  195.     if BX = $4850 then
  196.       begin
  197.       Writeln('HP 95LX');
  198.       caption2('Standard BIOS call says');
  199.       end;
  200.     end;
  201.   with regs do
  202.     begin
  203.     AH:=$C0;
  204.     ES:=0;
  205.     BX:=0;
  206.     Flags:=Flags and FCarry;
  207.     Intr($15, regs);
  208. {    if ((ES <> 0) and (BX <> 0)) and (Mem[$FFFF:$E] < $FD) and nocarry(regs) then}
  209.     if nocarry(regs) and (AH = 0) then
  210.       begin
  211.       rominfoseg:=ES;
  212.       rominfoofs:=BX;
  213.       xword1:=MemW[ES : BX + 2];
  214.       xbyte:=Mem[ES:BX + 4];
  215.       case xword1 of
  216.         $00FC:        if xbyte = 1 then
  217.                         Writeln('PC-AT 2x9, 6MHz')
  218.                       else
  219.                         Writeln('Industrial AT 7531/2');
  220.         $01FC:        case xbyte of
  221.                         $00: begin
  222.                              if romdate = '11/15/85' then
  223.                                Writeln('PC-AT 319 or 339, 8MHz')
  224.                              else
  225.                                if romdate = '01/15&88' then
  226.                                  Writeln('Toshiba T5200/100')
  227.                                else
  228.                                  if romdate = '12/26*89' then
  229.                                    Writeln('Toshiba T1200/XE')
  230.                                  else
  231.                                    if romdate = '07/24&90' then
  232.                                      Writeln('Toshiba T5200/200')
  233.                                    else
  234.                                      if romdate = '09/17/87' then
  235.                                        Writeln('Tandy 3000')
  236.                                      else
  237.                                        Writeln('AT clone');
  238.                              end;
  239.                         $30: Writeln('Tandy 3000NL')
  240.                       else
  241.                         Writeln('Compaq 286/386 or clone');
  242.                       end;
  243.         $02FC:        Writeln('PC-XT/286');
  244.         $04FC:        if xbyte = 3 then
  245.                         Writeln('PS/2 Model 50Z 10MHz 286')
  246.                       else
  247.                         Writeln('PS/2 Model 50 10MHz 286');
  248.         $05FC:        Writeln('PS/2 Model 60 10MHz 286');
  249.         $06FC:        Writeln('7552 Gearbox');
  250.         $09FC:        if xbyte = 2 then
  251.                         Writeln('PS/2 Model 30-286')
  252.                       else
  253.                         Writeln('PS/2 Model 25-286');
  254.         $0BFC:        Writeln('PS/1 Model 2011 10MHz 286');
  255.         $42FC:        Writeln('Olivetti M280');
  256.         $45FC:        Writeln('Olivetti M380 (XP1, 3, or 5)');
  257.         $48FC:        Writeln('Olivetti M290');
  258.         $4FFC:        Writeln('Olivetti M250');
  259.         $50FC:        Writeln('Olivetti M380 (XP7)');
  260.         $51FC:        Writeln('Olivetti PCS286');
  261.         $52FC:        Writeln('Olivetti M300');
  262.         $81FC:        Writeln('AT clone with Phoenix 386 BIOS');
  263.         $00FB:        if xbyte = 1 then
  264.                         Writeln('PC-XT w/ Enh kbd, 3.5" support')
  265.                       else
  266.                         Writeln('PC-XT');
  267.         $01FB:        Writeln('PC-XT/2');
  268.         $4CFB:        Writeln('Olivetti M200');
  269.         $00FA:        Writeln('PS/2 Model 30');
  270.         $01FA:        Writeln('PS/2 Model 25/25L');
  271.         $4EFA:        Writeln('Olivetti M111');
  272.         $00F9:        Writeln('PC-Convertible');
  273.         $00F8:        Writeln('PS/2 Model 80 16MHz 386');
  274.         $01F8:        Writeln('PS/2 Model 80 20MHz 386');
  275.         $04F8:        Writeln('PS/2 Model 70 20MHz 386');
  276.         $09F8:        Writeln('PS/2 Model 70 16MHz 386');
  277.         $0BF8:        Writeln('PS/2 Model P70');
  278.         $0CF8:        Writeln('PS/2 Model 55SX 16MHz 386SX');
  279.         $0DF8:        Writeln('PS/2 Model 70 25MHz 386');
  280.         $11F8:        Writeln('PS/2 Model 90 25MHz 386');
  281.         $13F8:        Writeln('PS/2 Model 90 33MHz 386');
  282.         $14F8:        Writeln('PS/2 Model 90-AK9 25MHz 486');
  283.         $16F8:        Writeln('PS/2 Model 90-AKD 33MHz 486');
  284.         $19F8:        Writeln('PS/2 Model 35/35LS/40 20MHz 386SX');
  285.         $1BF8:        Writeln('PS/2 Model 70 25MHz 486');
  286.         $1CF8:        Writeln('PS/2 Model 65-121 16MHz 386SX');
  287.         $1EF8:        Writeln('PS/2 Model 55LS 16MHz 386SX');
  288.         $23F8:        Writeln('PS/2 Model L40 20MHz 386SX');
  289.         $25F8:        Writeln('PS/2 Model M57 20MHz 386SLC');
  290.         $26F8:        Writeln('PS/2 Model 57 20MHz 386SX');
  291.         $2AF8:        Writeln('PS/2 Model 95 50MHz 486');
  292.         $2BF8:        Writeln('PS/2 Model 90 50MHz 486');
  293.         $2CF8:        Writeln('PS/2 Model 95 20MHz 486SX');
  294.         $2DF8:        Writeln('PS/2 Model 90 20MHz 486SX');
  295.         $2EF8:        Writeln('PS/2 Model 95 20MHz 486SX+487SX');
  296.         $2FF8:        Writeln('PS/2 Model 90 20MHz 486SX+487SX');
  297.         $30F8:        Writeln('PS/1 Model 2121 16MHz 386SX');
  298.         $50F8:        Writeln('PS/2 Model P70 16MHz 386');
  299.         $52F8:        Writeln('PS/2 Model P75 33MHz 486');
  300.         $61F8:        Writeln('Olivetti P500');
  301.         $62F8:        Writeln('Olivetti P800');
  302.         $80F8:        Writeln('PS/2 Model 80 25 MHz 386');
  303.       else
  304.         unknown('machine - model/type word', xword1, 4);
  305.       end; {case}
  306.       caption3('BIOS revision level');
  307.       Writeln(Mem[ES:BX + 4]);
  308.       xbyte:=Mem[ES:BX + 5];
  309.       caption3('DMA channel 3 used');
  310.       yesorno(xbyte and $80 = $80);
  311.       caption3('Slave 8259 present');
  312.       yesorno(xbyte and $40 = $40);
  313.       caption3('Real-time clock');
  314.       yesorno(xbyte and $20 = $20);
  315.       caption3('Keyboard intercept available');
  316.       yesorno(xbyte and $10 = $10);
  317.       caption3('Wait for external event available');
  318.       yesorno(xbyte and $08 = $08);
  319.       caption3('Extended BIOS data area segment');
  320.       if xbyte and $04 = $04 then
  321.         begin
  322.         AH:=$C1;
  323.         intr($15, regs);
  324.         if nocarry(regs) then
  325.           Writeln(hex(ES, 4))
  326.         else
  327.           dontknow
  328.         end
  329.       else
  330.         Writeln('(none)');
  331.       caption3('Micro Channel');
  332.       yesorno(xbyte and $02 = $02);
  333.       caption3('Keyboard Int 16h/Func 9 support');
  334.       yesorno(Mem[ES:BX + 6] and $40 = $40);
  335.       end
  336.     else
  337.       if Mem[$F000:$C000] = $21 then
  338.         Writeln('Tandy 1000')
  339.       else
  340.         begin
  341.         xbyte:=mem[$FFFF : $000E];
  342.         case xbyte of
  343.           $FF : begin
  344.                 if Mem[$F000:$FFFD] = $46 then
  345.                   Writeln('Olivetti M15')
  346.                 else
  347.                   begin
  348.                   Write('PC ');
  349.                   if romdate = '04/24/81' then
  350.                     Write('(original)')
  351.                   else
  352.                     if romdate = '10/19/81' then
  353.                       Write('(revised BIOS)')
  354.                     else
  355.                       if romdate = '10/27/82' then
  356.                         Write('(HD, 640K, EGA supported)')
  357.                       else
  358.                         Write('clone');
  359.                   end;
  360.                 Writeln;
  361.                 end;
  362.           $FE : begin
  363.                 if Mem[$F000:$FFFD] = $43 then
  364.                   Writeln('Olivetti M240')
  365.                 else
  366.                   begin
  367.                   Write('PC-XT');
  368.                   if romdate = '11/08/82' then
  369.                     Write(' or Portable')
  370.                   else
  371.                     if romdate <> '08/16/82' then
  372.                       Write(' clone');
  373.                   Writeln;
  374.                   end;
  375.                 end;
  376.           $FD : Writeln('PCjr');
  377.           $FC : Writeln('PC-AT');
  378.           $9A : Writeln('Compaq XT or Compaq Plus');
  379.           $30 : Writeln('Sperry PC');
  380.           $2D : Writeln('Compaq PC or Compaq Deskpro')
  381.           else
  382.             unknown('machine - model byte', xbyte, 2)
  383.         end
  384.         end
  385.   end;
  386. (*  Byte 12:12 p. 174  *)
  387.   caption2('BIOS source');
  388.   if BIOSscan(PCROMseg, $C000, $FFFF, xword1) then
  389.     showBIOS(PCROMseg, xword1)
  390.   else
  391.     dontknow;
  392.   s:='';
  393.   for xword1:=rominfoofs + $0D to rominfoofs + $0F do
  394.     s:=s + Chr(Mem[rominfoseg: xword1]);
  395.   if s = 'PTL' then
  396.     begin
  397.     caption2('BIOS version');
  398.     Writeln(unbcd(Mem[rominfoseg:rominfoofs + $B]), decimal,
  399.             addzero(unbcd(Mem[rominfoseg:rominfoofs + $C])));
  400.     end;
  401.   caption2('BIOS date');
  402.   i:=$0005;
  403.   xbool:=false;
  404.   xchar:=Chr(Mem[$FFFF : i]);
  405.   while (i < $0010) and (xchar in pchar) do
  406.     begin
  407.     xbool:=true;
  408.     Write(xchar);
  409.     Inc(i);
  410.     xchar:=Chr(Mem[$FFFF : i])
  411.     end;
  412.   if xbool then
  413.     Writeln
  414.   else
  415.     dontknow;
  416.   caption2('BIOS extensions');
  417.   xword1:=BIOScseg;
  418.   xbool:=false;
  419.   for i:=0 to 94 do
  420.     begin
  421.     if (memw[xword1 : 0] = BIOSext) then
  422.       begin
  423.       if not xbool then
  424.         begin
  425.         Writeln;
  426.         Window(3, wherey + hi(windmin), twidth, tlength - 2);
  427.         caption1('Segment Size  Copyright notice');
  428.         Writeln;
  429.         xbool:=true
  430.         end;
  431.       pause2;
  432.       if endit then
  433.         Exit;
  434.       Write(hex(xword1, 4), '    ', ((longint(512) * Mem[xword1: 2]) div 1024):3, 'K  ');
  435.       if BIOSscan(xword1, $0000, $1FFF, xword2) then
  436.         showBIOS(xword1, xword2)
  437.       else
  438.         dontknow
  439.       end;
  440.     Inc(xword1, $0080)
  441.     end;
  442.   if not xbool then
  443.     Writeln('(none)')
  444.   end;
  445. end.
  446.