'
' (06/99 Ulli Gruszka, basierend auf Routinen von Frank Rüger)
' Diese Listing zeigt und erläutert einige wesentliche Routinen zum Umgang
' mit Verzeichnissen und Dateien unter allen Dateisystemen. Dies geschieht
' im Rahmen einer Prozedur zum Lesen und Ausgeben aller Dateien/Ordner eines
' Verzeichnisses. Eine weitere Funktion zeigt die Technik zum vollständigen,
' rekursiven Lesen bzw. Ausgeben aller Dateien/Ordner eines Verzeichnisses
' inklusive der Unterverzeichnisse.
'
@init                                   ! Konstanten belegen und
'                                         XATTR/DTA-Struktur anlegen.
IF @pdomain(dom_mint&)<>EINVFN%         ! In die MiNT-Domain schalten und
  domain&=@pdomain(-1)                  ! dann die nun aktuelle Domain merken.
ENDIF                                   ! (wird im Fehlerfall 0L = TOS-Domain)
'
pfad$="c:\"                             ! Startverzeichnis (beliebig)
mask$="*.*"                             ! Maske anzuzeigender Dateien (dito)
'                                         (Wildcards * und ? sind erlaubt)
attribute&=&X101111                     ! Bit   Finde folgende:
'                                     x    0    Schreibgeschützte Datei
'                                     x    1    Versteckte Datei
'                                     x    2    Systemdatei
'                                     x    3    Diskettenname
'                                          4    Ordner
'                                     x    5    Datei mit gesetztem Archivbit
'
dta%=FGETDTA()                          ! Alte DTA zum Restaurieren merken.
'
' Die Vorbereitungen sind erledigt, jetzt kann es losgehen:
'
~@alle_verzeichnisse(pfad$,mask$,attribute&) ! Rekursive Verzeichnisausgabe
'
' Sofern nur eine Ebene eines Verzeichnisses ausgegeben werden soll,
' muß der obere Funktionsaufruf auskommentiert und der folgende
' aktiviert werden. Gegebenenfalls noch Bit Nr. 4 der Attribute
' setzen, um die Unterordnernamen ebenfalls ausgeben zu lassen.
'
' @ein_verzeichnis(pfad$,mask$,attribute&) ! Einfache Verzeichnisausgabe
'
~FSETDTA(dta%)                          ! DTA zurücksetzen
'
EDIT                                    ! Ende der Durchsage.
'
' -- Die Verzeichnisroutinen ---------------------------------------------------
'
FUNCTION alle_verzeichnisse(pfad$,mask$,attribute&)
  $F%
  LOCAL neu_ordner$
  LOCAL neu_pfad$
  '
  ' Diese Funktion wird einmalig mit dem Startpfad, der gewünschten Dateimaske
  ' und den gewünschten Attributen aufgerufen. Von nun an ruft sich die
  ' Funktion solange selbst auf, bis die unterste Verzeichnisebene erreicht ist.
  ' Zunächst werden bei jedem Durchlauf die gesuchten Dateien der jeweiligen
  ' Ebene ausgegeben:
  '
  @ein_verzeichnis(pfad$,mask$,attribute&)
  '
  ' Ab hier werden die Unterverzeichnisse/Ordner der jeweiligen Ebene gesucht:
  '
  IF @my_fsfirst(pfad$+"*.*",&X10000,TRUE)=0    ! Der erste Ordner dieser Ebene.
    '                                            (zu TRUE siehe @my_fsfirst())
    '
    REPEAT
      '
      IF BYTE{gl_xattr_d_attrib%} AND &X10000   ! Ist es ein Ordner?
        neu_ordner$=CHAR{gl_xattr_d_fname%}     ! Ordner-Name holen und damit
        neu_pfad$=pfad$+neu_ordner$+"\"         ! den neuen Pfad bilden.
        '
        IF neu_ordner$<>"." and neu_ordner$<>".."  ! Pseudo-Ordner überspringen
        '                                            (Dank an Matthias Jaap!)
          IF @alle_verzeichnisse(neu_pfad$,mask$,attribute&)=FALSE  ! Rekursion!
            RETURN FALSE                        ! Eine Stufe zurück bzw. Ende.
          ENDIF
        ENDIF
        '                                         Den nächsten Ordner nach dem
        ~@my_fsfirst(pfad$+"*.*",&X10000,TRUE)  ! gerade gelesenen suchen, indem
        WHILE neu_ordner$<>CHAR{gl_xattr_d_fname%} ! die Namen verglichen werden,
          ~@my_fsnext(pfad$+"*.*",&X10000)<>0   ! um dort weiterzumachen.
        WEND
      ENDIF
      '                                           Auf der (übergeordneten)
    UNTIL @my_fsnext(pfad$+"*.*",&X10000)<>0    ! Ebene weitersuchen.
    '
  ENDIF
  '
  RETURN TRUE
  '
