home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / info / systat.arc / SYS_STAT.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1987-05-20  |  16.4 KB  |  399 lines
  1. {SYS_STAT Version 1.0
  2.  
  3. Program to list equipment attached to a PC and provide additional information
  4. as to its general configuration.  Some provision is made to allow changes to
  5. the system configuration.  written by
  6.                       Bob MacDonald
  7.                       Rt #1, Box 859
  8.                       Lewisport, Ky 42351
  9.                       (502)295-3120
  10. Hope you find this program of some value.  Any comments as to your changes
  11. or suggested enhancements are welcome.}
  12.  
  13. program System_Status;
  14. {************************* Global Declarations ****************************}
  15. type
  16.     date      = record
  17.                   day, year, month, numday: integer;
  18.                 end;
  19.     str2      = string[2];
  20.     str3      = string[3];
  21.     str8      = string[8];
  22.     str25     = string[25];
  23.     str32     = string[32];
  24.     str40     = string[40];
  25.     str64     = string[64];
  26.     str80     = string[80];
  27.     int       = -32767..32767;
  28.  
  29. var
  30.    r               : record case integer of
  31.                      1 : (ax,bx,cx,dx,bp,si,di,ds,es,flags : integer);
  32.                      2 : (al,ah,bl,bh,cl,ch,dl,dh : byte);
  33.                      end;
  34.    d               : date;
  35.    option,max,i    : integer;
  36.    p,g,v,m,x,y,
  37.    ch,what         : char;
  38.    inserton        : boolean;
  39.    buffer          : str80;
  40.    error           : int;
  41.  
  42. const
  43. wk : string[63]='Sunday   Monday   Tuesday  WednesdayThursday Friday   Saturday ';
  44. monthst : string[36] = 'JanFebMarAprMayJunJulAugSepOctNovDec';
  45. completed : boolean = false;
  46. {**************************************************************************}
  47. {$I dataform.lib}
  48. {$I scrn_hlp.lib}
  49. {$I drv_data.lib}
  50. {$I bios.lib}
  51. {$I data_in.lib}
  52. {**************************************************************************}
  53. function equipment(which : char):byte;       {Determine attached equip.    }
  54. var                                 {NOTE: in order to isolate bits in a   }
  55.   result  : integer;                {register utilize SHL and SHR.  if you }
  56.   temp    : byte;                   {want the X's in this picture          }
  57. begin                               {xxxxxxXXxxxxxxxx first SHIFT LEFT 6 to}
  58.   intr($11,r);                      {get XXxxxxxxxx000000 and then SHIFT   }
  59.   result := r.ax;                   {RIGHT 14 for 00000000000000XX which   }
  60.   case upcase(which) of             {will yield the answer your after.     }
  61.     'P': temp := result shr 14;              {no. Printers                 }
  62.     'G': temp := (result shl 3) shr 15;      {no. Game ports               }
  63.     'R': temp := (result shl 4) shr 13;      {no. Rs232 ports              }
  64.     'V': temp := (result shl 10) shr 14;     {initial Video mode           }
  65.     'D': temp := (result shl 7) shr 15;      {Dma chip installed (Y/N)     }
  66.     'C': temp := (result shl 14) shr 15;     {math Coprocessor (Y/N)       }
  67.    end;
  68.    equipment := temp;
  69. end;
  70. {**************************************************************************}
  71. function k_available: real;                  {Ram available to DOS         }
  72. var avail : real;                            {NOTE: this program is loaded }
  73. begin                                        {and thus is deducted from the}
  74.       avail := memavail;                     {available RAM                }
  75.       if avail < 0 then avail := avail + 65536.0;
  76.       avail := avail*16;
  77.       k_available := avail;
  78. end;
  79. {**************************************************************************}
  80. function k_installed:real;                   {Installed Ram avail to DOS   }
  81. begin
  82.   with r do
  83.     begin
  84.       intr($12,r);
  85.       k_installed := r.ax;
  86.     end;
  87. end;
  88. {**************************************************************************}
  89. procedure clr_area;                          {clear bottom 7 lines of      }
  90. var i : integer;                             {screen for display of options}
  91. begin
  92.   for i := 0 to 6 do
  93.   begin
  94.     gotoxy(1,19 +i);clreol;
  95.   end;
  96. end;
  97. {**************************************************************************}
  98. procedure cursor(tln,bln : byte);              {cursor control..           }
  99. begin                                          {NOTE: this function is not }
  100.   with r do                                    {implemented on SANYO 55X   }
  101.     begin                                      {tln = top scan line        }
  102.       r.ah := 1;                               {bln = bottom scan line     }
  103.       r.ch := tln;
  104.       r.cl := bln;
  105.       intr($10,r);
  106.     end;
  107. end;
  108. {**************************************************************************}
  109. procedure disk_space;
  110. begin
  111. gotoxy(3,4);txt(1);writeln('Default Drive Data:');normvideo;
  112. gotoxy(3,5);write(dsk_format);
  113. gotoxy(3,6);write('Total Clusters       ');writeln(comma(abs(dsk_data('c'))
  114.       ,12,0));
  115. gotoxy(3,7);write('Bytes per Cluster    ');writeln(comma (dsk_data('b'),12,0));
  116. gotoxy(3,8);write('Bytes Free           ');writeln(comma (dsk_data('f'),12,0));
  117. gotoxy(3,9);write('Total Bytes          ');writeln(comma (dsk_data('t'),12,0));
  118. gotoxy(3,10);write('Percent Free            ');writeln(dsk_data('p'):8:2);
  119. gotoxy(3,11);write('Default Drive               ');
  120. write(def_drv);writeln(': ');
  121. end;
  122. {**************************************************************************}
  123. procedure getdate(var d: date);              {get system date              }
  124.    begin
  125.    r.ax := $2a00;                            {load 2Ah into the AH register}
  126.    MsDos (r);                                {request interrupt 21h        }
  127.    d.day    := lo(r.ax);
  128.    d.year   := r.cx;
  129.    d.month  := hi(r.dx);
  130.    d.numday := lo(r.dx);
  131. end;
  132. {**************************************************************************}
  133. procedure verify;                    {see if disk write verify is on or off}
  134.   begin                              {look in your AUTOEXEC.BAT file       }
  135.   r.ax := $5400;                             {load 54h into the AH register}
  136.   MsDos(r);                                  {request interrupt 21h        }
  137.   if lo(r.ax) = 0 then writeln('Verify is OFF');
  138.   if lo(r.ax) = 1 then writeln('Verify is ON ');
  139. end;
  140. {**************************************************************************}
  141. procedure set_verify;                {turn disk write verify on or off     }
  142. var status  : byte;
  143.     chng    : boolean;
  144.     old,new : str3;
  145. begin
  146.   r.ax := $5400;
  147.   msdos(r);
  148.   chng := odd(lo(r.ax));                      {if ON then true else false  }
  149.   if chng then old := ' ON' else old := 'OFF';
  150.   if chng then new := 'OFF' else new := ' ON';
  151.   if chng then status := 0 else status := 1;
  152.   clr_area;
  153.   write('Verify is presently ');r_video;
  154.   write(old);normvideo;txt(3);
  155.   write(' do you want to turn it ');r_video;
  156.   write(new);normvideo;
  157.   write(' ? (Y/N) ');
  158.   cursor(2,12);                               {create "BIG" cursor        }
  159.   repeat
  160.     read(kbd,ch);
  161.     ch := upcase(ch);
  162.     write(ch);
  163.   until (ch = #89) or (ch = #78);
  164.   cursor(48,13);                              {turn cursor off again      }
  165.   if (ch = #78) then exit;
  166.     r.ax := $2E shl 8 + status;               {ah = 2EH and al = 1 or 0   }
  167.     r.dx := $0 shr 8;                         {dl = 0                     }
  168.     msdos(r);
  169.   gotoxy(43,15);verify;
  170. end;
  171. {**************************************************************************}
  172. procedure controlbrk;                {see if control-break is set or not   }
  173.   begin                              {look in your CONFIG.SYS file         }
  174.   r.ax := $3300;                             {load 33h into the AH register}
  175.   MsDos(r);                                  {request interrupt 21h        }
  176.   if lo(r.dx) = 0 then writeln('Ctrl-Break is OFF');
  177.   if lo(r.dx) = 1 then writeln('Ctrl-Break is ON ');
  178. end;
  179. {**************************************************************************}
  180. procedure set_ctrl_break;            {turn control-break on or off         }
  181. var status  : byte;                  {NOTE: this procedure is vertually    }
  182.     chng    : boolean;               {identical to 'set_verify'            }
  183.     old,new : string[3];
  184. begin
  185.   r.ax := $3300;
  186.   msdos(r);
  187.   chng := odd(lo(r.dx));
  188.   if chng then old := ' ON' else old := 'OFF';
  189.   if chng then new := 'OFF' else new := ' ON';
  190.   if chng then status := 00 else status := 01;
  191.   clr_area;
  192.   write('Control-Break is presently ');r_video;
  193.   write(old);normvideo;txt(3);
  194.   write(' do you want to turn it ');r_video;
  195.   write(new);normvideo;
  196.   write(' ? (Y/N) ');
  197.   cursor(2,12);                                  {create large cursor}
  198.   repeat
  199.     read(kbd,ch);
  200.     ch := upcase(ch);
  201.     write(ch);
  202.   until (ch = #89) or (ch = #78);
  203.   cursor(48,13);                                 {turn cursor off again}
  204.   if (ch = #78) then exit;
  205.     r.ax := $33 shl 8 + 01;
  206.     r.dl := status;
  207.     msdos(r);
  208.   gotoxy(43,16);controlbrk;
  209. end;
  210. {**************************************************************************}
  211. procedure dos;                            {get DOS version number          }
  212. begin
  213.   r.ax := $3000;                          {set AH=30h and AL=00h           }
  214.   MsDos(r);                               {request interrupt 21h           }
  215.   writeln('DOS Version                  ',r.ax and $00ff,'.',r.ax shr 8);
  216. end;
  217. {**************************************************************************}
  218. procedure time;                           {get and display the system time }
  219. var
  220.   hour,sec,
  221.   min, hund  : integer;
  222.   ampm       : str2;
  223. begin
  224.   r.ax := $2C00;                          {set AH = 2CH                    }
  225.   MsDos(r);
  226.   hour := hi(r.cx);                       {CH contains the hour            }
  227.   min  := lo(r.cx);                       {CL contains the minutes         }
  228.   sec  := hi(r.dx);                       {DH contains the seconds         }
  229.   hund := lo(r.dx);                       {DL contains 1/100 seconds       }
  230.   if hour < 12 then ampm := 'AM' else ampm := 'PM';
  231.   if hour > 12 then hour := hour - 12;
  232.   txt(15);gotoxy(69,2);
  233.   write(hour,':',min);txt(3);write(' ',ampm);
  234. end;
  235. {**************************************************************************}
  236. procedure box_scrn;                   {box screen for data display         }
  237. begin
  238.   gotoxy(1,1);write(chr(201));
  239.   horzln(2,1,27,205);txt(15);write('[ System Status Report ]');
  240.   txt(3);
  241.   horzln(54,1,27,205);
  242.   gotoxy(80,1);write(chr(187));
  243.   gotoxy(1,2);write(chr(186));
  244.   gotoxy(80,2);write(chr(186));
  245.   gotoxy(1,3);write(chr(204));
  246.   horzln(2,3,38,205);
  247.   gotoxy(40,3);write(chr(203));
  248.   horzln(41,3,39,205);
  249.   gotoxy(80,3);write(chr(185));
  250.   vertln(1,4,9,186);
  251.   vertln(40,4,9,186);
  252.   vertln(80,4,9,186);
  253.   gotoxy(1,13);write(chr(199));
  254.   horzln(2,13,38,196);
  255.   gotoxy(40,13);write(chr(208));
  256.   horzln(41,13,24,196);
  257.   gotoxy(65,13);write(chr(210));
  258.   horzln(66,13,14,196);
  259.   vertln(1,14,4,186);
  260.   vertln(80,14,4,186);
  261.   vertln(65,14,4,186);
  262.   gotoxy(80,13);write(chr(182));
  263.   gotoxy(1,18);write(chr(200));
  264.   horzln(2,18,63,205);
  265.   gotoxy(65,18);write(chr(202));
  266.   horzln(66,18,14,205);
  267.   gotoxy(80,18);write(chr(188));
  268. end;
  269. {**************************************************************************}
  270. procedure key_stat(which :char);                 {check status of key locks}
  271. var result : integer;
  272.     temp   : byte;
  273.     on     : boolean;
  274. begin
  275.   r.ax := $0200;
  276.   intr($16,r);
  277.   result := lo(r.ax);                            {temp = 0 for off and}
  278.   case upcase(which) of                          {temp = 1 for on     }
  279.     'S' : temp := (result shl 3) shr 7;          {scroll lock }
  280.     'N' : temp := (result shl 2) shr 7;          {num lock}
  281.     'C' : temp := (result shl 1) shr 7;          {Caps lock}
  282.     'I' : temp := result shl 7;                  {insert}
  283.   end;
  284.   on := odd(temp);
  285.   if on then write(' ON') else write('OFF');
  286. end;
  287. {**************************************************************************}
  288. procedure show_key_status;                     {display the key lock status}
  289. begin
  290.   gotoxy(66,14);txt(1);write(' Key Locks: ');txt(15);
  291.   gotoxy(67,15);write('Scroll - ');gotoxy(76,15);key_stat('s');
  292.   gotoxy(67,16);write('Num    - ');gotoxy(76,16);key_stat('n');
  293.   gotoxy(67,17);write('Caps   - ');gotoxy(76,17);key_stat('c');
  294. end;
  295. {**************************************************************************}
  296. procedure big_txt_option;                   {use extended character set to }
  297. begin                                       {spell the word "OPTION"       }
  298. gotoxy(8,20);write(chr(201),chr(205),chr(187),' ',chr(201),chr(205),chr(187)
  299.                    ,' ',chr(201),chr(203),chr(187),' ',chr(203),' ',chr(201)
  300.                     ,chr(205),chr(187),' ',chr(204),chr(205),chr(187),' ',
  301.                     chr(201),chr(205),chr(187),' ',chr(254));
  302. gotoxy(8,21);write(chr(186),' ',chr(186),' ',chr(204),chr(205),chr(188),
  303.                   '  ',chr(186),'  ',chr(186),' ',chr(186),' ',chr(186),' ',
  304.                   chr(186),' ',chr(186),' ',chr(200),chr(205),chr(187));
  305. gotoxy(8,22);write(chr(200),chr(205),chr(188),' ',chr(208),'    ',chr(208),
  306.                     '  ',chr(202),' ',chr(200),chr(205),chr(188),' ',
  307.                     chr(208),' ',chr(208),' ',chr(200),chr(205),chr(188),
  308.                     ' ',chr(254));
  309. end;
  310. {**************************************************************************}
  311. procedure exit_prg;                  {clean-up first and then exit program }
  312. begin
  313.   cursor(12,13);                                     { turn cursor back on }
  314.   normvideo;                               { restore initial screen colors }
  315.   clrscr;                                            { clear screen        }
  316.   completed := true;                                 { exit to DOS         }
  317. end;
  318. {**************************************************************************}
  319. procedure change_drvs;                     {select a new default drive     }
  320. var n_drv : char;
  321. begin
  322.   clr_area;
  323.   gotoxy(32,22);write('Enter new drive ');
  324.   cursor(2,12);                            {create "BIG" cursor            }
  325.     read(kbd,n_drv);
  326.     n_drv := upcase(n_drv);
  327.     write(n_drv,':');
  328.   cursor(48,13);                           {turn cursor off again         }
  329.   chng_def(n_drv);
  330.   disk_space;
  331. end;
  332. {**************************************************************************}
  333. procedure menu;
  334. begin
  335.     clr_area;
  336.     txt(15);big_txt_option;
  337.     gotoxy(38,20);writeln('    Change DEFAULT drive');
  338.     gotoxy(38,21);writeln('    Set VERIFY switch');
  339.     gotoxy(38,22);writeln('    Set CONTROL-BREAK switch');
  340.     gotoxy(38,23);writeln('    QUIT');
  341.     choice := query(4,38,20,4);
  342.     case choice of
  343.       1 : change_drvs;
  344.       2 : set_verify;
  345.       3 : set_ctrl_break;
  346.       4 : exit_prg;
  347.       else menu;
  348.     end;
  349. end;
  350. {********************** MAIN PROGRAM **************************************}
  351. begin
  352.   clrscr;
  353.   txt(3);                                     {lowvideo                    }
  354.   cursor(48,13);                              {turn the cursor off         }
  355.   box_scrn;
  356.   gotoxy(2,2);write('Today is ');txt(15);
  357.   getdate(d);
  358.   write(copy(wk,9*d.day+1,9),' ');
  359.   write(copy(monthst,3*d.month-2,3),d.numday:3,',',d.year:4);
  360.   txt(3);gotoxy(57,2);write('The time is ');time;
  361.   disk_space;
  362.   gotoxy(3,14);txt(1);writeln('System Information:');txt(15);
  363.   gotoxy(3,15);dos;
  364.   gotoxy(3,16);writeln('ROM BIOS Ver. Date       ',biosver);
  365.   gotoxy(3,17);write('BIOS (c) -');strip(copywrite);
  366.   gotoxy(43,15);verify;
  367.   gotoxy(43,16);controlbrk;
  368.   show_key_status;
  369.   gotoxy(43,4);txt(1);writeln('Equipment List:');txt(15);
  370.   gotoxy(42,5);writeln(' Computer Model      ',sysmodel);
  371.   gotoxy(42,6);writeln(' No. of Printers     ',equipment('p'));
  372.   gotoxy(42,7);write(' DMA Chip            ');
  373.      case equipment('d') of
  374.        1 : writeln('NO');
  375.        0 : writeln('YES');
  376.      end;
  377.   gotoxy(42,8);write(' Math Coprocessor    ');
  378.      case equipment('c') of
  379.        0 : writeln('NO');
  380.        1 : writeln('YES');
  381.      end;
  382.   gotoxy(42,9);writeln(' No. of RS232 Ports  ',equipment('r'));
  383.   gotoxy(42,10);write(' Initial Video Mode  ');
  384.      case equipment('v') of
  385.        1: writeln('40x25 COLOR');
  386.        2: writeln('80x25 COLOR');
  387.        3: writeln('80x25 MONO');
  388.      end;
  389.   gotoxy(42,11);writeln(' Installed Ram       ',comma((k_installed*1024),7,0)
  390.                        ,' bytes');
  391.   gotoxy(42,12);writeln(' Available Ram       ',comma(k_available,7,0),
  392.                         ' bytes');
  393.   txt(3);
  394. completed := false;
  395. while not completed do
  396.  begin
  397.    menu;
  398.  end;
  399. end.