program systdata;               { gets system data, date, time, amount of memory
                devices hookedup, display adapter installed }

type dateStr         = string[10];
     timestring      = string[8];
     regpack         = record ax,bx,cx,dx,bp,si,ds,es,flags:integer; end;
     word            = string[2];
     memory_pointer  = ^memory;
     memory          = record memory_data : string[255] end;

var

  rom_date       : memory_pointer;
  date_of_rom    : timestring;
  recpack        : regpack;
  xt, old        : boolean;



function date:datestr;

var

  month,day:string[2];
  year:string[4];
  dx,cx:integer;
  begin
  with recpack do
    begin ax:= $2a shl 8; end;
    msdos(recpack);
    with recpack do
    begin
      str(cx,year);
      str(dx mod 256,day);
      str(dx shr 8,month);
   end;
   if length(month) < 2 then month := '0' + month;
   if length(day) < 2 then day := '0' + day;
   date := month +'/'+day+'/'+year;
   end;

function time:TimeString;

var
  recpack: regpack;
  ah,al,ch,cl,dh: byte;
  hour,min,sec : string[2];

begin
  ah := $2c;
  with recpack do
  begin
  ax := ah shl 8 +al
  end;
  intr($21,recpack);
  with recpack do
    begin
      str(cx shr 8, hour);
      str(cx mod 256,min);
      str(dx shr 8,sec)
    end;
  if length(hour) < 2 then hour := '0' + hour;
  if length(min) < 2 then min := '0' + min;
  if length(sec) < 2 then sec := '0' + sec;
  time:=hour+':'+min+':'+sec;
end;

procedure Bios_Rom_Date; { finds and reports the ROM System Date }

begin
  rom_date        := ptr($F000,$FFF4);
  with rom_date^ do writeln('Bios Rom Date: ',copy(memory_data,1,8));
end;

procedure Fdisk_Rom_Date;

 begin
   rom_date      := ptr($C800,$07B3);
   with rom_date^ do
   begin
     writeln( copy(memory_data,1,7) ); xt := false;
   end
 end;

procedure equipment_list;                    { ah,1,2   = # of printers                        }
var                                          { ah,3     = n/a                                  }
                                             { ah,4     = game adapter y/n                     }
  recpack: regpack;                          { ah,5,6,7 = # com adapters                       }
  ah,al,ch,cl,dh: byte;                      { ah,8     = n/a                                  }
                                             { al,1,2   = # of diskette drives                 }
  num_Printers, num_ComAdapters,
  num_diskettes, num_MemBanks, Display_mode :integer;
  Game_adapter                              : boolean;
                                             { al,5,6   = system board mem banks enabled       }
                                             { al,7     = n/a                                  }
                                             { al,8     = has diskettes y/n                    }
begin
  with recpack do  ax := 0;
  intr($11,recpack);
  with recpack do
    begin
      num_Printers := ((ax shr 14) and $0003);
      num_ComAdapters := ((ax shr 9) and $0007) ;
      num_Diskettes := (( ax shr 6) and $0003) + 1;
      Display_mode := ((ax shr 4) and $0003);
      num_Membanks := ((ax shr 2) and $0003) + 1;
      Game_Adapter := (((ax shr 12) and $0001) = 1)
    end;
  writeln('    has ',num_Printers,' printers');
  writeln('    has ',num_ComAdapters,' Serial Adapters');
  writeln('    has ',num_Diskettes,' Diskette drives');
  writeln('    has ',num_MemBanks,' Systemboard Memory Banks');
  if Game_Adapter then writeln('... has Game Adapter') else writeln('... has NO Game Adapter');
  writeln('    is in Display Mode: ',Display_Mode)
end;

procedure mem_quantity; { ax returns mem in 1k byte blocks }
var
  recpack: regpack;
  ah,al,ch,cl,dh: byte;

begin
  intr($12,recpack);
  with recpack do write('    ',ax ,' K of Ram');
  writeln
end;

procedure print_screen;
begin
intr($5,recpack)
end;

procedure printer_status;  { finds the printer status in PC }
var pbstate, drives          : integer;
    bit0, bit1, bit2, bit3, bit4, bit5, bit6, bit7  : boolean;

begin
  bit7 := (port[889] > 127);
  bit6 := (odd(port[889] div 64)); { n/a      }
  bit5 := (odd(port[889] div 32)); { n/a      }
  bit4 := (odd(port[889] div 16)); { error    }
  bit3 := (odd(port[889] div 8));  { select   }
  bit2 := (odd(port[889] div 4));  { no paper }
  bit1 := (odd(port[889] div 2));  { ack      }
  bit0 := (odd(port[889]));        { busy     }
  if not bit0 then write('busy     ');
  if not bit2 then write('no paper ');
  if bit3 then write('printer selected   ') else write('printer not selected');
  if (bit3 and not bit4) then write('error    ');
  if (not bit7 and bit3) then write('time out ');
  writeln
end;

begin
  clrscr;
  writeln;
  writeln(' Today''s date: ',date);
  writeln('   The time is: ',time);
  Bios_Rom_Date;
  fdisk_Rom_Date; if xt then writeln('IBM XT valid ROM date found');
  gotoxy(1,7);
  writeln('Options installed:');
  window(20,8,60,20);
  gotoxy(1,1);
  equipment_list;
  mem_quantity;
end.