program konfig;

var
system_type, version_number: byte;
systype, vernum, laufwerk: string[2];
inf1, inf2, inf3: string[60];

type
  regpack = record
             case integer of 
             1:  (ax,bx,cx,dx,bp,si,di,ds,es,flags: integer);
             2:  (al,ah,bl,bh,cl,ch,dl,dh: byte);
            end;

var
  recpack:       regpack;          
    e1, e2 : byte;
    high, low : string[8];
    flop, serie, usernr, currdrive : byte;

type
str8 = string[8];
str2 = string[2];



function bytobit (zahl : byte) : str8;


var  st1, st2, st4, st8, st16, st32, st64, st128 : byte;
     pos1, pos2, pos4, pos8, pos16, pos32, pos64, pos128 : string[8];

begin
 if zahl >= 128 then
  begin
   st128 := 1;
   zahl := zahl - 128;
  end
  else st128 := 0;
 if zahl >= 64 then
  begin
   st64 := 1;
   zahl := zahl - 64;
  end
  else st64 := 0;
 if zahl >= 32 then
  begin
   st32 := 1;
   zahl := zahl - 32;
  end
  else st32 := 0;
 if zahl >= 16 then
  begin
   st16 := 1;
   zahl := zahl - 16;
  end
  else st16 := 0;
 if zahl >= 8 then
  begin
   st8 := 1;
   zahl:= zahl - 8;
  end
   else st8 := 0;
 if zahl >= 4 then
  begin
   st4 := 1;
   zahl := zahl - 4;
  end
   else st4 := 0;
 if zahl >= 2 then
  begin
   st2 := 1;
   zahl := zahl - 2;
  end
  else st2 := 0;
 if zahl = 1
  then st1 := 1;
 if zahl = 0
  then st1 := 0;
 str (st128, pos128);
 str (st64, pos64);
 str (st32, pos32);
 str (st16, pos16);
 str (st8, pos8);
 str (st4, pos4);
 str (st2, pos2);
 str (st1, pos1);
bytobit := pos128+pos64+pos32+pos16+pos8+pos4+pos2+pos1;
end;

function ergebnis : integer;

type
result = record
          AX, BX, CX, BP, SI, DI, DS, ES, Flags: Integer;
         end;

var register: result;

begin
inline ($50/$53/$51/$52/$56/$57/$1E/$06/$FB);
intr ($11, register);
ergebnis := register.ax;

inline ($07/$1F/$5F/$5E/$5A/$59/$5B/$58/$8B/$E5/$D5/$CF);
end;

function extmem: integer;

type
result = record
          AX, BX, CX, BP, SI, DI, DS, ES, Flags: Integer;
         end;

var register: result;


begin
inline ($50/$53/$51/$52/$56/$57/$1E/$06/$FB);
register.ax:=$8800;
intr ($15, register);
extmem:= register.ax;
inline ($07/$1F/$5F/$5E/$5A/$59/$5B/$58/$8B/$E5/$D5/$CF);
end;




function hex (eingabe: byte): str2;
{Konvertiert eine bytelange Dezimalzahl in eine Hexzahl}

var ergebnis: real;
    ganz: real;
    rest: real;
    s1: char;
    s2: char;

begin
ergebnis:= eingabe / 16;
ganz:= int (ergebnis);
if ganz = 0.0 then
   s1:= '0';
if ganz = 1.0 then
   s1:= '1';
if ganz = 2.0 then
   s1:= '2';
if ganz = 3.0 then
   s1:= '3';
if ganz = 4.0 then
   s1:= '4';
if ganz = 5.0 then
   s1:= '5';
if ganz = 6.0 then
   s1:= '6';
if ganz = 7.0 then
   s1:= '7';
if ganz = 8.0 then
   s1:= '8';
if ganz = 9.0 then
   s1:= '9';
if ganz = 10.0 then
   s1:= 'A';
if ganz = 11.0 then
   s1:= 'B';
if ganz = 12.0 then
   s1:= 'C';
if ganz = 13.0 then
   s1:= 'D';
if ganz = 14.0 then
   s1:= 'E';
if ganz = 15.0 then
   s1:= 'F';
rest:= frac(ergebnis);
if rest = 0.0 then
   s2:= '0';
if rest = 0.0625 then
   s2:= '1';
if rest = 0.125 then
   s2:= '2';
if rest = 0.1875 then
   s2:= '3';
if rest = 0.25 then
   s2:= '4';
if rest = 0.3125 then
   s2:= '5';
if rest = 0.375 then
   s2:= '6';
if rest = 0.4375 then
   s2:= '7';
