(*********************************************************************
**                  Lesen der MS-DOS-Diskette                       **
*********************************************************************)

(* SCAN_MSDIR sucht in MS-DOS-Directory nach File mit Namen SUCHNAME *)
(* Variable GEFUNDEN gibt Erfolg der Suche an. Wenn TRUE, werden die *)
(* File-Parameter-Variablen auf die entspr. Werte gesetzt.           *)
(* Suche nach FIRST/NEXT bei Wildcards, Variable MSNAME wird auf     *)
(* tatsaechlich gefundenen Namen gesetzt.     ACTDRV                 *)

procedure scan_msdir(first:boolean);
var i       : integer;
    ende    : boolean;
    vglname : string14;
begin
  gefunden:=false;
  with disk[actdrv] do begin
    if first then begin
      ende:=false;
      i:=0;
      dirsec:=pred(dirstart);
      diroff:=-32;
      end;
    while not ende and not gefunden do begin
      diroff:=(diroff+32) mod psize;
      if diroff=0 then begin
        dirsec:=succ(dirsec);
        rwsector(actdrv,dirsec,false,addr(dirbuf));
        end;
      i:=succ(i);
      vglname:='           ';
      move(dirbuf[diroff],vglname[1],11);
      gefunden:=gleichheit(suchname,vglname) and (dirbuf[diroff+11]<>$28);
      ende:=(dirbuf[diroff]=0) or (i=eintraege);
      end;
    if gefunden then begin
      msname:=vglname;
      zeit:=dirbuf[diroff+22]+dirbuf[diroff+23] shl 8;
      datum:=dirbuf[diroff+24]+dirbuf[diroff+25] shl 8;
      startgruppe:=dirbuf[diroff+26]+dirbuf[diroff+27] shl 8;
      datlength:=65536.0*dirbuf[diroff+30]
                 +256.0*dirbuf[diroff+29]+dirbuf[diroff+28];
      end;
    end;
  end;

(* Directory der MS-DOS-Diskette ausgeben  (ACTDRV) *)

procedure directory;
var spalte,i,anzahl : integer;
    options         : boolean;
begin
  spalte:=0;
  anzahl:=0;
  options:=false;
  if (length(befehl)>0) and (befehl[1]='F') then begin
    delete(befehl,1,1);
    options:=true;
    end;
  while (length(befehl)>0) and (befehl[1]=' ') do delete(befehl,1,1);
  generate_suchname;
  if length(suchname)=0 then suchname:='*.*';
  suchname:=expand(suchname);
  scan_msdir(true);                   (* Search for First *)
  while gefunden do begin
    anzahl:=succ(anzahl);
    if not options then begin
      if spalte mod 5=0 then write(chr(drive[actdrv]+$41));
      write(' : ');
      end;
    write(copy(msname,1,8),' ',copy(msname,9,3));
    if options then begin
      write(datlength:9:0);
      if datum=0 then write('':10) else write(datum and 31:4,'.',
                                              datum shr 5 and 15:2,'.',
                                              (80+datum shr 9) mod 100:2);
      if zeit<>0 then write(zeit shr 11:4,':',
                            zeit shr 5 and 63:2,':',
                            zeit shl 1 and 63:2);
      end
    else spalte:=succ(spalte);
    if spalte mod 5=0 then writeln;
    scan_msdir(false);                (* Search for Next *)
    end;
  if spalte mod 5>0 then writeln;
  writeln(anzahl:9,' Datei(en)',msspace(actdrv):10:0,' Bytes frei');
  end;

(*********************************************************************
**               Schreiben der MS-DOS-Diskette                      **
*********************************************************************)

(* Leeren MS-DOS-Directory-Eintrag suchen. GEFUNDEN wird entsprechend   *)
(* gesetzt. Name und Daten der Datei werden in den Eintrag eingesetzt.  *)
(* Neue Directory wird auf Diskette geschrieben.   1-ACTDRV             *)

procedure make_eintrag(name:string14; length:real; start,dat,uhr:integer);
var sec,off,i : integer;
    buf       : tbuff;
begin
  with disk[1-actdrv] do begin
    gefunden:=false;
    i:=0;
    sec:=pred(dirstart);
    off:=-32;
    repeat
      off:=(off+32) mod psize;
      if off=0 then begin
        sec:=succ(sec);
        rwsector(1-actdrv,sec,false,addr(buf));
        end;
      i:=succ(i);
      gefunden:=buf[off] in [0,$E5];
    until gefunden or (i=eintraege);
    if gefunden then begin
      move(name[1],buf[off],11);
      fillchar(buf[off+$0B],21,0);
      buf[off+$0B]:=$20;
      buf[off+$16]:=lo(uhr);
      buf[off+$17]:=hi(uhr);
      buf[off+$18]:=lo(dat);
      buf[off+$19]:=hi(dat);
      buf[off+$1A]:=lo(start);
      buf[off+$1B]:=hi(start);
      i:=trunc(length/65536.0);
      buf[off+$1E]:=i;
      length:=length-65536.0*i;
      i:=trunc(length/256.0);
      buf[off+$1D]:=i;
      buf[off+$1C]:=trunc(length-256.0*i);
      rwsector(1-actdrv,sec,true,addr(buf));
      end;
    end;
  end;

(* Einzelne Datei von ACTDRV nach 1-ACTDRV kopieren *)

procedure lies;
var rdgr,wrgr,next,n,m : integer;
    laenge             : real;
begin
  laenge:=datlength;
  if laenge>msspace(1-actdrv) then writeln(diskfull) else begin
    rdgr:=startgruppe;
    wrgr:=firstfreecluster(1-actdrv,1);
    make_eintrag(msname,datlength,wrgr,datum,zeit);
    if gefunden then begin
      while laenge>0 do begin
        m:=0;
        with disk[actdrv] do while (m<bufcl) and (rdgr<$FF8) do begin
          rwcluster(actdrv,rdgr,false,addr(datbuf[m*clsize]));
          rdgr:=fat_eintrag(actdrv,rdgr);
          m:=succ(m);
          end;
        laenge:=laenge-m*disk[actdrv].clsize;
        n:=pred(m*disk[actdrv].clsize) div disk[1-actdrv].clsize;
        with disk[1-actdrv] do for m:=0 to n do begin
          rwcluster(1-actdrv,wrgr,true,addr(datbuf[m*clsize]));
          if (m=n) and (laenge<=0) then next:=$FFF
            else next:=firstfreecluster(1-actdrv,wrgr);
          fat_setzen(1-actdrv,wrgr,next);
          wrgr:=next;
          end;
        end; {while}
      writefat(1-actdrv);
      end  { if gefunden }
    else writeln('No Directory Space');
    end;
  end;

procedure readfile;
begin
  generate_suchname;
  if length(suchname)=0 then
    repeat
      write('Dateiname : ');
      readln(suchname);
    until length(suchname)>0;
  suchname:=expand(suchname);
  scan_msdir(true);
  if not gefunden then writeln(nofile)
  else if wildcard(suchname) then begin
    writeln(copying);
    while gefunden do begin
      writeln(compress(msname));
      lies;
      scan_msdir(false);
      end;
    end
  else lies;
  end;