home *** CD-ROM | disk | FTP | other *** search
/ Best Objectech Shareware Selections / UNTITLED.iso / boss / util / misc / 011 / page_01.pas < prev    next >
Pascal/Delphi Source File  |  1992-12-29  |  14KB  |  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