home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / DOOG / INFOP131.ZIP / INFOPLUS.PAS < prev    next >
Pascal/Delphi Source File  |  1990-09-04  |  15KB  |  734 lines
  1. (*
  2. **  INFOPLUS.PAS
  3. **
  4. **  Version 1.31 by Andrew Rossmann 9/4/90
  5. *)
  6.  
  7. (*$A-,B-,D-,L-,F-,I-,N-,O-,R-,S-,V-*)
  8. (*$M 16384, 0, 0*)
  9. program INFOPLUS;
  10.  
  11. uses
  12.   crt, dos, graph;
  13.  
  14. const
  15.   qversion = 'Version 1.31A';
  16.   qdate = 'September 4, 1990';
  17.   BIOSdseg = $0040;
  18.   pgmax = 17;
  19.   pchar = [' '..'~'];
  20.   secsiz = 1024;
  21.   tick1 = 1193180;
  22.  
  23. type
  24.   cpu_info_t = record
  25.     cpu_type : byte;
  26.     MSW : word;
  27.     GDT : array[1..6] of byte;
  28.     IDT : array[1..6] of byte;
  29.     intflag : boolean;
  30.     ndp_type : byte;
  31.     ndp_cw : word;
  32.     weitek: byte;
  33.     test_type: char
  34.   end;
  35.   char2 = string[2];
  36.  
  37. var
  38.   attrsave : byte;
  39.   country : array[0..33] of byte;
  40.   currdrv : byte;
  41.   devofs : word;
  42.   devseg : word;
  43.   dirsep : set of char;
  44.   DOScofs : word;
  45.   DOScseg : word;
  46.   DOSmem : longint;
  47.   equip : word;
  48.   graphdriver : integer;
  49.   i : word;
  50.   intvec : array[$00..$FF] of pointer;
  51.   lastdrv : byte;
  52.   osmajor : byte;
  53.   osminor : byte;
  54.   pg : 0..pgmax;
  55.   regs : registers;
  56.   switchar : char;
  57.   tlength : byte;
  58.   twidth : byte;
  59.   vidpg : byte;
  60.   x1 : byte;
  61.   x2 : byte;
  62.   xbool1 : boolean;
  63.   xbool2 : boolean;
  64.   xchar1 : char;
  65.   xchar2 : char;
  66.   xword : word;
  67.   gotcountry: boolean;
  68.   c2: char2;
  69.   endit: boolean;
  70.   ccode: word;
  71.   mono: boolean;
  72.   vidmode: word;
  73.  
  74. (*$L INFOPLUS*)
  75.  
  76. {These first two procedures filter the color commands to allow Black&White}
  77. procedure TextColor(color: byte);
  78.   var
  79.     temp: byte;
  80.   begin
  81.   if mono then
  82.     begin
  83.     case (color and $0F) of
  84.       0: temp:=0;
  85.       1..7: temp:=7;
  86.       8..15: temp:=15
  87.       end;
  88.     if color > 15 then
  89.       temp:=temp + Blink;
  90.     end
  91.   else
  92.     temp:=color;
  93.   Crt.TextColor(temp)
  94.   end; {TextColor}
  95.  
  96. procedure TextBackground(color: byte);
  97.   var
  98.     temp: byte;
  99.   begin
  100.   temp:=color;
  101.   if mono and (color < 7) then
  102.     temp:=0;
  103.   Crt.TextBackground(temp);
  104.   end; {TextBackground}
  105.  
  106. function getkey2: char2;
  107.   var
  108.     c: char;
  109.     c2: char2;
  110.  
  111.   begin
  112.   c:=ReadKey;
  113.   if c = #0 then
  114.     getkey2:=c + ReadKey
  115.   else
  116.     getkey2:=c;
  117.   end; {getkey2}
  118.  
  119. {^Make sure number entered, not any letters}
  120. function getnum: word;
  121.   var
  122.     inpchar: char;
  123.     number_string: string[2];
  124.     temp, position, code: word;
  125.     row, col: byte;
  126.     finish: boolean;
  127.  
  128.   begin
  129.   row:=WhereY;
  130.   col:=WhereX;
  131.   Write(' ':3);
  132.   GotoXY(col, row);
  133.   temp:=99;
  134.   finish:=false;
  135.   position:=0;
  136.   number_string:='';
  137.   TextColor(LightGray);
  138.   repeat
  139.     inpchar:=ReadKey;
  140.     case inpchar of
  141.       '0'..'9':if position < 2 then
  142.         begin
  143.         Inc(position);
  144.         Inc(number_string[0]);
  145.         number_string[position]:=inpchar;
  146.         Write(inpchar)
  147.         end;
  148.       #8: if position > 0 then
  149.         begin
  150.         Dec(position);
  151.         Dec(number_string[0]);
  152.         Write(^H' '^H)
  153.         end;
  154.       #27: if number_string = '' then
  155.           finish:=true
  156.         else
  157.           begin
  158.           number_string:='';
  159.           GotoXY(col, row);
  160.           ClrEol;
  161.           position:=0
  162.           end;
  163.       #13: finish:=true
  164.     end {case}
  165.   until finish;
  166.   if number_string <> '' then
  167.     Val(number_string, temp, code);
  168.   getnum:=temp
  169.   end; {getnum}
  170.  
  171. procedure caption1(a: string);
  172.   begin
  173.   textcolor(LightGray);
  174.   write(a);
  175.   textcolor(LightCyan)
  176.   end; {caption1}
  177.  
  178. procedure caption2(a: string);
  179.   const
  180.     capterm = ': ';
  181.  
  182.   var
  183.     i: byte;
  184.     xbool: boolean;
  185.  
  186.   begin
  187.   i:=length(a);
  188.   while (i > 0) and (a[i] = ' ') do
  189.     dec(i);
  190.   insert(capterm, a, i + 1);
  191.   caption1(a)
  192.   end; {caption2}
  193.  
  194. function nocarry : boolean;
  195.   begin
  196.   nocarry:=regs.flags and fcarry = $0000
  197.   end; {nocarry}
  198.  
  199. function hex(a : word; b : byte) : string;
  200.   const
  201.     digit : array[$0..$F] of char = '0123456789ABCDEF';
  202.  
  203.   var
  204.     i : byte;
  205.     xstring : string;
  206.  
  207.   begin
  208.   xstring:='';
  209.   for i:=1 to b do
  210.     begin
  211.     insert(digit[a and $000F], xstring, 1);
  212.     a:=a shr 4
  213.     end;
  214.   hex:=xstring
  215.   end; {hex}
  216.  
  217. procedure unknown(a : string; b : word; c : byte);
  218.   begin
  219.   writeln('(unknown', ' ', a, ' ', hex(b, c), ')')
  220.   end; {unknown}
  221.  
  222. procedure caption3(a : string);
  223.   begin
  224.   caption2('  ' + a)
  225.   end; {caption3}
  226.  
  227. procedure yesorno(a : boolean);
  228.   begin
  229.   if a then
  230.     writeln('yes')
  231.   else
  232.     writeln('no')
  233.   end; {yesorno}
  234.  
  235. procedure yesorno2(a: boolean);
  236.   begin
  237.   if a then
  238.     Write('yes')
  239.   else
  240.     Write('no')
  241.   end; {yesorno2}
  242.  
  243. procedure dontknow;
  244.   begin
  245.   writeln('(unknown)')
  246.   end; {dontknow}
  247.  
  248. procedure segofs(a, b : word);
  249.   begin
  250.   write(hex(a, 4), ':', hex(b, 4))
  251.   end; {segofs}
  252.  
  253. function showchar(a : char) : char;
  254.   begin
  255.   if a in pchar then
  256.     showchar:=a
  257.   else
  258.     showchar:='.'
  259.   end; {showchar}
  260.  
  261. procedure pause1;
  262.   var
  263.     xbyte : byte;
  264.     xchar : char2;
  265.     savex, savey: byte;
  266.  
  267.   begin
  268.   xbyte:=textattr;
  269.   endit:=false;
  270.   textcolor(Cyan);
  271.   savex:=WhereX;
  272.   savey:=WhereY;
  273.   Write('( for more)');
  274.   xchar:=getkey2;
  275.   if xchar <> #0#80 then
  276.     begin
  277.     endit:=true;
  278.     c2:=xchar
  279.     end;
  280.   textattr:=xbyte;
  281.   GotoXY(savex, savey);
  282.   Write('            ')
  283.   end; {pause1}
  284.  
  285. procedure pause2;
  286.   var
  287.     xbyte : byte;
  288.  
  289.   begin
  290.   if wherey + hi(windmin) > hi(windmax) then
  291.     begin
  292.     xbyte:=TextAttr;
  293.     TextColor(Cyan);
  294.     pause1;
  295.     clrscr;
  296.     writeln('(continued)');
  297.     textattr:=xbyte
  298.     end
  299.   end; {pause2}
  300.  
  301. procedure pause3(extra: byte);
  302.   var
  303.     xbyte: byte;
  304.   begin
  305.   if WhereY + Hi(WindMin) + extra > Hi(WindMax) then
  306.     begin
  307.     xbyte:=TextAttr;
  308.     TextColor(Cyan);
  309.     pause1;
  310.     ClrScr;
  311.     Writeln('(continued)');
  312.     TextAttr:=xbyte
  313.     end
  314.   end; {pause3}
  315.  
  316. function bin4(a : byte) : string;
  317.   const
  318.     digit : array[0..1] of char = '01';
  319.  
  320.   var
  321.     xstring : string;
  322.     i : byte;
  323.  
  324.   begin
  325.   xstring:='';
  326.   for i:=3 downto 0 do
  327.     begin
  328.     insert(digit[a mod 2], xstring, 1);
  329.     a:=a shr 1
  330.     end;
  331.   bin4:=xstring
  332.   end; {bin4}
  333.  
  334. procedure offoron(a : string; b : boolean);
  335.   begin
  336.   caption3(a);
  337.   if b then
  338.     writeln('on')
  339.   else
  340.     writeln('off')
  341.   end; {offoron}
  342.  
  343. procedure zeropad(a : word);
  344.   begin
  345.   if a < 10 then
  346.     write('0');
  347.   write(a)
  348.   end; {zeropad}
  349.  
  350. procedure showvers;
  351.   var
  352.     xchar : char;
  353.  
  354.   begin
  355.   xchar:=chr(country[9]);
  356.   if osmajor > 0 then
  357.     begin
  358.     write(osmajor, xchar);
  359.     zeropad(osminor);
  360.     writeln
  361.     end
  362.   else
  363.     writeln('1', xchar, 'x')
  364.   end; {showvers}
  365.  
  366. function cbw(a, b : byte) : word;
  367.   begin
  368.   cbw:=word(b) shl 8 + a
  369.   end; {cbw}
  370.  
  371. function bin16(a : word) : string;
  372.   function bin8(a : byte) : string;
  373.     begin
  374.     bin8:=bin4(a shr 4) + '_' + bin4(a and $0F)
  375.     end; {bin8}
  376.  
  377.   begin {bin16}
  378.   bin16:=bin8(hi(a)) + '_' + bin8(lo(a))
  379.   end; {bin16}
  380.  
  381. procedure drvname(a : byte);
  382.   begin
  383.   write(chr(ord('A') + a), ': ')
  384.   end; {drvname}
  385.  
  386. procedure media(a, b : byte);
  387.   procedure diskette(a, b, c : byte);
  388.     begin
  389.     writeln('floppy ', a, ' side, ', b, ' sctr, ', c, ' trk')
  390.     end; {diskette}
  391.  
  392.   begin {media}
  393.   caption3('Media');
  394.   case a of
  395.     $FF : diskette(2, 8, 40);
  396.     $FE : diskette(1, 8, 40);
  397.     $FD : diskette(2, 9, 40);
  398.     $FC : diskette(1, 9, 40);
  399.     $F9 : if b = 1 then
  400.       diskette(2, 15, 80)
  401.     else
  402.       diskette(2, 9, 80);
  403.     $F8 : writeln('fixed disk');
  404.     $F0 : diskette(2, 18, 80)
  405.     else
  406.       unknown('media', a, 2)
  407.   end
  408.   end; {media}
  409.  
  410. procedure pagenameclr;
  411.   var
  412.     xbyte: byte;
  413.  
  414.   begin
  415.   xbyte:=TextAttr;
  416.   Window(x1, tlength, x2 - 1, tlength);
  417.   TextColor((TextAttr and $70) shr 4);
  418.   ClrScr;
  419.   TextAttr:=xbyte;
  420.   Window(1, 1, twidth, tlength)
  421.   end; {pagenameclr}
  422.  
  423. {$F+}
  424. procedure CPUID(var a : cpu_info_t);  external;
  425.  
  426. function diskread(drive : byte; starting_sector, number_of_sectors : word
  427.   ; var buffer) : word;  external;
  428.  
  429. procedure longcall(addr: longint; var regs: registers); external;
  430.  
  431. function ATIinfo(data_in: byte; register: word): byte; external;
  432.  
  433. procedure AltIntr(intno: byte; var regs: registers); external;
  434.  
  435. procedure AltMsDos(var regs: registers); external;
  436. {$F-}
  437.  
  438. procedure Intr(intno: byte; var regs: registers);
  439.   begin
  440.   AltIntr(intno, regs)
  441.   end;
  442.  
  443. procedure MsDos(var regs: registers);
  444.   begin
  445.   AltMsDos(regs)
  446.   end;
  447.  
  448. procedure init;
  449.   var
  450.     xint : integer;
  451.  
  452.   procedure rjustify(a : string);
  453.     begin
  454.     gotoxy(1 + lo(windmax) - length(a), wherey);
  455.     x2:=WhereX;
  456.     write(a)
  457.     end; {rjustify}
  458.  
  459.   procedure border(ch: char);
  460.     var
  461.       i : byte;
  462.  
  463.     begin
  464.     TextColor(LightCyan);
  465.     for i:=1 to twidth do
  466.       write(ch);
  467.     TextColor(LightGray);
  468.     end; {border}
  469.  
  470.   begin {init}
  471.   mono:=false;
  472.   vidmode:=LastMode;
  473.   attrsave:=textattr;
  474.   if (Lo(LastMode) = 0) or (Lo(LastMode) = 1) then
  475.     TextMode(LastMode + 2);
  476.   with regs do
  477.     begin
  478.     AH:=$0F;
  479.     intr($10, regs);
  480.     twidth:=AH;
  481.     vidpg:=BH
  482.     end;
  483.   detectgraph(graphdriver, xint);
  484.   if (graphdriver = EGA) or (graphdriver = MCGA) or (graphdriver = VGA) then
  485.     with regs do
  486.       begin
  487.       AX:=$1130;
  488.       BH:=$00;
  489.       intr($10, regs);
  490.       tlength:=DL + 1;
  491.       CheckSnow:=False;
  492.       end
  493.   else
  494.     tlength:=25;
  495.   with regs do
  496.     begin
  497.     intr($11, regs);
  498.     equip:=AX;
  499.     intr($12, regs);
  500.     DOSmem:=longint(AX) shl 10;
  501.     AH:=$19;
  502.     MSDOS(regs);
  503.     currdrv:=AL;
  504.     AH:=$34;
  505.     MSDOS(regs);
  506.     DOScseg:=ES;
  507.     DOScofs:=BX
  508.     end;
  509.   for i:=$00 to $FF do
  510.     getintvec(i, intvec[i]);
  511.   intvec[$00]:=saveint00;
  512.   intvec[$02]:=saveint02;
  513.   intvec[$1B]:=saveint1B;
  514.   intvec[$23]:=saveint23;
  515.   intvec[$24]:=saveint24;
  516.   intvec[$34]:=saveint34;
  517.   intvec[$35]:=saveint35;
  518.   intvec[$36]:=saveint36;
  519.   intvec[$37]:=saveint37;
  520.   intvec[$38]:=saveint38;
  521.   intvec[$39]:=saveint39;
  522.   intvec[$3A]:=saveint3A;
  523.   intvec[$3B]:=saveint3B;
  524.   intvec[$3C]:=saveint3C;
  525.   intvec[$3D]:=saveint3D;
  526.   intvec[$3E]:=saveint3E;
  527.   intvec[$3F]:=saveint3F;
  528.   intvec[$75]:=saveint75;
  529.   with regs do
  530.     begin
  531.     AX:=$3700;
  532.     MSDOS(regs);
  533.     switchar:=chr(DL)
  534.     end;
  535.   dirsep:=['\'];
  536.   if switchar <> '/' then
  537.     dirsep:=dirsep + ['/'];
  538.   with regs do
  539.     begin
  540.     AH:=$52;
  541.     MSDOS(regs);
  542.     devseg:=ES;
  543.     devofs:=BX
  544.     end;
  545.   lastdrv:=mem[devseg : devofs + $0021];
  546.   if (Lo(LastMode) = 2) or (Lo(LastMode) = 7) then
  547.     mono:=true;
  548.   TextBackground(Blue);
  549.   clrscr;
  550.   textcolor(LightGreen);
  551.   write('INFO+');
  552.   textcolor(lightgray);
  553.   write(' - Information on all computer functions');
  554.   rjustify(qversion);
  555.   writeln;
  556.   border(#223);
  557.   gotoxy(1, tlength - 1);
  558.   border(#220);
  559.   write('Page ');
  560.   x1:=wherex;
  561.   textcolor(Lightgreen);
  562.   rjustify('Enter PgUp PgDn Home End Esc');
  563.   pg:=0;
  564.   endit:=false;
  565.   if osmajor >= 3 then
  566.     with regs do
  567.       begin
  568.       AX:=$3800;
  569.       DS:=seg(country);
  570.       DX:=ofs(country);
  571.       MSDOS(regs);
  572.       ccode:=BX
  573.       end;
  574.   end; {init}
  575.  
  576. {$I PAGE_00.INC}
  577. {$I PAGE_01.INC}
  578. {$I PAGE_02.INC}
  579. {$I PAGE_03.INC}
  580. {$I PAGE_04.INC}
  581. {$I PAGE_05.INC}
  582. {$I PAGE_06.INC}
  583. {$I PAGE_07.INC}
  584. {$I PAGE_08.INC}
  585. {$I PAGE_09.INC}
  586. {$I PAGE_10.INC}
  587. {$I PAGE_11.INC}
  588. {$I PAGE_12.INC}
  589. {$I PAGE_13.INC}
  590. {$I PAGE_14.INC}
  591. {$I PAGE_15.INC}
  592. {$I PAGE_16.INC}
  593. {$I PAGE_17.INC}
  594.  
  595. begin
  596.   xword:=dosversion;
  597.   osmajor:=lo(xword);
  598.   osminor:=hi(xword);
  599.   if osmajor >= 3 then
  600.     begin
  601.     init;
  602.     xbool1:=false;
  603.     repeat
  604.       pagenameclr;
  605.       gotoxy(x1, tlength);
  606.       textcolor(lightgray);
  607.       write(pg:2, ' - ');
  608.       case pg of
  609.         0 : Write('Table of Contents');
  610.         1 : Write('Machine & ROM Identification');
  611.         2 : Write('CPU Identification');
  612.         3 : Write('RAM Identification');
  613.         4 : Write('Memory Block Listing');
  614.         5 : Write('Video Identification');
  615.         6 : Write('Video Information');
  616.         7 : Write('Keyboard & Mouse Information');
  617.         8 : Write('Parallel/Serial Port Information');
  618.         9 : Write('DOS Information');
  619.         10: Write('Multiplex Programs');
  620.         11: Write('Environment Variables');
  621.         12: Write('Device Drivers');
  622.         13: Write('DOS Drive Information');
  623.         14: Write('BIOS Drive Information');
  624.         15: Write('Partition Table Listing');
  625.         16: Write('Boot info & DOS drive parameters');
  626.         17: Write('Thanks');
  627.       end;
  628.       window(1, 3, twidth, tlength - 2);
  629.       clrscr;
  630.       case pg of
  631.         0 : page_00;
  632.         1 : page_01;
  633.         2 : page_02;
  634.         3 : page_03;
  635.         4 : page_04;
  636.         5 : page_05;
  637.         6 : page_06;
  638.         7 : page_07;
  639.         8 : page_08;
  640.         9 : page_09;
  641.         10 : page_10;
  642.         11 : page_11;
  643.         12 : page_12;
  644.         13 : page_13;
  645.         14 : page_14;
  646.         15 : page_15;
  647.         16 : page_16;
  648.         17 : page_17
  649.       end;
  650.       window(1, 1, twidth, tlength);
  651.       gotoxy(x2 - 1, tlength);
  652.       xbool2:=false;
  653.       repeat
  654.         if not endit then
  655.           begin
  656.           repeat
  657.           until keypressed;
  658.           xchar1:=readkey;
  659.           if keypressed then
  660.             xchar2:=readkey
  661.           else
  662.             xchar2:=#0;
  663.           end
  664.         else
  665.           begin
  666.           endit:=false;
  667.           xchar1:=c2[1];
  668.           if Length(c2) = 1 then
  669.             xchar2:=#0
  670.           else
  671.             xchar2:=c2[2]
  672.           end;
  673.         if (xchar1 = #27) and (xchar2 = #0) then
  674.           begin
  675.           xbool2:=true;
  676.           xbool1:=true
  677.           end;
  678.         if (xchar1 = #13) and (xchar2 = #0) then
  679.           begin
  680.           pagenameclr;
  681.           GotoXY(x1, tlength);
  682.           TextColor(White);
  683.           Write('Go to page no.=> ');
  684.           i:=getnum;
  685.           if (i >= 0 ) and (i <= pgmax) then
  686.             begin
  687.             pg:=i;
  688.             xbool2:=true
  689.             end;
  690.           pagenameclr
  691.           end;
  692.         if xchar1 = #0 then
  693.           case xchar2 of
  694.             #71: begin
  695.                  xbool2:=true;
  696.                  pg:=0
  697.                  end;
  698.             #73: if pg > 0 then
  699.                    begin
  700.                    xbool2:=true;
  701.                    Dec(pg)
  702.                    end;
  703.             #79: begin
  704.                  xbool2:=true;
  705.                  pg:=pgmax
  706.                  end;
  707.             #81: if pg < pgmax then
  708.                    begin
  709.                    xbool2:=true;
  710.                    Inc(pg)
  711.                    end;
  712.           end;
  713.       if not xbool2 then
  714.         begin
  715.         Sound(220);
  716.         Delay(100);
  717.         NoSound
  718.         end
  719.       until xbool2
  720.     until xbool1;
  721.     textattr:=attrsave;
  722.     TextMode(vidmode);
  723.     clrscr
  724.   end
  725. else
  726.   begin
  727.   writeln;
  728.   country[9]:=Ord('.');
  729.   writeln('INFOPLUS requires DOS version 3.0 or later');
  730.   write('Your DOS version is ');
  731.   showvers
  732.   end
  733. end.
  734.