home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / IFP1S155.ZIP / PAGE_01.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-04-21  |  13.3 KB  |  435 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.     AH:=$C0;
  193.     ES:=0;
  194.     BX:=0;
  195.     Flags:=Flags and FCarry;
  196.     Intr($15, regs);
  197. {    if ((ES <> 0) and (BX <> 0)) and (Mem[$FFFF:$E] < $FD) and nocarry(regs) then}
  198.     if nocarry(regs) and (AH = 0) then
  199.       begin
  200.       rominfoseg:=ES;
  201.       rominfoofs:=BX;
  202.       xword1:=MemW[ES : BX + 2];
  203.       xbyte:=Mem[ES:BX + 4];
  204.       case xword1 of
  205.         $00FC:        if xbyte = 1 then
  206.                         Writeln('PC-AT 2x9, 6MHz')
  207.                       else
  208.                         Writeln('Industrial AT 7531/2');
  209.         $01FC:        case xbyte of
  210.                         $00: begin
  211.                              if romdate = '11/15/85' then
  212.                                Writeln('PC-AT 319 or 339, 8MHz')
  213.                              else
  214.                                if romdate = '01/15&88' then
  215.                                  Writeln('Toshiba T5200/100')
  216.                                else
  217.                                  if romdate = '12/26*89' then
  218.                                    Writeln('Toshiba T1200/XE')
  219.                                  else
  220.                                    if romdate = '07/24&90' then
  221.                                      Writeln('Toshiba T5200/200')
  222.                                    else
  223.                                      if romdate = '09/17/87' then
  224.                                        Writeln('Tandy 3000')
  225.                                      else
  226.                                        Writeln('AT clone');
  227.                              end;
  228.                         $30: Writeln('Tandy 3000NL')
  229.                       else
  230.                         Writeln('Compaq 286/386 or clone');
  231.                       end;
  232.         $02FC:        Writeln('PC-XT/286');
  233.         $04FC:        if xbyte = 3 then
  234.                         Writeln('PS/2 Model 50Z 10MHz 286')
  235.                       else
  236.                         Writeln('PS/2 Model 50 10MHz 286');
  237.         $05FC:        Writeln('PS/2 Model 60 10MHz 286');
  238.         $06FC:        Writeln('7552 Gearbox');
  239.         $09FC:        if xbyte = 2 then
  240.                         Writeln('PS/2 Model 30-286')
  241.                       else
  242.                         Writeln('PS/2 Model 25-286');
  243.         $0BFC:        Writeln('PS/1 Model 2011 10MHz 286');
  244.         $42FC:        Writeln('Olivetti M280');
  245.         $45FC:        Writeln('Olivetti M380 (XP1, 3, or 5)');
  246.         $48FC:        Writeln('Olivetti M290');
  247.         $4FFC:        Writeln('Olivetti M250');
  248.         $50FC:        Writeln('Olivetti M380 (XP7)');
  249.         $51FC:        Writeln('Olivetti PCS286');
  250.         $52FC:        Writeln('Olivetti M300');
  251.         $81FC:        Writeln('AT clone with Phoenix 386 BIOS');
  252.         $00FB:        if xbyte = 1 then
  253.                         Writeln('PC-XT w/ Enh kbd, 3.5" support')
  254.                       else
  255.                         Writeln('PC-XT');
  256.         $01FB:        Writeln('PC-XT/2');
  257.         $4CFB:        Writeln('Olivetti M200');
  258.         $00FA:        Writeln('PS/2 Model 30');
  259.         $01FA:        Writeln('PS/2 Model 25/25L');
  260.         $4EFA:        Writeln('Olivetti M111');
  261.         $00F9:        Writeln('PC-Convertible');
  262.         $00F8:        Writeln('PS/2 Model 80 16MHz 386');
  263.         $01F8:        Writeln('PS/2 Model 80 20MHz 386');
  264.         $04F8:        Writeln('PS/2 Model 70 20MHz 386');
  265.         $09F8:        Writeln('PS/2 Model 70 16MHz 386');
  266.         $0BF8:        Writeln('PS/2 Model P70');
  267.         $0CF8:        Writeln('PS/2 Model 55SX 16MHz 386SX');
  268.         $0DF8:        Writeln('PS/2 Model 70 25MHz 386');
  269.         $11F8:        Writeln('PS/2 Model 90 25MHz 386');
  270.         $13F8:        Writeln('PS/2 Model 90 33MHz 386');
  271.         $14F8:        Writeln('PS/2 Model 90-AK9 25MHz 486');
  272.         $16F8:        Writeln('PS/2 Model 90-AKD 33MHz 486');
  273.         $19F8:        Writeln('PS/2 Model 35/35LS/40 20MHz 386SX');
  274.         $1BF8:        Writeln('PS/2 Model 70 25MHz 486');
  275.         $1CF8:        Writeln('PS/2 Model 65-121 16MHz 386SX');
  276.         $1EF8:        Writeln('PS/2 Model 55LS 16MHz 386SX');
  277.         $23F8:        Writeln('PS/2 Model L40 20MHz 386SX');
  278.         $25F8:        Writeln('PS/2 Model M57 20MHz 386SLC');
  279.         $26F8:        Writeln('PS/2 Model 57 20MHz 386SX');
  280.         $2AF8:        Writeln('PS/2 Model 95 50MHz 486');
  281.         $2BF8:        Writeln('PS/2 Model 90 50MHz 486');
  282.         $2CF8:        Writeln('PS/2 Model 95 20MHz 486SX');
  283.         $2DF8:        Writeln('PS/2 Model 90 20MHz 486SX');
  284.         $2EF8:        Writeln('PS/2 Model 95 20MHz 486SX+487SX');
  285.         $2FF8:        Writeln('PS/2 Model 90 20MHz 486SX+487SX');
  286.         $30F8:        Writeln('PS/1 Model 2121 16MHz 386SX');
  287.         $50F8:        Writeln('PS/2 Model P70 16MHz 386');
  288.         $52F8:        Writeln('PS/2 Model P75 33MHz 486');
  289.         $61F8:        Writeln('Olivetti P500');
  290.         $62F8:        Writeln('Olivetti P800');
  291.         $80F8:        Writeln('PS/2 Model 80 25 MHz 386');
  292.       else
  293.         unknown('machine - model/type word', xword1, 4);
  294.       end; {case}
  295.       caption3('BIOS revision level');
  296.       Writeln(Mem[ES:BX + 4]);
  297.       xbyte:=Mem[ES:BX + 5];
  298.       caption3('DMA channel 3 used');
  299.       yesorno(xbyte and $80 = $80);
  300.       caption3('Slave 8259 present');
  301.       yesorno(xbyte and $40 = $40);
  302.       caption3('Real-time clock');
  303.       yesorno(xbyte and $20 = $20);
  304.       caption3('Keyboard intercept available');
  305.       yesorno(xbyte and $10 = $10);
  306.       caption3('Wait for external event available');
  307.       yesorno(xbyte and $08 = $08);
  308.       caption3('Extended BIOS data area segment');
  309.       if xbyte and $04 = $04 then
  310.         begin
  311.         AH:=$C1;
  312.         intr($15, regs);
  313.         if nocarry(regs) then
  314.           Writeln(hex(ES, 4))
  315.         else
  316.           dontknow
  317.         end
  318.       else
  319.         Writeln('(none)');
  320.       caption3('Micro Channel');
  321.       yesorno(xbyte and $02 = $02);
  322.       caption3('Keyboard Int 16h/Func 9 support');
  323.       yesorno(Mem[ES:BX + 6] and $40 = $40);
  324.       end
  325.     else
  326.       if Mem[$F000:$C000] = $21 then
  327.         Writeln('Tandy 1000')
  328.       else
  329.         begin
  330.         xbyte:=mem[$FFFF : $000E];
  331.         case xbyte of
  332.           $FF : begin
  333.                 if Mem[$F000:$FFFD] = $46 then
  334.                   Writeln('Olivetti M15')
  335.                 else
  336.                   begin
  337.                   Write('PC ');
  338.                   if romdate = '04/24/81' then
  339.                     Write('(original)')
  340.                   else
  341.                     if romdate = '10/19/81' then
  342.                       Write('(revised BIOS)')
  343.                     else
  344.                       if romdate = '10/27/82' then
  345.                         Write('(HD, 640K, EGA supported)')
  346.                       else
  347.                         Write('clone');
  348.                   end;
  349.                 Writeln;
  350.                 end;
  351.           $FE : begin
  352.                 if Mem[$F000:$FFFD] = $43 then
  353.                   Writeln('Olivetti M240')
  354.                 else
  355.                   begin
  356.                   Write('PC-XT');
  357.                   if romdate = '11/08/82' then
  358.                     Write(' or Portable')
  359.                   else
  360.                     if romdate <> '08/16/82' then
  361.                       Write(' clone');
  362.                   Writeln;
  363.                   end;
  364.                 end;
  365.           $FD : Writeln('PCjr');
  366.           $FC : Writeln('PC-AT');
  367.           $9A : Writeln('Compaq XT or Compaq Plus');
  368.           $30 : Writeln('Sperry PC');
  369.           $2D : Writeln('Compaq PC or Compaq Deskpro')
  370.           else
  371.             unknown('machine - model byte', xbyte, 2)
  372.         end
  373.         end
  374.   end;
  375. (*  Byte 12:12 p. 174  *)
  376.   caption2('BIOS source');
  377.   if BIOSscan(PCROMseg, $C000, $FFFF, xword1) then
  378.     showBIOS(PCROMseg, xword1)
  379.   else
  380.     dontknow;
  381.   s:='';
  382.   for xword1:=rominfoofs + $0D to rominfoofs + $0F do
  383.     s:=s + Chr(Mem[rominfoseg: xword1]);
  384.   if s = 'PTL' then
  385.     begin
  386.     caption2('BIOS version');
  387.     Writeln(unbcd(Mem[rominfoseg:rominfoofs + $B]), decimal,
  388.             addzero(unbcd(Mem[rominfoseg:rominfoofs + $C])));
  389.     end;
  390.   caption2('BIOS date');
  391.   i:=$0005;
  392.   xbool:=false;
  393.   xchar:=Chr(Mem[$FFFF : i]);
  394.   while (i < $0010) and (xchar in pchar) do
  395.     begin
  396.     xbool:=true;
  397.     Write(xchar);
  398.     Inc(i);
  399.     xchar:=Chr(Mem[$FFFF : i])
  400.     end;
  401.   if xbool then
  402.     Writeln
  403.   else
  404.     dontknow;
  405.   caption2('BIOS extensions');
  406.   xword1:=BIOScseg;
  407.   xbool:=false;
  408.   for i:=0 to 94 do
  409.     begin
  410.     if (memw[xword1 : 0] = BIOSext) then
  411.       begin
  412.       if not xbool then
  413.         begin
  414.         Writeln;
  415.         Window(3, wherey + hi(windmin), twidth, tlength - 2);
  416.         caption1('Segment Size  Copyright notice');
  417.         Writeln;
  418.         xbool:=true
  419.         end;
  420.       pause2;
  421.       if endit then
  422.         Exit;
  423.       Write(hex(xword1, 4), '    ', ((longint(512) * Mem[xword1: 2]) div 1024):3, 'K  ');
  424.       if BIOSscan(xword1, $0000, $1FFF, xword2) then
  425.         showBIOS(xword1, xword2)
  426.       else
  427.         dontknow
  428.       end;
  429.     Inc(xword1, $0080)
  430.     end;
  431.   if not xbool then
  432.     Writeln('(none)')
  433.   end;
  434. end.
  435.