ENDFUNC
PROCEDURE ein_verzeichnis(pfad$,mask$,attr&)
  LOCAL ex&
  '
  ' Hier werden die passenden Dateien/Ordner einer Ebene gesucht und auf
  ' dem Bildschirm ausgegeben. Der jeweilige Name findet sich nach Aufruf
  ' der Verzeichnisfunktion in der DTA-Struktur. Von dort kann er natürlich
  ' auch in ein String-Array, in einen Speicherblock oder in eine Datei
  ' geschrieben werden. Die restlichen Dateiinformationen befinden sich
  ' ebenfalls in der DTA-Struktur.
  '
  IF @my_fsfirst(pfad$+mask$,attr&,TRUE)=0      ! Erste Datei
    '                                             (zu TRUE siehe @my_fsfirst())
    REPEAT
      '
      IF BYTE{gl_xattr_d_attrib%} AND &X10000             ! Ist es ein Ordner?
        PRINT "Ordner: ";pfad$;CHAR{gl_xattr_d_fname%}    ! Namen ausgeben
      ELSE IF BYTE{gl_xattr_d_attrib%} AND attr&          ! Ist es eine Datei?
        PRINT " Datei: ";pfad$;CHAR{gl_xattr_d_fname%}    ! Namen ausgeben
        ' PRINT "        ";{gl_xattr_d_length%};" Byte"   ! Dateilänge
      ENDIF
      '
      ex&=@my_fsnext(pfad$+mask$,attr&)         ! Weitersuchen bis zum Ende.
      '
    UNTIL ex&<>0                                ! Keine weiteren Dateien.
    '
  ENDIF
  '
RETURN
'
' -- Die Unterprogramme --------------------------------------------------------
'

FUNCTION pdomain(dom&)
  $F%
  ' dom&=-1     Abfrage der aktuellen Domain
  ' dom&=0      Schalte in die TOS-Domain
  ' dom&=1      Schalte in die MiNT-Domain
  RETURN GEMDOS(pdomain&,dom&)
