procedure ConvertName(Str: Str20; var N: NameAry; var T: TypeAry);
var
  I,J: integer;
begin
for I:= 1 to NameSize do N[I]:= ' ';
for I:= 1 to TypeSize do T[I]:= ' ';
if (Str = '') then Str:= '*.*';
if (pos('.',Str) = 0) then Str:= concat(Str,'.');
if not (pos('.',Str)-1 > NameSize) then
  for I:= 1 to pos('.',Str)-1 do
    N[I]:= upcase(Str[I]);
if not (length(copy(Str,pos('.',Str)+1,20)) > TypeSize) then
  for I:= pos('.',Str)+1 to length(Str) do
    T[I-pos('.',Str)]:= upcase(Str[I]);
for I:= 1 to NameSize do
  if (N[I] = '*') then
    for J:= I to NameSize do
      N[J]:= '?';
for I:= 1 to TypeSize do
  if (T[I] = '*') then
    for J:= I to TypeSize do
      T[J]:= '?';
end;



function SameName(S: Str20; FN: NameAry; FT: TypeAry): boolean;
var
  N: NameAry;
  T: TypeAry;
  I,J: integer;
  Match: boolean;
begin
ConvertName(S,N,T);
Match:= true;
for I:= 1 to NameSize do
  if ((N[I] <> FN[I]) and (N[I] <> '?')) then
    Match:= False;
for I:= 1 to TypeSize do
  if ((T[I] <> FT[I]) and (T[I] <> '?')) then
    Match:= False;
SameName:= Match;
end;



procedure dirClLoc;     {firstDirSector enthaellt die ClusterNr des naechsten}
{  Directory Clusters. dirClLoc berechnet dirTrack, dirSector & dirsecs}

begin

  dirTrack := ((firstDirSector{cluster}-2) * secsPerCluster) div NSectors;
  dirSector := ((firstDirSector{cluster}-2) * secsPerCluster) mod NSectors;
  dirSector := dirSector+firstDataSector;
  dirTrack := dirTrack+firstDataTrack+(dirSector div NSectors);
  dirSector := dirSector mod NSectors;

  if dirSector = 0 then begin
    dirSector := NSectors-1;
    dirTrack := dirTrack-1
  end
  else
    dirSector := dirSector-1;
  dirsecs := secsPerCluster

end;



procedure SearchNextAll(FileName: Str20; var Error: integer);
const
  SizePC_FCB = 32;
var
  I,FCBsPerSector: integer;

