home *** CD-ROM | disk | FTP | other *** search
/ PC Underground / UNDERGROUND.ISO / rtclock / rtc.pas < prev    next >
Pascal/Delphi Source File  |  1995-08-08  |  5KB  |  231 lines
  1. program rtc_unit;
  2.  
  3. uses crt,dos;
  4.  
  5. const
  6.   Rtc_Seconds         = $00;
  7.   Rtc_Seconds_alarm   = $01;
  8.   Rtc_Minutes         = $02;
  9.   Rtc_Minutes_alarm   = $03;
  10.   Rtc_Hours           = $04;
  11.   Rtc_Hours_alarm     = $05;
  12.   Rtc_Weekday         = $06;
  13.   Rtc_Day_of_Month    = $07;
  14.   Rtc_Month           = $08;
  15.   Rtc_Year            = $09;
  16.   Rtc_Status_A        = $0A;
  17.   Rtc_Status_B        = $0B;
  18.   Rtc_Status_C        = $0C;
  19.   Rtc_Status_D        = $0D;
  20.   Rtc_Diagnosis_status = $0E;
  21.   Rtc_Shutdown_status = $0F;
  22.   Rtc_Floppy_Typ      = $10;
  23.   Rtc_HD_Typ          = $12;
  24.   Rtc_Equipment       = $14;
  25.   Rtc_Lo_Basememory   = $15;
  26.   Rtc_Hi_Basememory   = $16;
  27.   Rtc_Lo_Extendedmem  = $17;
  28.   Rtc_Hi_Extendedmem  = $18;
  29.   Rtc_HD1_extended    = $19;
  30.   Rtc_HD2_extended    = $1A;
  31.   Rtc_Features        = $1F;
  32.   Rtc_HD1_Lo_Cylinder = $20;
  33.   Rtc_HD1_Hi_Cylinder = $21;
  34.   Rtc_HD1_Heads       = $22;
  35.   Rtc_HD1_Lo_Precom   = $23;
  36.   Rtc_HD1_Hi_Precom   = $24;
  37.   Rtc_HD1_Lo_Landing  = $25;
  38.   Rtc_HD1_Hi_Landing  = $26;
  39.   Rtc_HD1_Sectors     = $27;
  40.   Rtc_Options1        = $28;
  41.   Rtc_Options2        = $2B;
  42.   Rtc_Options3        = $2C;
  43.   Rtc_Lo_Checksum     = $2E;
  44.   Rtc_Hi_Checksum     = $2F;
  45.   Rtc_Extendedmem_Lo  = $30;
  46.   Rtc_Extendedmem_Hi  = $31;
  47.   Rtc_Century         = $32;
  48.   Rtc_Setup_Info      = $33;
  49.   Rtc_CPU_speed       = $34;
  50.   Rtc_HD2_Lo_Cylinder = $35;
  51.   Rtc_HD2_Hi_Cylinder = $36;
  52.   Rtc_HD2_Heads       = $37;
  53.   Rtc_HD2_Lo_Precom   = $38;
  54.   Rtc_HD2_Hi_Precom   = $39;
  55.   Rtc_HD2_Lo_Landing  = $3A;
  56.   Rtc_HD2_Hi_Landing  = $3B;
  57.   Rtc_HD2_Sectors     = $3C;
  58.  
  59.  
  60. function wrhexb(b : byte) : string;
  61. const hexcar : array[0..15] of char =
  62.  ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
  63. begin;
  64.   wrhexb := hexcar[(b shr 4)] + hexcar[(b AND $0F)];
  65. end;
  66.  
  67. function wrhexw(w : word) : string;
  68. begin;
  69.   wrhexw := '$'+wrhexb(hi(w))+wrhexb(lo(w));
  70. end;
  71.  
  72. procedure write_rtc(Reg,val : byte);
  73. {
  74.  Writes a value to the RTC register specified in Reg
  75. }
  76. begin;
  77.   port[$70] := Reg;
  78.   port[$71] := val;
  79. end;
  80.  
  81. function read_rtc(Reg : byte) : byte;
  82. {
  83.  Reads a value from the RTC register specified in Reg
  84. }
  85. begin;
  86.   port[$70] := Reg;
  87.   read_rtc := port[$71];
  88. end;
  89.  
  90. Procedure Write_Floppy;
  91. {
  92.  Outputs information about the installed floppy drives
  93. }
  94. Var Fl : byte;
  95.     Fls : array[1..2] of byte;
  96. begin;
  97.   Fl     := Read_Rtc(Rtc_Floppy_Typ);
  98.   Fls[2] := Fl AND $0F;
  99.   Fls[1] := Fl SHR 4;
  100.   for Fl := 1 to 2 do begin;
  101.     write('Floppy ',Fl,': ');
  102.     case Fls[Fl] of
  103.       0 : begin;
  104.             writeln('No  Floppy        ');
  105.           end;
  106.       1 : begin;
  107.             writeln('5¼" Floppy, 360K');
  108.           end;
  109.       2 : begin;
  110.             writeln('5¼" Floppy, 1.2 Meg');
  111.           end;
  112.       3 : begin;
  113.             writeln('3½" Floppy, 720K');
  114.           end;
  115.       4 : begin;
  116.             writeln('3½" Floppy, 1.44 Meg');
  117.           end;
  118.     end;
  119.   end;
  120. end;
  121.  
  122. Procedure Write_Hd;
  123. {
  124.  Outputs the type of installed HD
  125. }
  126. Var Hd : byte;
  127.     Hds : array[1..2] of byte;
  128. begin;
  129.   Hd     := Read_Rtc(Rtc_HD_Typ);
  130.   Hds[2] := Hd AND $0F;
  131.   Hds[1] := Hd SHR 4;
  132.   If HDs[1] = $F then HDs[1] := Read_Rtc(Rtc_HD1_extended);
  133.   If HDs[2] = $F then HDs[2] := Read_Rtc(Rtc_HD2_extended);
  134.   writeln('HD 1 : Typ ',Hds[1]);
  135.   writeln('HD 2 : Typ ',Hds[2]);
  136. end;
  137.  
  138. procedure Write_Memory;
  139. {
  140.  Outputs available memory
  141. }
  142. var base,extended : word;
  143. begin;
  144.   Base     := 256 * Read_Rtc(Rtc_Hi_Basememory) +
  145.               Read_Rtc(Rtc_Lo_Basememory);
  146.   extended := 256 * Read_Rtc(Rtc_Hi_Extendedmem) +
  147.               Read_Rtc(Rtc_Lo_Extendedmem);
  148.   writeln('Base memory: ',Base,' KB');
  149.   writeln('Extended memory: ',extended,' KB');
  150. end;
  151.  
  152. procedure Write_Display;
  153. {
  154.  Outputs the type of graphic card and tells whether a coprocessor
  155.  is installed
  156. }
  157. var dtyp : byte;
  158.     Copro : byte;
  159. begin;
  160.   dtyp  := Read_Rtc(Rtc_Equipment);
  161.   Copro := (dtyp AND 3) SHR 1;
  162.   dtyp  := (dtyp AND 63) SHR 4;
  163.   case dtyp of
  164.     0 : begin;
  165.           writeln('Extended functionality GFX controller');
  166.         end;
  167.     1 : begin;
  168.           writeln('Color display in 40 column mode');
  169.         end;
  170.     2 : begin;
  171.           writeln('Color display in 80 column mode');
  172.         end;
  173.     3 : begin;
  174.           writeln('Monochrome display controller');
  175.         end;
  176.   end;
  177.   if Copro = 1 then
  178.     writeln('Coprocessor found')
  179.   else
  180.     writeln('Coprocessor not found');
  181. end;
  182.  
  183. procedure write_shadow;
  184. {
  185.  Outputs which areas of shadow RAM are supported
  186. }
  187. var shadow : byte;
  188. begin;
  189.   shadow := read_rtc(Rtc_Options1);
  190.   shadow := shadow AND 3;
  191.   case shadow of
  192.     0 : begin;
  193.           writeln('Shadow System AND Video BIOS');
  194.         end;
  195.     1 : begin;
  196.           writeln('Shadow System BIOS');
  197.         end;
  198.     2 : begin;
  199.           writeln('Shadow disabled');
  200.         end;
  201.   end;
  202. end;
  203.  
  204. procedure write_cpuspeed;
  205. {
  206.  Indicates whether the CPU is in Turbo mode
  207. }
  208. var speed : byte;
  209. begin;
  210.   speed := read_rtc(Rtc_CPU_speed);
  211.   if speed = 1 then
  212.     writeln('CPU in Turbo mode')
  213.   else
  214.     writeln('CPU not in Turbo mode');
  215. end;
  216.  
  217. var speed : byte;
  218. begin;
  219.  clrscr;
  220.  Write_Floppy;
  221.  Write_Hd;
  222.  Write_Memory;
  223.  Write_Display;
  224.  Write_Shadow;
  225.  Write_CPUSpeed;
  226. end.
  227.  
  228.  
  229.  
  230.  
  231.