ENDFUNC
'
FUNCTION my_fsfirst(datei$,attr&,next!)
  $F%
  ' Der Ersatz zu FSFIRST(). Achtung: Der zusätzliche Parameter (next!) muß
  ' auf TRUE gesetzt werden, wenn anschließend my_fsnext() aufgerufen wird.
  ' Wird my_fsfirst() nur einmalig aufgerufen (z.B. zur Existenzprüfung), so
  ' ist next! auf FALSE zu setzen!
  '
  LOCAL all_names!
  LOCAL match_name!
  LOCAL attrib&
  LOCAL fehler%
  LOCAL bufdatei$
  LOCAL dateiname$
  LOCAL path$
  '
  @chk_dirhandle
  '
  @pfad(datei$,path$)
  '
  IF domain&=1                                  ! Nur wenn wir uns auch in der
    gl_dirhandle%=@dopendir(path$,0)            ! MiNT-Domain befinden öffnen.
  ELSE
    gl_dirhandle%=einvfn%                       ! Normales FSFIRST/FSNEXT
  ENDIF
  '
  IF gl_dirhandle%=einvfn%                      ! (-32) Kein passendes Filesystem
    gl_dirhandle%=0                             ! oder nicht in der MiNT-Domain
    '
    gl_xattr_d_attrib%=ADD(gl_xattrbuf%,&H15)   ! Zum vereinfachten Zugriff auf
    gl_xattr_d_time%=ADD(gl_xattrbuf%,&H16)     ! die DTA (nimmt die Ergebnisse
    gl_xattr_d_date%=ADD(gl_xattrbuf%,&H18)     ! der Funktion auf) werden einige
    gl_xattr_d_length%=ADD(gl_xattrbuf%,&H1A)   ! globale Variablen mit den
    gl_xattr_d_fname%=ADD(gl_xattrbuf%,&H1E)    ! Struktur-Adressen belegt.
    '
    ~FSETDTA(gl_xattrbuf%)                      ! DTA setzen
    '
    RETURN FSFIRST(datei$,attr&)
    '
  ELSE                                          ! In der MiNT-Domain:
    fehler%=gl_dirhandle%
    IF (SHR(gl_dirhandle%,24) AND &HFF)<>&HFF
      gl_xattr_d_attrib%=ADD(gl_xattrbuf%,&H29) ! Variablen belegen (siehe oben)
      gl_xattr_d_time%=ADD(gl_xattrbuf%,&H1C)
      gl_xattr_d_date%=ADD(gl_xattrbuf%,&H1E)
      gl_xattr_d_length%=ADD(gl_xattrbuf%,&H10)
      gl_xattr_d_fname%=ADD(gl_fnamebuf%,&H4)
      '
      @filename(datei$,dateiname$)              ! Datei extrahieren
      IF dateiname$="*.*" OR dateiname$="*"
        dateiname$="*"
        all_names!=-1
      ENDIF
      CHAR{gl_fnamebuf%}=""                     ! Struktur bereinigen
      '
      fehler%=@dreaddir(255,gl_dirhandle%,gl_fnamebuf%) ! Lesen
      '
      WHILE fehler%=0
        bufdatei$=CHAR{gl_xattr_d_fname%}       ! Die gefundene Datei
        IF all_names!                           ! Gesucht wurde *.*
          match_name!=TRUE
        ELSE
          match_name!=@match(UPPER$(bufdatei$),UPPER$(dateiname$))
        ENDIF
        IF match_name!=TRUE                     ! entspricht dem Suchkriterium
          datei$=path$+bufdatei$                ! Kompletter Zugriffspfad
          IF @fxattr(0,datei$,gl_xattrbuf%)=0
            attrib&=INT{PRED(gl_xattr_d_attrib%)}
            IF attrib&=0 AND (attr& AND fa_file&)=fa_file&
              attrib&=fa_file&
            ENDIF
            IF (attrib& AND attr&) OR attr&=0
              IF NOT next!                      ! Dem my_fsfirst() folgt kein
                ~@dclosedir(gl_dirhandle%)      ! my_fsnext(), also Verzeichnis
                CLR gl_dirhandle%               ! wieder schließen.
              ENDIF
              RETURN 0
            ENDIF
          ENDIF
        ENDIF
        fehler%=@dreaddir(255,gl_dirhandle%,gl_fnamebuf%)
      WEND
      ~@dclosedir(gl_dirhandle%)
    ENDIF
  ENDIF
  '
  CLR gl_dirhandle%
  RETURN fehler%
  '
