home *** CD-ROM | disk | FTP | other *** search
/ PC Interdit / pc-interdit.iso / rtclock / rtc.pas < prev    next >
Pascal/Delphi Source File  |  1994-10-11  |  5KB  |  225 lines
  1. program rtc_unit;
  2.  
  3. uses crt,dos;
  4.  
  5. const
  6.   Rtc_Secondes        = $00;
  7.   Rtc_Secondes_alarm  = $01;
  8.   Rtc_Minutes         = $02;
  9.   Rtc_Minutes_alarm   = $03;
  10.   Rtc_Heures          = $04;
  11.   Rtc_Heures_alarm    = $05;
  12.   Rtc_Jour_semaine    = $06;
  13.   Rtc_Jour_mois       = $07;
  14.   Rtc_Mois            = $08;
  15.   Rtc_Annee           = $09;
  16.   Rtc_Etat_A          = $0A;
  17.   Rtc_Etat_B          = $0B;
  18.   Rtc_Etat_C          = $0C;
  19.   Rtc_Etat_D          = $0D;
  20.   Rtc_Diagnost_Etat   = $0E;
  21.   Rtc_Shutdown_Etat   = $0F;
  22.   Rtc_Floppy_Type     = $10;
  23.   Rtc_HD_Type         = $12;
  24.   Rtc_Equipement     = $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_Tetes       = $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_Secteurs    = $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_Siecle          = $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_Tetes      = $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_Secteurs    = $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.  Ecrit une valeur dans le registre RTC indiqué dans Reg
  75. }
  76. begin;
  77.   port[$70] := Reg;
  78.   port[$71] := val;
  79. end;
  80.  
  81. function read_rtc(Reg : byte) : byte;
  82. {Lit une valeur dans le registre RTC indiqué dans Reg}
  83. begin;
  84.   port[$70] := Reg;
  85.   read_rtc := port[$71];
  86. end;
  87.  
  88. Procedure Write_Floppy;
  89. {
  90. Affiche des informations sur les lecteurs de disquettes installés
  91. }
  92. Var Fl : byte;
  93.     Fls : array[1..2] of byte;
  94. begin;
  95.   Fl     := Read_Rtc(Rtc_Floppy_Type);
  96.   Fls[2] := Fl AND $0F;
  97.   Fls[1] := Fl SHR 4;
  98.   for Fl := 1 to 2 do begin;
  99.     write('Floppy ',Fl,': ');
  100.     case Fls[Fl] of
  101.       0 : begin;
  102.             writeln('No  Floppy        ');
  103.           end;
  104.       1 : begin;
  105.             writeln('5¼" Floppy, 360 KO');
  106.           end;
  107.       2 : begin;
  108.             writeln('5¼" Floppy, 1.2 MO');
  109.           end;
  110.       3 : begin;
  111.             writeln('3½" Floppy, 720 KO');
  112.           end;
  113.       4 : begin;
  114.             writeln('3½" Floppy, 1.44 MO');
  115.           end;
  116.     end;
  117.   end;
  118. end;
  119.  
  120. Procedure Write_Hd;
  121. {
  122.  Affiche le type du disque dur installé
  123. }
  124. Var Hd : byte;
  125.     Hds : array[1..2] of byte;
  126. begin;
  127.   Hd     := Read_Rtc(Rtc_HD_Type);
  128.   Hds[2] := Hd AND $0F;
  129.   Hds[1] := Hd SHR 4;
  130.   If HDs[1] = $F then HDs[1] := Read_Rtc(Rtc_HD1_extended);
  131.   If HDs[2] = $F then HDs[2] := Read_Rtc(Rtc_HD2_extended);
  132.   writeln('HD 1 : Type ',Hds[1]);
  133.   writeln('HD 2 : Type ',Hds[2]);
  134. end;
  135.  
  136. procedure Write_Memory;
  137. {
  138.  Affiche la mémoire disponible
  139. }
  140. var base,extended : word;
  141. begin;
  142.   Base     := 256 * Read_Rtc(Rtc_Hi_Basememory) +
  143.               Read_Rtc(Rtc_Lo_Basememory);
  144.   extended := 256 * Read_Rtc(Rtc_Hi_Extendedmem) +
  145.               Read_Rtc(Rtc_Lo_Extendedmem);
  146.   writeln('Base memory: ',Base,' KO');
  147.   writeln('Extended memory: ',extended,' KO');
  148. end;
  149.  
  150. procedure Write_Display;
  151. {
  152.  Affiche le type de la carte graphique et indique si un coprocesseur est installé
  153. }
  154. var dType : byte;
  155.     Copro : byte;
  156. begin;
  157.   dType  := Read_Rtc(Rtc_Equipement);
  158.   Copro := (dType AND 3) SHR 1;
  159.   dType  := (dType AND 63) SHR 4;
  160.   case dType of
  161.     0 : begin;
  162.           writeln('Extended functionality GFX-Controller');
  163.         end;
  164.     1 : begin;
  165.           writeln('Color Display sur 40 colonnes');
  166.         end;
  167.     2 : begin;
  168.           writeln('Color Display sur 80 colonnes');
  169.         end;
  170.     3 : begin;
  171.           writeln('Monochrome Display Controller');
  172.         end;
  173.   end;
  174.   if Copro = 1 then
  175.     writeln('Coprocesseur trouvé')
  176.   else
  177.     writeln('Pas de coprocesseur trouvé');
  178. end;
  179.  
  180. procedure write_shadow;
  181. {
  182.  Indique les secteurs supportés par la shadow-Ram
  183. }
  184. var shadow : byte;
  185. begin;
  186.   shadow := read_rtc(Rtc_Options1);
  187.   shadow := shadow AND 3;
  188.   case shadow of
  189.     0 : begin;
  190.           writeln('Shadow System AND Video Bios');
  191.         end;
  192.     1 : begin;
  193.           writeln('Shadow System Bios');
  194.         end;
  195.     2 : begin;
  196.           writeln('Shadow disabled');
  197.         end;
  198.   end;
  199. end;
  200.  
  201. procedure write_cpuspeed;
  202. {
  203.  Indique si l'unité centrale se trouve en mode Turbo
  204. }
  205. var speed : byte;
  206. begin;
  207.  
  208.   speed := read_rtc(Rtc_CPU_speed);
  209.   if speed = 1 then
  210.     writeln('CPU in Turbo-Mode')
  211.   else
  212.     writeln('CPU in Deturbo-Mode');
  213. end;
  214.  
  215. begin;
  216.  clrscr;
  217.  Write_Floppy;
  218.  Write_Hd;
  219.  Write_Memory;
  220.  Write_Display;
  221.  Write_Shadow;
  222.  Write_CPUSpeed;
  223.  readln;
  224. end.
  225.