home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / msdos / pascal / ifp1s158 / page_17.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-08-29  |  8.6 KB  |  304 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, ComputedChecksum, CMOSChecksum: word;
  29.     bad, pm, PS2, Phoenix: boolean;
  30.     Floppy, Hd0, Hd1, Date, Month, Century, Year, Hour, Min, Sec: byte;
  31.     TimeSep: char;
  32.     xbyte: byte;
  33.     s: string;
  34.     Cylinders, Heads, Precomp, LZ, Sectors: word;
  35.  
  36.   function ReadCMOS(adr: byte): byte;
  37.     var
  38.       i: byte;
  39.  
  40.     begin
  41.     inline($FA);
  42.     Port[CMOSport]:=adr;
  43.     for i:=1 to 10 do;
  44.     ReadCMOS:=Port[CMOSport + 1];
  45.     inline($FB)
  46.     end; {ReadCMOS}
  47.  
  48. {
  49.   procedure writeCMOS(adr, data: byte);
  50.     var
  51.       i: byte;
  52.  
  53.     begin
  54.     inline($FA);
  55.     Port[CMOSport]:=adr;
  56.     for i:=1 to 10 do;
  57.     Port[CMOSport + 1]:=data;
  58.     inline($FB)
  59.     end;
  60.  }
  61.  
  62.   procedure GetHDValues(HDtype: byte;
  63.             var Cylinders, Heads, PreComp, LZ, Sectors: word);
  64.     var
  65.       HDOffset: word;
  66.     begin
  67.     HDOffset:=$E401 + ((HDtype - 1) * 16);
  68.     Cylinders:=MemW[$F000:HDOffset];
  69.     Heads:=Mem[$F000:HDOffset + 2];
  70.     PreComp:=MemW[$F000:HDOffset + 5];
  71.     LZ:=MemW[$F000:HDOffset + $C];
  72.     Sectors:=Mem[$F000:HDOffset + $E];
  73.     end;
  74.  
  75.   procedure ShowHDValues(Cylinders, Heads, PreComp, LZ, Sectors: word);
  76.     begin
  77.     Caption3('Cyl');
  78.     Write(Cylinders:4);
  79.     Caption3('Hds');
  80.     Write(Heads:2);
  81.     Caption3('Sec');
  82.     Write(Sectors:2);
  83.     Caption3('LZ');
  84.     Write(integer(LZ):4);
  85.     Caption3('PreComp');
  86.     Writeln(integer(PreComp):4);
  87.     end;
  88.  
  89.   begin
  90.   Caption2('CMOS');
  91.   regs.AH:=$C0;
  92.   Intr($15, regs);
  93.   if NoCarry(regs) or (Mem[$FFFF:$E] < $FD) then
  94.     begin
  95.     PS2:=False;
  96.     if Mem[regs.ES:regs.BX + 2] = $F8 then
  97.       PS2:=true;
  98.     Phoenix:=false;
  99.     s:='';
  100.     with regs do
  101.       for xword:=BX + $D to BX + $F do
  102.         s:=s + Chr(Mem[ES:xword]);
  103.     if s = 'PTL' then
  104.       Phoenix:=true;
  105.     CMOSport:=$70;
  106.     Writeln;
  107.     Caption3('Power status');
  108.     if ReadCMOS($D) and $80 = $80 then
  109.       Writeln('OK')
  110.     else
  111.       Writeln('No power!');
  112.     Caption3(' Diagnostics');
  113.     xbyte:=ReadCMOS($E);
  114.     if xbyte = 0 then
  115.       Writeln('No problems detected')
  116.     else
  117.       begin
  118.       if xbyte and $80 = $80 then
  119.         Writeln('Clock lost power');
  120.       if xbyte and $40 = $40 then
  121.         Writeln('Incorrect checksum');
  122.       if xbyte and $20 = $20 then
  123.         Writeln('Bad equipment configuration');
  124.       if xbyte and $10 = $10 then
  125.         Writeln('Memory size error');
  126.       if xbyte and 8 = 8 then
  127.         Writeln('Disk drive initialization failure');
  128.       if xbyte and 4 = 4 then
  129.         Writeln('Invalid time');
  130.       if xbyte and 2 = 2 then
  131.         Writeln('Bad adaptor configuration (EISA)');
  132.       if xbyte and 1 = 1 then
  133.         Writeln('Timeout reading adaptor ID (EISA)');
  134.       end;
  135.     Writeln;
  136.     Caption3('Date');
  137.     Date:=ReadCMOS(7);
  138.     if PS2 then
  139.       Century:=unBCD(ReadCMOS($37))
  140.     else
  141.       Century:=unBCD(ReadCMOS($32));
  142.     Year:=ReadCMOS(9);
  143.     Month:=ReadCMOS(8);
  144.     if ReadCMOS($B) and 4 = 0 then
  145.       begin
  146.       Date:=unBCD(Date);
  147.       Year:=unBCD(Year);
  148.       Month:=unBCD(Month);
  149.       end;
  150. { Most BIOS's do not set the Day of Week byte. Commented out and left for info}
  151. {    Write(DayName[ReadCMOS(6)], ', ');}
  152.     case Country[0] of
  153.       0, 3..255: Writeln(Monthname[Month], ' ', Date, ', ',
  154.                          Century, AddZero(Year));
  155.       1: Writeln(Date, ' ', Monthname[Month], ', ', Century, AddZero(Year));
  156.       2: Writeln(Century, AddZero(Year), ', ', Monthname[Month], ' ', Date);
  157.     end; {case}
  158.     Caption3('Time');
  159.     TimeSep:=Chr(Country[$0D]);
  160.     Hour:=ReadCMOS(4);
  161.     Min:=ReadCMOS(2);
  162.     Sec:=ReadCMOS(0);
  163.     if ReadCMOS($B) and 4 = 0 then
  164.       begin
  165.       Hour:=unBCD(Hour);
  166.       Min:=unBCD(Min);
  167.       Sec:=unBCD(Sec);
  168.       end;
  169.     if ReadCMOS($B) and 2 = 0 then
  170.       if Hour > 12 then
  171.         Hour:=(Hour - 128) + 11
  172.       else
  173.         Dec(Hour);
  174.     if Country[$11] and 1 = 1 then
  175.       Writeln(Hour, TimeSep, AddZero(Min), TimeSep, AddZero(Sec))
  176.     else
  177.       begin
  178.       pm:=false;
  179.       case Hour of
  180.         0: Hour:=12;
  181.         1..11: Hour:=Hour;
  182.         12: pm:=true;
  183.         13..23: begin
  184.                 pm:=true;
  185.                 Hour:=Hour - 12
  186.                 end;
  187.       end; {case}
  188.       Write(Hour, TimeSep, AddZero(Min), TimeSep, AddZero(Sec), ' ');
  189.       if pm then
  190.         Writeln('PM')
  191.       else
  192.         Writeln('AM');
  193.       end;
  194.     Writeln;
  195.     Caption3('Video type ');
  196.     Writeln(ScreenName[(ReadCMOS($14) shr 4) and 3]);
  197.     Caption3('Coprocessor');
  198.     YesOrNo((ReadCMOS($14) and 2) = 2);
  199.     Writeln;
  200.     Caption3('Floppy disk A');
  201.     Floppy:=ReadCMOS($10);
  202.     if (Floppy shr 4) < 6 then
  203.       Writeln(FloppyName[Floppy shr 4])
  204.     else
  205.       Writeln('Unknown value -> ', Hex(Floppy shr 4, 2));
  206.     Caption3('Floppy disk B');
  207.     if (Floppy and $0F) < 6 then
  208.       Writeln(FloppyName[Floppy and $0F])
  209.     else
  210.       Writeln('Unknown value -> ', Hex(Floppy and $0F, 2));
  211.     Writeln;
  212.     Caption3('Hard disk 0');
  213.     if not PS2 then
  214.       begin
  215.       Hd0:=ReadCMOS($12) shr 4;
  216.       Hd1:=ReadCMOS($12) and $0F;
  217.       if Hd0 = $F then
  218.         Hd0:=ReadCMOS($19);
  219.       if Hd1 = $F then
  220.         Hd1:=ReadCMOS($1A);
  221.       end
  222.     else
  223.       begin
  224.       Hd0:=ReadCMOS($11);
  225.       Hd1:=ReadCMOS($12);
  226.       end;
  227.     if Hd0 = 0 then
  228.       Writeln('None')
  229.     else
  230.       begin
  231.       Write('Type ', Hd0);
  232.       if Hd0 < 47 then
  233.         begin
  234.         GetHDValues(Hd0, Cylinders, Heads, PreComp, LZ, Sectors);
  235.         ShowHDValues(Cylinders, Heads, PreComp, LZ, Sectors)
  236.         end
  237.       else
  238.         if (Phoenix) and (Hd0 >= 48) then
  239.           begin
  240.           Cylinders:=word(ReadCMOS($21) shl 8) + ReadCMOS($20);
  241.           Heads:=ReadCMOS($22);
  242.           PreComp:=word(ReadCMOS($24) shl 8) + ReadCMOS($23);
  243.           LZ:=word(ReadCMOS($26) shl 8) + ReadCMOS($25);
  244.           Sectors:=ReadCMOS($27);
  245.           ShowHDValues(Cylinders, Heads, PreComp, LZ, Sectors)
  246.           end
  247.         else
  248.           Writeln;
  249.       end;
  250.     Caption3('Hard disk 1');
  251.     if Hd1 = 0 then
  252.       Writeln('None')
  253.     else
  254.       begin
  255.       Write('Type ', Hd1);
  256.       if Hd1 < 47 then
  257.         begin
  258.         GetHDValues(Hd1, Cylinders, Heads, PreComp, LZ, Sectors);
  259.         ShowHDValues(Cylinders, Heads, PreComp, LZ, Sectors)
  260.         end
  261.       else
  262.         if (Phoenix) and (Hd1 >= 48) then
  263.           begin
  264.           Cylinders:=word(ReadCMOS($36) shl 8) + ReadCMOS($35);
  265.           Heads:=ReadCMOS($37);
  266.           PreComp:=word(ReadCMOS($39) shl 8) + ReadCMOS($38);
  267.           LZ:=word(ReadCMOS($3B) shl 8) + ReadCMOS($3A);
  268.           Sectors:=ReadCMOS($3C);
  269.           ShowHDValues(Cylinders, Heads, PreComp, LZ, Sectors)
  270.           end
  271.         else
  272.           Writeln;
  273.       end;
  274.     Writeln;
  275.     Caption3('Conventional RAM');
  276.     Writeln(word(ReadCMOS($16) shl 8) + ReadCMOS($15):6, 'K');
  277.     Caption3('    Extended RAM');
  278.     Writeln(word(ReadCMOS($18) shl 8) + ReadCMOS($17):6, 'K');
  279.     Writeln;
  280.     Caption3('CMOS checksum');
  281.     if not PS2 then
  282.       begin
  283.       ComputedChecksum:=0;
  284.       for count:=$10 to $2D do
  285.         Inc(ComputedChecksum, ReadCMOS(count));
  286.       CMOSChecksum:=word(ReadCMOS($2E) shl 8) + ReadCMOS($2F);
  287.       end
  288.     else
  289.       begin
  290.       ComputedChecksum:=0;
  291.       for count:=$10 to $31 do
  292.         Inc(ComputedChecksum, ReadCMOS(count));
  293.       CMOSChecksum:=word(ReadCMOS($33) shl 8) + ReadCMOS($32);
  294.       end;
  295.     if ComputedChecksum = CMOSChecksum then
  296.       Writeln('OK')
  297.     else
  298.       Writeln('Error!  Says ', Hex(CMOSChecksum, 4), ' should be ',
  299.                Hex(ComputedChecksum, 4));
  300.     end
  301.   else
  302.     Writeln('No standard CMOS detected!!')
  303.   end;
  304. end.