home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-385-Vol-1of3.iso / i / ifp1s156.zip / PAGE_17.PAS < prev    next >
Pascal/Delphi Source File  |  1992-12-30  |  5KB  |  169 lines

  1. unit page_17;
  2.  
  3. interface
  4.  
  5. uses crt, ifpglobl, ifpcomon;
  6.  
  7. procedure page17;
  8.  
  9. implementation
  10.  
  11. procedure page17;
  12.   const
  13.     DayName: array[0..7] of string[9] = ('Sunday', 'Monday', 'Tuesday',
  14.                                          'Wednesday', 'Thursday', 'Friday',
  15.                                          'Saturday', 'Sunday');
  16.     MonthName: array[0..12] of string[9] = ('???', 'January', 'February', 'March',
  17.                                             'April', 'May', 'June', 'July',
  18.                                             'August', 'September', 'October',
  19.                                             'November', 'December');
  20.     ScreenName: array[0..3] of string[10] = ('EGA/VGA', 'CGA 40col',
  21.                                                  'CGA 80col', 'Monochrome');
  22.     FloppyName: array[0..5] of string[11] = ('none', '5.25" 360K',
  23.                                              '5.25" 1.2M', '3.5"  720K',
  24.                                              '3.5"  1.44M', '3.5"  2.88M');
  25.  
  26.   var
  27.     CMOSport: word;
  28.     count, checksum1, checksum2: word;
  29.     bad, pm: boolean;
  30.     floppy, hd, hdc, hdd, date, month, century, year, hour, min, sec: byte;
  31.     c: char;
  32.     xbyte1, xbyte2, xbyte3: byte;
  33.  
  34.   function readCMOS(adr: byte): byte;
  35.     var
  36.       i: byte;
  37.  
  38.     begin
  39.     inline($FA);
  40.     Port[CMOSport]:=adr;
  41.     for i:=1 to 10 do;
  42.     readCMOS:=Port[CMOSport + 1];
  43.     inline($FB)
  44.     end; {readCMOS}
  45.  
  46.   procedure writeCMOS(adr, data: byte);
  47.     var
  48.       i: byte;
  49.  
  50.     begin
  51.     inline($FA);
  52.     Port[CMOSport]:=adr;
  53.     for i:=1 to 10 do;
  54.     Port[CMOSport + 1]:=data;
  55.     inline($FB)
  56.     end; {writeCMOS}
  57.  
  58.   begin
  59.   caption2('CMOS');
  60. {!! This check failed on an IBM PC, possibly due to an oddball card.
  61.     If anyone has a reliable detection method, please let me know.
  62.   CMOSport:=$70;
  63.   xbyte1:=readCMOS(6);
  64.   writeCMOS(6, $AA);
  65.   xbyte2:=readCMOS(6);
  66.   writeCMOS(6, $55);
  67.   xbyte3:=readCMOS(6);
  68.   writeCMOS(6, xbyte1);
  69.   if (xbyte2 = $AA) and (xbyte3 = $55) then
  70.     begin
  71. }
  72.   regs.AH:=$C0;
  73.   Intr($15, regs);
  74.   if nocarry(regs) or (Mem[$FFFF:$E] < $FD) then
  75.     begin
  76.     CMOSport:=$70;
  77.     Writeln;
  78.     caption3('Date');
  79.     date:=unBCD(readCMOS(7));
  80.     century:=unBCD(readCMOS($32));
  81.     year:=unBCD(readCMOS(9));
  82.     month:=unBCD(readCMOS(8));
  83. { Most BIOS's do not set the Day of Week byte. Commented out and left for info}
  84. {    Write(DayName[readCMOS(6)], ', ');}
  85.     case country[0] of
  86.       0, 3..255: Writeln(Monthname[month], ' ', date, ', ', century, addzero(year));
  87.       1: Writeln(date, ' ', Monthname[month], ', ', century, addzero(year));
  88.       2: Writeln(century, addzero(year), ', ', Monthname[month], ' ', date);
  89.     end; {case}
  90.     caption3('Time');
  91.     c:=Chr(country[$0D]);
  92.     hour:=unBCD(readCMOS(4));
  93.     min:=unBCD(readCMOS(2));
  94.     sec:=unBCD(readCMOS(0));
  95.     if country[$11] and 1 = 1 then
  96.       Writeln(hour, c, addzero(min), c, addzero(sec))
  97.     else
  98.       begin
  99.       pm:=false;
  100.       case hour of
  101.         0: hour:=12;
  102.         1..11: hour:=hour;
  103.         12: pm:=true;
  104.         13..23: begin
  105.                 pm:=true;
  106.                 hour:=hour - 12
  107.                 end;
  108.       end; {case}
  109.       Write(hour, c, addzero(min), c, addzero(sec), ' ');
  110.       if pm then
  111.         Writeln('PM')
  112.       else
  113.         Writeln('AM');
  114.       end;
  115.     Writeln;
  116.     caption3('Video type ');
  117.     Writeln(ScreenName[(readCMOS($14) shr 4) and 3]);
  118.     caption3('Coprocessor');
  119.     yesorno((readCMOS($14) and 2) = 2);
  120.     Writeln;
  121.     caption3('Floppy disk A');
  122.     floppy:=readCMOS($10);
  123.     if (floppy shr 4) < 5 then
  124.       Writeln(FloppyName[floppy shr 4])
  125.     else
  126.       Writeln('Unknown value -> ', hex(floppy shr 4, 2));
  127.     caption3('Floppy disk B');
  128.     if (floppy and $0F) < 5 then
  129.       Writeln(FloppyName[floppy and $0F])
  130.     else
  131.       Writeln('Unknown value -> ', hex(floppy and $0F, 2));
  132.     Writeln;
  133.     caption3('Hard disk 0');
  134.     hd:=readCMOS($12);
  135.     hdc:=hd shr 4;
  136.     hdd:=hd and $0F;
  137.     if hdc = $F then
  138.       hdc:=readCMOS($19);
  139.     if hdd = $F then
  140.       hdd:=readCMOS($1A);
  141.     if hdc = 0 then
  142.       Writeln('None')
  143.     else
  144.       Writeln('Type ', hdc);
  145.     caption3('Hard disk 1');
  146.     if hdd = 0 then
  147.       Writeln('None')
  148.     else
  149.       Writeln('Type ', hdd);
  150.     Writeln;
  151.     caption3('Conventional RAM');
  152.     Writeln((word(256) * readCMOS($16)) + readCMOS($15):5, 'K');
  153.     caption3('    Extended RAM');
  154.     Writeln((word(256) * readCMOS($18)) + readCMOS($17):5, 'K');
  155.     Writeln;
  156.     caption3('CMOS checksum');
  157.     checksum1:=0;
  158.     for count:=$10 to $2D do
  159.       Inc(checksum1, readCMOS(count));
  160.     checksum2:=(word(256) * readCMOS($2E)) + readCMOS($2F);
  161.     if checksum1 = checksum2 then
  162.       Writeln('OK')
  163.     else
  164.       Writeln('Error!  Says ', hex(checksum2, 4), ' should be ', hex(checksum1, 4));
  165.     end
  166.   else
  167.     Writeln('No standard CMOS detected!!')
  168.   end;
  169. end.