Program Directory;

{$path"ram:include/","pascal:include/";incl"libraries/dos.h"}

Const
 maxname=80;

Var
 name:String[maxname];
 inf: p_FileInfoBlock;
 MyLock: BPTR;
 st: integer;

Procedure FullName(Sohn:BPTR; Flag:Boolean);
  { Rekursiv den vollen Verzeichnisnamen ermitteln.
    Die Fileinfo-Struktur enthält jeweils nur den eigentlichen Namen
    ohne Pfadangabe. Deshalb hangelt sich diese Prozedur über "ParentDir"
    rekursiv nach oben. Gibt es kein "ParentDir" mehr, so ist der
    Devicename erreicht, so daß ein ":" dahinter zu setzen ist.
    "Flag" gibt an, ob ggf. ein "/" am Ende gesetzt werden soll. }

  Var Vater:BPTR;
      fib:p_FileInfoBlock;
      stat:integer;
  Begin
    Vater:=ParentDir(Sohn);
    If Vater<>0 Then
      Fullname(Vater,true); { zuerst aufwärts gehen }
    fib:=ptr(Alloc_Mem(sizeOf(FileInfoBlock),0));
    { Die FileInfo-Striktur muß, da das Dos in BCPL geschrieben ist, an
      einer durch 4 teilbaren Adresse liegen. Deshalb ist es nicht
      möglich, sie als Variable zu deklarieren.  }
    stat:=Examine(Sohn,fib);
      { Info in Puffer lesen }
    If stat<>0 Then { nur wenn kein Fehler auftrat }
      write(fib^.fib_filename);
    If Vater=0 Then
      write(':')    { Kein Vorgänger, also Devicename }
    Else
      If flag Then write('/'); { Slash kann unterdrückt werden }
    Free_Mem(Long(fib),SizeOf(FileInfoBlock))
  End;

Procedure GetName;
  { Parameter auswerten und in "name" ablegen }
  Var s:String[maxname];
      i,j:integer;
  Begin
    If parameterlen>=maxname Then  { Name zu lang }
      Name:=''
    Else
      Begin
        s:=parameterstr;
        s[parameterlen+1]:=chr(0); { richtig beenden }
        i:=1;
        While (s[i]=' ') Do i:=succ(i); { führende Leerzeichen überlesen }
        j:=1;
        While s[i]>' ' Do  { Beim ersten Space oder Stringende stoppen }
          Begin
            name[j]:=s[i];  { Zeichenweise kopieren }
            i:=succ(i);
            j:=succ(j)
          End;
        name[j]:=chr(0)    { Stringende markieren }
      End
  End;

Begin
  If not FromWB Then { kann nicht von Workbench gestartet werden }
    Begin
      inf:=ptr(Alloc_Mem(sizeOf(FileInfoBlock),0));
        { Speicher für Puffer reservieren }
      GetName; { Parameter lesen }
      MyLock:=Lock(Name,-2);  { Lock-Struktur auf Verzeichnis anlegen }
      If MyLock=0 Then
        writeln('Fehler: ',name,' konnte nicht gefunden werden.')
      Else
        Begin
          st:=Examine(MyLock,inf);
          writeln;
          If st<>0 Then
            Begin
              FullName(MyLock,false);
              writeln;
            End;
          If inf^.fib_DirEntryType<=0 Then
            writeln('Dies ist eine Datei!')  { Es wurde ein Dateiname angegeben }
          Else
            Begin
              st:=ExNext(MyLock,Inf)
              While st<>0 Do  { Dateien nacheinander durchgehen }
                Begin { Größe, Name und Kommentar ausgeben }
                  If inf^.fib_DirEntryType>0 Then
                    write('     Dir')
                  Else
                    write(inf^.fib_Size:8);
                  writeln(' ',inf^.fib_filename,' ',inf^.fib_comment);
                  st:=ExNext(MyLock,Inf)
                End;
              writeln
            End
        End;
      Free_Mem(Long(inf),SizeOf(FileInfoBlock))  { Pufferspeicher freigeben }
    End
End.