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