begin
  repeat
    Error:= FoundDir;  { default }
    FCBsPerSector:= (SectorSize div SizePC_FCB);

    if ((DirOffset mod FCBsPerSector) = 0) then begin
      DirOffset:= 0;
      NextSector(DirSector,DirTrack);
      ReadSector(DirSector,DirTrack,Addr(DirBuffer));
      DirSectorCount:= DirSectorCount +1;
    end;

    if (dirSectorCount = dirSecs) and (not rootSearch) then begin
      firstDirSector := FATPointer (firstDirSector);
      if firstDirSector < $ff8 then
        dirClLoc
    end;

    if (DirSectorCount < DirSecs) then begin
      DOS_FCB:= ptr(addr(DirBuffer) + (DirOffset * SizePC_FCB));
      if (DOS_FCB^.Name[1] in [#0,#$F6,#$E5]) then
        Error:= MTDirectory;
    end
    else
      Error:= EODirectory;

    DirOffset:= DirOffset +1;

  until ((Error = EODirectory)
      or (Error = MTDirectory)
      or (SameName(FileName,DOS_FCB^.Name,DOS_FCB^.Extention)));

  If (Error = EODirectory) Then Begin
    VolumeName:= False;
    SubDirName:= False;
  End
  Else Begin
    VolumeName:= (DOS_FCB^.Attribute and $08) <> 0;
    SubDirName:= (DOS_FCB^.Attribute and $10) <> 0;
  End
end;    {searchNextAll}



procedure SearchNext(FN: Str20; var Err: integer);
begin
repeat
  SearchNextAll(FN,Err);
  if (DOS_FCB^.Name[1] = #0) then { "high water" mark }
    Err:= EODirectory;
  until ((Err = EODirectory) or (Err = FoundDir));
end;



procedure SearchFirstAll( FileName: Str20; var Error: integer );
const
  SizePC_FCB = 32;
var
  I: integer;
begin
  DirOffset := 0;
  DirSectorCount := -1;
  if rootSearch then begin
    DirTrack:= (firstdirsector-1) div nsectors;
    DirSector:= (FirstDirSector -1) mod nsectors
  end
  else begin
    firstDirSector := dirCluster;
    dirClLoc
  end;
  SearchNextAll(FileName,Error);
end;


 

procedure SearchFirst(FN: Str20; var Err: integer);
begin
SearchFirstAll(FN,Err);
if (Err = MTDirectory) then
  SearchNext(FN,Err);
end;



procedure openSubDir (dirName: str20);

var
  err: integer;

begin
  searchFirst (dirName, err);
  while (not subDirName) and (err <> EODirectory) do
    searchNext (dirName, err);
  if (err = EODirectory) then begin
    writeln;
    writeln ('Directory not found: "', dirName, '"');
    continue
  end
  else begin    {gefundenes Subdirectory oeffnen}
    dirCluster := DOS_FCB^.clusterNo;
    rootSearch := false
  end
end;



procedure goPath;

var
  subDirName: str20;            {Name eines Unterverzeichnisses}
  pathPos: integer;             {Position in pathStr}
  pathEnd: boolean;             {Ende des Pfadnamens erreicht}

begin
  rootSearch := true;
  pathPos := 1;
  while pathPos <= length (pathStr) do
    if pathStr [pathPos] = '\' then
      pathPos := pathPos+1
    else begin
      subDirName := '';
      repeat
        subDirName := subDirName+pathStr [pathPos];
        pathPos := succ (pathPos);
        if pathPos <= length (pathStr) then
          pathEnd := (pathStr [pathPos] = '\')
        else
          pathEnd := true
      until pathEnd;
      openSubDir (subDirName)
    end {while}
end;



procedure IdentifyMS_DOS;

var
  boot: record
    dummy1: array [0..10] of byte;
    bps: integer;
    cls: byte;
    rsv: integer;
    fas: byte;
    dis: integer;
    sec: integer;
    med: byte;
    spf: integer;
    spt: integer;
    hds: integer;
    hid: integer;
    dummy2: array [30..511] of byte
  end;

begin

  bdos (13);                        { Disk Reset }
  bdos(14, CPM_Drive);              { CPM_Drive zum Bezugslaufwerk machen }
  dosnew:=true;

  RecordsPerSector:= SectorSize div 128;
  FirstFATSector:= 1;

  readsector (0, 0, addr (boot));
  with boot do begin
    identity := ds8spt;
    fatsize := spf;
    fatnum := fas;
    IF (sectorsize > 0) AND (dis > 0) AND (dis < 1000) THEN
       dirsecs := (dis*32) div sectorsize
    ELSE
       identity := unidentified;
    nsectors := spt;
    SecsPerCluster := cls;
    IF nsectors > 0 THEN
       ntracks := sec div nsectors
    ELSE
       identity := unidentified;
    singlesided := true;
  end;
  IF sectorSize * fatSize <= MaxFATSize THEN BEGIN
     GetFAT;
     IF fat[1] <> boot.med THEN BEGIN
        writeln('ERR: Media Bytes in Boot Sector and FAT don',
                      chr (39), 't match.');
        Identity := Unidentified;
     END;
  END ELSE BEGIN
     writeln('ERR: FAT too big or disk has no valid BOOT Sector');
     writeln;
     Identity := Unidentified;
  END;
  if not (Identity = Unidentified) then begin
    FirstDirSector:=   FatSize * 2 + FirstFATSector;
    FirstDataSector:=  (FirstDirSector + DirSecs) mod NSectors;
    FirstDataTrack:=   (FirstDirSector + DirSecs) div NSectors;
    NClusters:= (NTracks * NSectors div SecsPerCluster)
                - (((FATSize * 2) + DirSecs + 1) div SecsPerCluster);
    goPath      {Pfad bis zum gewuenschten Subdir entlanggehen}
  end ELSE
    continue;
end;



procedure showboot;

type

  sector = array [0..511] of byte;

  word = integer;


var

  boot: record
    case dummy: boolean of
     true: (
      dummy1: array [0..10] of byte;
      bps: integer;
      cls: byte;
      rsv: integer;
      fas: byte;
      dis: integer;
      sec: integer;
      med: byte;
      spf: integer;
      spt: integer;
      hds: integer;
      hid: integer;
      dummy2: array [30..511] of byte);
     false: (
      all: sector)
  end;

  check: word;          {TOS Pruefsumme des Bootsektors}

  i: integer;


begin   {showboot}

  bdos (13);                        { Disk Reset }
  bdos(14, CPM_Drive);              { CPM_Drive zum Bezugslaufwerk machen }

  writeln;
  if addr (boot.dummy1) <> addr (boot.all) then
    writeln ('Prg Fehler: Boot Record falsch definiert.');
  readsector (0, 0, addr (boot.all));
  with boot do begin
    if spt <> 0 then
      writeln ('Number of tracks   ', sec div spt)
    else
      writeln ('-- Error in this Boot Sector');
    writeln ('bytes / sector     ', bps);
    writeln ('cluster size       ', cls);
    writeln ('reserved sectors   ', rsv);
    writeln ('# FATs             ', fas);
    writeln ('# Dir entries      ', dis);
    writeln ('# sectors          ', sec);
    writeln ('media              ', med);
    writeln ('sectors / FAT      ', spf);
    writeln ('sectors / track    ', spt);
    writeln ('# heads            ', hds);
    writeln ('hidden sectors     ', hid);
    writeln;

    check := 0;
    for i := 0 to 255 do
      check := check+((all[2*i] shl 8)+all[2*i+1]);
    if check = $1234 then begin
      writeln ('This Disk has an executable TOS Boot record');
      writeln
    end

  end;

  continue
end;