ENDFUNC
FUNCTION my_fsnext(datei$,attr&)
  $F%
  ' Der Ersatz zu FSNEXT().
  '
  LOCAL all_names!
  LOCAL match_name!
  LOCAL attrib&
  LOCAL fehler%
  LOCAL bufdatei$
  LOCAL dateiname$
  LOCAL path$
  '
  IF gl_dirhandle%                              ! Aufruf erfolgte aus MiNT-Domain
    '
    @pfad(datei$,path$)                         ! Pfad extrahieren
    @filename(datei$,dateiname$)                ! Dateiname extrahieren
    IF dateiname$="*.*" OR dateiname$="*"
      dateiname$="*"
      all_names!=TRUE
    ENDIF
    '
    CHAR{gl_fnamebuf%}=""                       ! Struktur bereinigen
    fehler%=@dreaddir(255,gl_dirhandle%,gl_fnamebuf%)   ! Lesen
    WHILE fehler%=0
      bufdatei$=CHAR{gl_xattr_d_fname%}
      IF all_names!                             ! Gesucht wurde *.*
        match_name!=TRUE
      ELSE
        match_name!=@match(UPPER$(bufdatei$),UPPER$(dateiname$))
      ENDIF
      IF match_name!=TRUE                       ! entspricht dem Suchkriterium
        datei$=path$+bufdatei$                  ! Kompletter Zugriffspfad
        IF @fxattr(0,datei$,gl_xattrbuf%)=0
          attrib&=INT{PRED(gl_xattr_d_attrib%)}
          IF attrib&=0 AND (attr& AND &H27)=&H27
            attrib&=&H27
          ENDIF
          IF (attrib& AND attr&) OR attr&=0
            RETURN 0
          ENDIF
        ENDIF
      ENDIF
      fehler%=@dreaddir(255,gl_dirhandle%,gl_fnamebuf%)
    WEND
    ~@dclosedir(gl_dirhandle%)
    CLR gl_dirhandle%
    RETURN fehler%
  ELSE IF gl_has_dopendir!
    RETURN enmfil%          ! -49
    '
  ELSE                                         ! Aufruf erfolgte aus TOS-Domain
    RETURN FSNEXT()
  ENDIF
  '
ENDFUNC
'
FUNCTION fxattr(flag&,fname$,buf%)
  $F%
  '
  fname$=fname$+CHR$(0)
  '
  RETURN GEMDOS(fxattr&,flag&,L:V:fname$,L:buf%)
  '
ENDFUNC
'
FUNCTION dopendir(dir$,flag&)
  $F%
  '
  LOCAL fehler%
  '
  LET dir$=dir$+CHR$(0)
  '
  fehler%=GEMDOS(dopendir&,L:V:dir$,flag&)
  '
  ' Internes Flag für dieses eine Verzeichnis:
  gl_has_dopendir!=fehler%<>einvfn%      ! -32
  '
  RETURN fehler%
  '
ENDFUNC
FUNCTION dclosedir(dirhandle%)
  $F%
  '
  RETURN GEMDOS(dclosedir&,L:dirhandle%)
  '
ENDFUNC
FUNCTION dreaddir(size&,dirhandle%,buf%)
  $F%
  '
  RETURN GEMDOS(dreaddir&,size&,L:dirhandle%,L:buf%)
  '
