(*********************************************************************
**                       U T I L I T I E S                          **
*********************************************************************)

(* Direkter BIOS-Aufruf ueber BDOS-Funktion 50 *)

function UBIOS(fn,pa,pbc,pde,phl:integer):integer;
var biospb : record
               func,a   : byte;
               bc,de,hl : integer;
               end;
    result : integer;
begin
  with biospb do begin
    func:=fn; a:=pa;
    bc:=pbc; de:=pde; hl:=phl;
    end;
  result:=0;
  case fn of 2,3,7,13,14,15,17,18,19,24 : result:=BDOS(50,addr(biospb));
             9,16,20,22,25              : result:=BDOSHL(50,addr(biospb));
             else                         BDOS(50,addr(biospb));
    end;
  ubios:=result;
  end;

(* RWSECTOR liest/schreibt physikalischen Sektor auf ang. Drive *)
(* Absolute Sektorangabe, Sektoren ab 1 gezaehlt !! *)

procedure rwsector(dr,abssec:integer; wflag:boolean; buf:integer);
var trk,sec,k : integer;
    dph       : ^integer absolute k;
begin
  if abssec>disk[dr].sektoren then writeln('Fehler ! Sektor : ',abssec)
  else begin
    abssec:=pred(abssec);                 (* zaehlt ab 0 *)
    trk:=abssec div disk[dr].secptrk;
    sec:=abssec mod disk[dr].secptrk;
    k:=ubios(9,0,drive[dr],1,0);          (* SELDSK *)
    sec:=ubios(16,0,sec,dph^,0);          (* SECTRN *)
    k:=ubios(23,0,1,0,0);                 (* MULTIO *)
    k:=ubios(10,0,trk,0,0);               (* SETTRK *)
    k:=ubios(11,0,sec,0,0);               (* SETSEC *)
    k:=ubios(12,0,buf,0,0);               (* SETDMA *)
    k:=ubios(28,1,0,0,0);                 (* SETBNK *)
    if wflag then k:=ubios(14,0,0,0,0)    (* WRITE  *)
      else k:=ubios(13,0,0,0,0);          (* READ   *)
    end;
  end;

(* RWCLUSTER liest/schreibt ein Cluster der MS-DOS-Diskette *)

procedure rwcluster(dr,cl:integer; wflag:boolean; buf:integer);
var k : integer;
begin
  with disk[dr] do begin
    cl:=(cl-2)*secpcl+datstart;
    for k:=0 to pred(secpcl) do rwsector(dr,cl+k,wflag,buf+k*psize);
    end;
  end;

(* LOGIN schaltet BDOS und BIOS 'kalt' auf ACTDRV um.                 *)
(* Zum Einloggen der MS-DOS-Diskette werden Boot-Record gelesen und   *)
(* die entsprechenden Parameter gesetzt. Die gesamte FAT wird nach    *)
(* FATBUF gelesen (max. 2048 Byte).                                   *)

procedure login;
type dpb = record
             spt         : integer;
             bsh,blm,exm : byte;
             dsm,drm     : integer;
             al0,al1     : byte;
             cks,off     : integer;
             psh,phm     : byte;
             end;
var  k,secsize : integer;
     ptr       : ^dpb absolute k;
