home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Pascal / MAXONPASCAL3.DMS / in.adf / DEMOS-OS1.3 / Directory.p < prev    next >
Encoding:
Text File  |  1994-07-23  |  3.3 KB  |  108 lines
  1. { MaxonPascal3 Anpassung / Test: Falk Zühlsdorff (PackMAN) 1994 }
  2.  
  3. Program Directory;
  4. USES DOS;
  5.  
  6. Const
  7.  maxname=80;
  8.  
  9. Var
  10.  name:String[maxname];
  11.  inf: p_FileInfoBlock;
  12.  MyLock: BPTR;
  13.  st: integer;
  14.  
  15. Procedure FullName(Sohn:BPTR; Flag:Boolean);
  16.   { Rekursiv den vollen Verzeichnisnamen ermitteln.
  17.     Die Fileinfo-Struktur enthält jeweils nur den eigentlichen Namen
  18.     ohne Pfadangabe. Deshalb hangelt sich diese Prozedur über "ParentDir"
  19.     rekursiv nach oben. Gibt es kein "ParentDir" mehr, so ist der
  20.     Devicename erreicht, so daß ein ":" dahinter zu setzen ist.
  21.     "Flag" gibt an, ob ggf. ein "/" am Ende gesetzt werden soll. }
  22.  
  23.   Var Vater:BPTR;
  24.       fib:p_FileInfoBlock;
  25.       stat:integer;
  26.   Begin
  27.     Vater:=ParentDir(Sohn);
  28.     If Vater<>0 Then
  29.       Fullname(Vater,true); { zuerst aufwärts gehen }
  30.     fib:=ptr(Alloc_Mem(sizeOf(FileInfoBlock),0));
  31.     { Die FileInfo-Striktur muß, da das Dos in BCPL geschrieben ist, an
  32.       einer durch 4 teilbaren Adresse liegen. Deshalb ist es nicht
  33.       möglich, sie als Variable zu deklarieren.  }
  34.     stat:=Examine(Sohn,fib);
  35.       { Info in Puffer lesen }
  36.     If stat<>0 Then { nur wenn kein Fehler auftrat }
  37.       write(fib^.fib_filename);
  38.     If Vater=0 Then
  39.       write(':')    { Kein Vorgänger, also Devicename }
  40.     Else
  41.       If flag Then write('/'); { Slash kann unterdrückt werden }
  42.     Free_Mem(Long(fib),SizeOf(FileInfoBlock))
  43.   End;
  44.  
  45. Procedure GetName;
  46.   { Parameter auswerten und in "name" ablegen }
  47.   Var s:String[maxname];
  48.       i,j:integer;
  49.   Begin
  50.     If parameterlen>=maxname Then  { Name zu lang }
  51.       Name:=''
  52.     Else
  53.       Begin
  54.         s:=parameterstr;
  55.         s[parameterlen+1]:=chr(0); { richtig beenden }
  56.         i:=1;
  57.         While (s[i]=' ') Do i:=succ(i); { führende Leerzeichen überlesen }
  58.         j:=1;
  59.         While s[i]>' ' Do  { Beim ersten Space oder Stringende stoppen }
  60.           Begin
  61.             name[j]:=s[i];  { Zeichenweise kopieren }
  62.             i:=succ(i);
  63.             j:=succ(j)
  64.           End;
  65.         name[j]:=chr(0)    { Stringende markieren }
  66.       End
  67.   End;
  68.  
  69. Begin
  70.   If not FromWB Then { kann nicht von Workbench gestartet werden }
  71.     Begin
  72.       inf:=ptr(Alloc_Mem(sizeOf(FileInfoBlock),0));
  73.         { Speicher für Puffer reservieren }
  74.       GetName; { Parameter lesen }
  75.       MyLock:=Lock(Name,-2);  { Lock-Struktur auf Verzeichnis anlegen }
  76.       If MyLock=0 Then
  77.         writeln('Fehler: ',name,' konnte nicht gefunden werden.')
  78.       Else
  79.         Begin
  80.           st:=Examine(MyLock,inf);
  81.           writeln;
  82.           If st<>0 Then
  83.             Begin
  84.               FullName(MyLock,false);
  85.               writeln;
  86.             End;
  87.           If inf^.fib_DirEntryType<=0 Then
  88.             writeln('Dies ist eine Datei!')  { Es wurde ein Dateiname angegeben }
  89.           Else
  90.             Begin
  91.               st:=ExNext(MyLock,Inf)
  92.               While st<>0 Do  { Dateien nacheinander durchgehen }
  93.                 Begin { Größe, Name und Kommentar ausgeben }
  94.                   If inf^.fib_DirEntryType>0 Then
  95.                     write('     Dir')
  96.                   Else
  97.                     write(inf^.fib_Size:8);
  98.                   writeln(' ',inf^.fib_filename,' ',inf^.fib_comment);
  99.                   st:=ExNext(MyLock,Inf)
  100.                 End;
  101.               writeln
  102.             End
  103.         End;
  104.       Free_Mem(Long(inf),SizeOf(FileInfoBlock))  { Pufferspeicher freigeben }
  105.     End
  106. End.
  107.  
  108.