if rest = 0.5 then
   s2:= '8';
if rest = 0.5625 then
   s2:= '9';
if rest = 0.625 then
   s2:= 'A';
if rest = 0.6875 then
   s2:= 'B';
if rest = 0.75 then
   s2:= 'C';
if rest = 0.8125 then
   s2:= 'D';
if rest = 0.875  then
   s2:= 'E';
if rest = 0.9375 then
   s2:= 'F';
hex:= s1+s2;
end;



begin
    recpack.cx:= $000C;
  BDos(recpack);                        { call function }
    system_type:= recpack.ah;
  version_number:= recpack.al;

 systype := hex (system_type);
 vernum := hex (version_number);

  if copy (systype,1,1) = '0' 
   then inf1 := '8080/Z80';
  if copy (systype,1,1) = '1'
   then inf1 := '80x88/80x86';
  if copy (systype,2,1) = '0'
   then inf2 := 'Single User CP/M resp. MP/M';
  if copy (systype,2,1) = '1'
   then inf2 := 'CP/M-Net, network present';
  if copy (systype,2,1) = '2'
   then inf2 := '16 Bit Multi User System';
  if vernum = '00' then inf3 := '1.0 (CP/M 1.0)'
  else
   if vernum = '20' then inf3 := '2.0 (CP/M 2.0)'
  else
   if vernum = '21' then inf3 := '2.1 (CP/M 2.1)'
  else
   if vernum = '22' then inf3 := '2.2 (CP/M 2.2)'
  else
   if vernum = '25' then inf3 := '2.5 (DOS+)'
  else
   if vernum = '28' then inf3 := '2.8 (PCP/M-80)'
  else
   if vernum = '30' then inf3 := '3.0 (MP/M II)'
  else
   if vernum = '31' then inf3 := '3.1 (CP/M-Plus)'
  else
   if vernum = '41' then inf3 := '4.1 (DOSPlus 1 resp. PCP/M-86)'
  else
   if vernum = '60' then inf3 := '6.0 (DOSPlus 2)'
  else inf3 := copy (vernum,1,1)+'.'+copy (vernum,2,1);

 e1 := lo (ergebnis);
 e2 := hi (ergebnis);
 low := bytobit(e1);
 high := bytobit(e2);
 if low[8] <> '0' then
 begin
  if (low[1] = '0') and (low[2] = '0')
  then flop := 1;
  if (low[1] = '0') and (low[2] = '1')
  then flop := 2;
  if (low[1] = '1') and (low[2] = '0')
  then flop := 3;
  if (low[1] = '1') and (low[2] = '1')
  then flop := 4;
 end
 else flop := 0;
 writeln;
 writeln ('Gabytools Configuration Info Version 1.1 for CP/M');
 writeln ('(C)opyright 1999');
 writeln;
 writeln ('Current Configuration of this Computer');
 writeln ('--------------------------------------');
 writeln;
 writeln ('Number of parallel Ports: ',high[2], '.');
  if (high[6] = '0') and (high[7] = '1')
  then serie := 1;
  if (high[6] = '1') and (high[7] = '0')
  then serie := 2;
  if (high[6] = '1') and (high[7] = '1')
  then serie := 3;
  if (high[6] = '0') and (high[7] = '0')
  then serie := 0;
 writeln ('Number of serial Ports: ',serie, '.');
 if (low[2] = '0') and (low[3] = '1')
  then writeln ('Video Mode: 40*25 Characters, Color.');
  if (low[2] = '1') and (low[3] = '0')
  then writeln ('Video Mode: 80*25 Characters, Color.');
  if (low[2] = '1') and (low[3] = '1')
  then writeln ('Video Mode: 80*25 Characters, monochrome.');
 if extmem <> 0
 then writeln ('Extended Memory: ',extmem, 'K.')
 else writeln ('Extended Memory: none or EMS/XMS Manager installed.');
 writeln ('Number of Floppy Drives: ', flop, '.');
 writeln ('CPU Type as reported by OS: ', inf1, '.');
 writeln ('Operating System Type: ', inf2, '.'); 
 writeln ('BIOS Version: ', inf3, '.'); 
    recpack.cx := $0019;
 BDos (recpack);
    currdrive := recpack.al;
    currdrive := currdrive + 65;
    laufwerk := chr (currdrive);
  writeln ('Current Drive is ',laufwerk, ':.');  
    
    recpack.cx:= $0020;
    recpack.dx:= $00ff;
  BDos(recpack);                        
   usernr := recpack.ax;
 writeln ('Current User Area is ',usernr, '.');
end.
 
 writeln;
 end.