ENDFUNC
'
' --- Diverses ----------------------------------------------------------------
'
PROCEDURE init
  '
  ' 256 Bytes Puffer für Dreaddir() und 64 Bytes für
  ' XATTR/DTA-Struktur über ein INLINE bereitstellen:
  '
  INLINE gl_fnamebuf%,320
  gl_xattrbuf%=ADD(gl_fnamebuf%,256)
  '
  fa_file&=&H27

  '
  ' Die folgende Variablenliste enthält alle relevanten GEMDOS-Funktionsnummern
  ' und Parameter. Es handelt sich also nicht um echte Variablen, sondern um
  ' feststehende Werte bzw. Konstanten. Wir nennen sie symbolische Konstanten,
  ' da sie vom ergo!pro-Präprozessor als Symbole (siehe ++SYM-Kommando)
  ' interpretiert werden und vor dem Compilieren überall im Listing durch
  ' ihren Wert ersetzt werden.
  '
  ' Durch dieses Verfahren bleibt das Listing gut lesbar, ohne dass im Compilat
  ' unnötig Speicherplatz für sich nie ändernde Variablen beansprucht wird.
  ' Definierte, aber nicht verwendete Konstanten, werden vom Präprozessor
  ' natürlich ebenfalls rechtzeitig aus dem Listing entfernt.
  ' [Ende der Werbung :-]
  '
  ' Die (symbolischen) GEMDOS-Konstanten:
  '
  '     ++SYM
  '
  LET dsetdrv&=14
  LET dgetdrv&=25
  LET super&=32
  LET tgetdate&=42
  LET tgettime&=44
  LET sversion&=48
  LET dfree&=54
  LET dcreate&=57
  LET dsetpath&=59
  LET fcreate&=60
  LET fopen&=61
  ' Fopen()-Modi
  LET readonly&=0
  LET readwrite&=2
  '
  LET fclose&=62
  LET fread&=63
  LET fwrite&=64
  ' Standard-Kan&auml;le
  LET stdprn&=3
  LET fdelete&=65
  LET fseek&=66
  ' Modi
  LET seek_set&=0
  LET seek_cur&=1
  LET seek_end&=2
  LET mxalloc&=68
  ' Modi
  LET mx_stonly&=0
  LET mx_altonly&=1
  LET mx_prefst&=2
  LET mx_prefalt&=3
  ' MTOS-Speicherschutz (OR)
  LET mx_prot_default&=0
  LET mx_prot_private&=&H10
  LET mx_prot_global&=&H20
  LET mx_prot_super&=&H30
  LET mx_prot_readable&=&H40
  LET mx_prot_no_free&=&H4000
  LET dgetpath&=71
  LET pexec&=75
  ' Modi
  LET loadgo&=0
  ' ' Dateiattribute für Fsfirst()
  LET fa_rdonly&=&H1
  LET fa_hidden&=&H2
  LET fa_system&=&H4
  LET fa_label&=&H8
  LET fa_direc&=&H10
  LET fa_arch&=&H20
  LET fa_attrib&=&H17
  LET fa_file&=&H27
  LET fa_other&=&H18
  LET frename&=86
  LET fdatime&=87
  ' Get/Set
  LET fd_read&=0
  LET fd_write&=1
  LET mfork&=112
  LET pdomain&=281
  '  Domains
  LET dom_tos&=0
  LET dom_mint&=1
  LET dopendir&=296
  LET dreaddir&=297
  LET dclosedir&=299
  LET fxattr&=300
  LET dreadlabel&=338
  '
  e_ok%=0
  einvfn%=-32
  efilnf%=-33
  epthnf%=-34
  enhndl%=-35
  eaccdn%=-36
  eihndl%=-37
  ensmem%=-39
  eimba%=-40
  edrive%=-46
  ensame%=-48
  enmfil%=-49
  elocked%=-58
  enslock%=-59
  erange%=-64
  eintrn%=-65
  eplfmt%=-66
  egsbf%=-67
  ebreak%=-68
  excpt%=-69
  epthov%=-70
  '
  '     ++SYM
  '
RETURN
PROCEDURE chk_dirhandle
  IF gl_dirhandle%
    ~@dclosedir(gl_dirhandle%)
    CLR gl_dirhandle%
  ENDIF
RETURN
FUNCTION match(strng$,pattern$)
  $F%
  '
  LOCAL pattern0$
  LOCAL strng0$
  '
  pattern0$=pattern$+CHR$(0)
  strng0$=strng$+CHR$(0)
  '
  RETURN @search(V:strng0$,V:pattern0$)
  '
ENDFUNC
FUNCTION search(strng%,pattern%)
  $F%
  '
  LOCAL nochmal!
  '
  REPEAT
    CLR nochmal!
    IF BYTE{strng%}=0
      IF BYTE{pattern%}=0
        RETURN -1
      ELSE IF BYTE{pattern%}=42   !"*"
        INC pattern%
        nochmal!=-1
      ENDIF
    ELSE
      IF BYTE{pattern%}=42        !"*"
        RETURN @search(strng%,SUCC(pattern%)) OR @search(SUCC(strng%),pattern%)
      ELSE IF BYTE{pattern%}=BYTE{strng%} OR BYTE{pattern%}=63      !"?"
        INC pattern%
        INC strng%
        nochmal!=-1
      ENDIF
    ENDIF
  UNTIL NOT nochmal!
  RETURN 0
ENDFUNC
PROCEDURE filename(datei$,VAR match$)
  '
  ' Extrahiert einen Dateinamen
  '
  LOCAL match&
  match&=SUCC(RINSTR(datei$,"\"))
  IF match&>0
    match$=MID$(datei$,match&)
  ELSE
    CLR match$
  ENDIF
RETURN
PROCEDURE pfad(datei$,VAR match$)
  '
  ' Extrahiert einen Pfad
  '
  LOCAL match&
  match&=RINSTR(datei$,"\")
  IF match&>0
    match$=LEFT$(datei$,match&)
  ELSE
    CLR match$
  ENDIF
RETURN