Category : Pascal Source Code
Archive   : INFOS155.ZIP
Filename : PAGE_17.PAS

unit page_17;

interface

uses crt, ifpglobl, ifpcomon;

procedure page17;

implementation

procedure page17;
const
DayName: array[0..7] of string[9] = ('Sunday', 'Monday', 'Tuesday',
'Wednesday', 'Thursday', 'Friday',
'Saturday', 'Sunday');
MonthName: array[0..12] of string[9] = ('???', 'January', 'February', 'March',
'April', 'May', 'June', 'July',
'August', 'September', 'October',
'November', 'December');
ScreenName: array[0..3] of string[10] = ('EGA/VGA', 'CGA 40col',
'CGA 80col', 'Monochrome');
FloppyName: array[0..5] of string[11] = ('none', '5.25" 360K',
'5.25" 1.2M', '3.5" 720K',
'3.5" 1.44M', '3.5" 2.88M');

var
CMOSport: word;
count, checksum1, checksum2: word;
bad, pm: boolean;
floppy, hd, hdc, hdd, date, month, century, year, hour, min, sec: byte;
c: char;
xbyte1, xbyte2, xbyte3: byte;

function readCMOS(adr: byte): byte;
var
i: byte;

begin
inline($FA);
Port[CMOSport]:=adr;
for i:=1 to 10 do;
readCMOS:=Port[CMOSport + 1];
inline($FB)
end; {readCMOS}

procedure writeCMOS(adr, data: byte);
var
i: byte;

begin
inline($FA);
Port[CMOSport]:=adr;
for i:=1 to 10 do;
Port[CMOSport + 1]:=data;
inline($FB)
end; {writeCMOS}

begin
caption2('CMOS');
{!! This check failed on an IBM PC, possibly due to an oddball card.
If anyone has a reliable detection method, please let me know.
CMOSport:=$70;
xbyte1:=readCMOS(6);
writeCMOS(6, $AA);
xbyte2:=readCMOS(6);
writeCMOS(6, $55);
xbyte3:=readCMOS(6);
writeCMOS(6, xbyte1);
if (xbyte2 = $AA) and (xbyte3 = $55) then
begin
}
regs.AH:=$C0;
Intr($15, regs);
if nocarry(regs) or (Mem[$FFFF:$E] < $FD) then
begin
CMOSport:=$70;
Writeln;
caption3('Date');
date:=unBCD(readCMOS(7));
century:=unBCD(readCMOS($32));
year:=unBCD(readCMOS(9));
month:=unBCD(readCMOS(8));
{ Most BIOS's do not set the Day of Week byte. Commented out and left for info}
{ Write(DayName[readCMOS(6)], ', ');}
case country[0] of
0, 3..255: Writeln(Monthname[month], ' ', date, ', ', century, addzero(year));
1: Writeln(date, ' ', Monthname[month], ', ', century, addzero(year));
2: Writeln(century, addzero(year), ', ', Monthname[month], ' ', date);
end; {case}
caption3('Time');
c:=Chr(country[$0D]);
hour:=unBCD(readCMOS(4));
min:=unBCD(readCMOS(2));
sec:=unBCD(readCMOS(0));
if country[$11] and 1 = 1 then
Writeln(hour, c, addzero(min), c, addzero(sec))
else
begin
pm:=false;
case hour of
0: hour:=12;
1..11: hour:=hour;
12: pm:=true;
13..23: begin
pm:=true;
hour:=hour - 12
end;
end; {case}
Write(hour, c, addzero(min), c, addzero(sec), ' ');
if pm then
Writeln('PM')
else
Writeln('AM');
end;
Writeln;
caption3('Video type ');
Writeln(ScreenName[(readCMOS($14) shr 4) and 3]);
caption3('Coprocessor');
yesorno((readCMOS($14) and 2) = 2);
Writeln;
caption3('Floppy disk A');
floppy:=readCMOS($10);
if (floppy shr 4) < 5 then
Writeln(FloppyName[floppy shr 4])
else
Writeln('Unknown value -> ', hex(floppy shr 4, 2));
caption3('Floppy disk B');
if (floppy and $0F) < 5 then
Writeln(FloppyName[floppy and $0F])
else
Writeln('Unknown value -> ', hex(floppy and $0F, 2));
Writeln;
caption3('Hard disk 0');
hd:=readCMOS($12);
hdc:=hd shr 4;
hdd:=hd and $0F;
if hdc = $F then
hdc:=readCMOS($19);
if hdd = $F then
hdd:=readCMOS($1A);
if hdc = 0 then
Writeln('None')
else
Writeln('Type ', hdc);
caption3('Hard disk 1');
if hdd = 0 then
Writeln('None')
else
Writeln('Type ', hdd);
Writeln;
caption3('Conventional RAM');
Writeln((word(256) * readCMOS($16)) + readCMOS($15):5, 'K');
caption3(' Extended RAM');
Writeln((word(256) * readCMOS($18)) + readCMOS($17):5, 'K');
Writeln;
caption3('CMOS checksum');
checksum1:=0;
for count:=$10 to $2D do
Inc(checksum1, readCMOS(count));
checksum2:=(word(256) * readCMOS($2E)) + readCMOS($2F);
if checksum1 = checksum2 then
Writeln('OK')
else
Writeln('Error! Says ', hex(checksum2, 4), ' should be ', hex(checksum1, 4));
end
else
Writeln('No standard CMOS detected!!')
end;
end.