begin
  k:=ubios(9,0,drive[actdrv],0,0);               (* SELDSK kalt         *)
  bdos(14,drive[actdrv]);                        (* Select Drive        *)
  with disk[actdrv] do begin
    k:=bdoshl(31);                               (* Get DPB             *)
    psize:=128 shl ptr^.psh;                     (* Byte/Sektor         *)
    sektoren:=1; secptrk:=2;                (* vorbelegen fuer RWSECTOR *)
    rwsector(actdrv,1,false,addr(dirbuf));       (* Boot-Record lesen   *)
    secsize:=dirbuf[$0B]+dirbuf[$0C] shl 8;      (* Byte/Sektor         *)
    if psize<>secsize then writeln(^G^M^J'Boot-Record defekt !') else begin
      secpcl:=dirbuf[$0D];                         (* Sektoren/Cluster    *)
      reservsec:=dirbuf[$0E]+dirbuf[$0F] shl 8;    (* Boot-Sektoren       *)
      fatzahl:=dirbuf[$10];                        (* Anzahl FAT's        *)
      eintraege:=dirbuf[$11]+dirbuf[$12] shl 8;    (* Directory-Eintr.    *)
      sektoren:=dirbuf[$13]+dirbuf[$14] shl 8;     (* Gesamtzahl Sektoren *)
      medium:=dirbuf[$15];                         (* Medium-Flag         *)
      fatsecs:=dirbuf[$16]+dirbuf[$17] shl 8;      (* Sektoren pro FAT    *)
      secptrk:=dirbuf[$18]+dirbuf[$19] shl 8;      (* Sektoren pro Spur   *)
      heads:=dirbuf[$1A]+dirbuf[$1B] shl 8;        (* Seiten pro Spur     *)
      secptrk:=secptrk*heads;                      (* Sektorueberlauf     *)
      dirstart:=reservsec+fatsecs*fatzahl+1;       (* Start der Directory *)
      datstart:=dirstart+(32*eintraege div psize); (* Start der Daten     *)
      maxclnum:=(sektoren-pred(datstart)) div secpcl +1;  (* +2 -1 *)
      clsize:=secpcl*psize;
      bufcl:=succ(bufgr) div clsize;
      if psize*fatsecs>succ(fatgr) then writeln(^G^M^J'FAT zu gro~ !')
      else for k:=1 to fatsecs do
        rwsector(actdrv,reservsec+k,false,addr(fatbuf[actdrv,psize*pred(k)]));
      end;
    end;
  end;

(* RELOG schaltet 'warm' auf angegebenes Drive um. *)

procedure relog(drive:byte);
var k : integer;
begin
  k:=ubios(9,0,drive,1,0);              (* SELDSK *)
  bdos(14,drive);                       (* Select Drive *)
  end;

(* FAT-Eintrag lesen *)

function fat_eintrag(dr,agr:integer):integer;
var offset : integer;
begin
  offset:=trunc(agr*1.5);
  offset:=fatbuf[dr,offset]+fatbuf[dr,succ(offset)] shl 8;
  if odd(agr) then fat_eintrag:=offset shr 4
  else fat_eintrag:=offset and $0FFF;
  end;

(* Wert in FAT einsetzen *)

procedure fat_setzen(dr,gruppe,wert:integer);
var offset,hilf : integer;
begin
  offset:=trunc(gruppe*1.5);
  hilf:=fatbuf[dr,offset]+fatbuf[dr,succ(offset)] shl 8;
  if odd(gruppe) then begin
    hilf:=hilf and $000F;
    wert:=wert shl 4;
    end
  else
    hilf:=hilf and $F000;
  hilf:=hilf or wert;
  fatbuf[dr,offset]:=lo(hilf);
  fatbuf[dr,succ(offset)]:=hi(hilf);
  end;

(* Ersten leeren Block in FAT suchen. Suche beginnt ab Cluster *)
(* hinter START. Keine Endepruefung.                           *)

function firstfreecluster(dr,start:integer):integer;
begin
  repeat
    start:=succ(start)
  until fat_eintrag(dr,start)=0;
  firstfreecluster:=start;
  end;

(* FAT auf Diskette schreiben *)

procedure writefat(dr:integer);
var i,j,sec : integer;
begin
  with disk[dr] do for i:=1 to fatzahl do begin
    sec:=reservsec+pred(i)*fatsecs;
    for j:=1 to fatsecs do
      rwsector(dr,sec+j,true,addr(fatbuf[dr,psize*pred(j)]));
    end;
  end;

(* Freien Speicherplatz der MS-DOS-Diskette berechnen (aus FAT) *)

function msspace(dr:integer):real;
var i : integer;
    s : real;
begin
  s:=0.0;
  with disk[dr] do for i:=2 to maxclnum do
    if fat_eintrag(dr,i)=0 then s:=s+clsize;
  msspace:=s;
  end;

(* Dateinamen SUCHNAME aus Befehlszeile BEFEHL extrahieren *)

procedure generate_suchname;
begin
  suchname:=copy(befehl,1,14);
  i:=pos(' ',suchname);
  if i>0 then delete(suchname,i,14);
  end;

(* String auf Wildcards pruefen *)

function wildcard(name:string14):boolean;
begin
  wildcard:=(pos('?',name)>0) or (pos('*',name)>0);
  end;

(* Datei-Namens-String in Character-Array (11 Buchstaben) umsetzen *)
(* Wildcards: '?' unveraendert, '*' expandiert.                    *)

function expand(name:string14):string14;
var i,j  : byte;
    hilf : string14;
begin
  hilf:='           '; j:=1;
  for i:=1 to length(name) do
    case name[i] of
      '.' : j:=9;
      '*' : repeat
              hilf[j]:='?';
              j:=succ(j);
            until j in [9,12];
       else begin
              hilf[j]:=upcase(name[i]);
              j:=succ(j);
              end;
      end;
  expand:=hilf;
  end;

(* Datei-Namen aus Array-Form in String-Form zurueckverwandeln *)

function compress(name:string14):string14;
var i : integer;
begin
  for i:=11 downto 9 do
    if name[i]=' ' then delete(name,i,1);
  if length(name)>8 then insert('.',name,9);
  for i:=8 downto 2 do
    if name[i]=' ' then delete(name,i,1);
  compress:=name;
  end;

(* Namen, evtl. mit Wildcards, vergleichen; beide in Array-Form! *)
(* NAM1 kann Wildcards enthalten, NAM2 kommt von Diskette(MSDOS).*)

function gleichheit(nam1,nam2:string14):boolean;
var i    : byte;
    flag : boolean;
begin
  flag:=true;
  for i:=1 to 11 do
    if (nam1[i]<>'?') and (nam1[i]<>nam2[i]) then flag:=false;
  if ord(nam2[1]) in [$E5,0] then flag:=false;  (* Leerer Eintrag *)
  gleichheit:=flag;
  end;