home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 11 / heimwerk / tree.bas < prev    next >
Encoding:
BASIC Source File  |  1989-08-25  |  5.1 KB  |  178 lines
  1. DECLARE SUB GetDir (Path$)
  2. DECLARE SUB FindNextFile (DTA$, Fehler%)
  3. DECLARE SUB GetCurrDrive (LW$)
  4. DECLARE SUB FindFirstFile (Pattern$, Attr%, Trans$, Result%)
  5.  
  6. '* ------------------------------------------------------- *
  7. '*                     TREE.BAS                            *
  8. '*    Auslesen der Verzeichnisse des aktuellen Laufwerks   *
  9. '*  in ein Array zur weiteren Verarbeitung, zum Beispiel   *
  10. '*  für einen cursorgesteuerten Verzeichniswechsel.        *
  11. '*                                                         *
  12. '*           (c) 1989  W.Rinke  &  TOOLBOX                 *
  13. '* ------------------------------------------------------- *
  14. CONST Normal    = 0
  15. CONST ReadOnly  = 1
  16. CONST Hidden    = 2
  17. CONST SysFile   = 4
  18. CONST VolumeID  = 8
  19. CONST Directory = 16
  20. CONST Archive   = 32
  21. CONST AnyFile   = 63        '* die Dateiattribute
  22.  
  23. CONST MaxDirs   = 500       '* Anzahl der Verzeichnisse
  24.  
  25. TYPE Registers
  26.   ax AS INTEGER
  27.   bx AS INTEGER
  28.   cx AS INTEGER
  29.   dx AS INTEGER
  30.   bp AS INTEGER
  31.   si AS INTEGER
  32.   di AS INTEGER
  33.   Flags AS INTEGER
  34.   ds AS INTEGER
  35.   es AS INTEGER
  36. END TYPE                    '* die Prozessor-Register
  37.  
  38. DIM SHARED EntryArray(1 TO MaxDirs) AS STRING
  39.                             '* Global: Array für Einträge
  40. COMMON counter%             '* Global: der Eintrag-Zähler
  41.  
  42. '* ---------------- Hauptprogramm ------------------------ *
  43. CALL GetCurrDrive(Drive$)   '* Aktuelles Laufwerk ermitteln
  44.  
  45. counter% = 0
  46.  
  47. FOR i% = 1 TO MaxDirs
  48.   EntryArray(i%) = ""       '* Array löschen
  49. NEXT i%
  50.  
  51. CALL GetDir(Drive$)         '* Rekursiv: Verzeichnisse lesen
  52.  
  53. FOR i% = 1 TO counter%
  54.   PRINT EntryArray(i%)      '* Bange Frage: Hat's geklappt?
  55. NEXT i%
  56.  
  57. END                         '* Nur zur Information...
  58.  
  59. '* ------------------------------------------------------- *
  60. SUB FindFirstFile (Pattern$, Attr%, Trans$, Result%)
  61. DIM Regs AS Registers
  62.  
  63.   Path$ = Pattern$ + CHR$(0)   '* Ende der Zeichenkette,
  64.                                '* braucht DOS
  65.   Regs.ax = &H2F00             '* aktuelle DTA sichern
  66.   CALL InterruptX(&H21, Regs, Regs)
  67.   DTASeg% = Regs.es
  68.   DTAOfs% = Regs.bx
  69.  
  70.   Trans$ = SPACE$(43)          '* Platz für eigenen Puffer
  71.   Regs.ax = &H1A00             '* eigener Puffer wird DTA
  72.   Regs.ds = VARSEG(Trans$)
  73.   Regs.dx = SADD(Trans$)
  74.   CALL InterruptX(&H21, Regs, Regs)
  75.  
  76.   Regs.ax = &H4E00             '* DOS: ersten passenden
  77.   Regs.cx = Attr%              '*      Eintrag suchen
  78.   Regs.ds = VARSEG(Path$)
  79.   Regs.dx = SADD(Path$)
  80.   CALL InterruptX(&H21, Regs, Regs)
  81.  
  82.   IF (Regs.Flags AND 1) = 1 THEN    '* Fehlererkennung
  83.     Fehler% = Regs.ax
  84.   ELSE
  85.     Fehler% = 0
  86.   END IF
  87.  
  88.   Regs.ax = &H1A00             '* DTA zurückschreiben
  89.   Regs.ds = DTASeg%
  90.   Regs.dx = DTAOfs%
  91.   CALL InterruptX(&H21, Regs, Regs)
  92.  
  93. END SUB
  94.  
  95. '* ------------------------------------------------------- *
  96. SUB FindNextFile (DTA$, Fehler%)
  97. DIM Regs AS Registers
  98.  
  99.   IF LEN(DTA$) <> 43 THEN      '* wurde 'FindFirst'
  100.     Fehler% = 2                '* aufgerufen?
  101.     EXIT SUB
  102.   END IF
  103.  
  104.   Regs.ax = &H2F00             '* aktuelle DTA sichern
  105.   CALL InterruptX(&H21, Regs, Regs)
  106.   DTASeg% = Regs.es
  107.   DTAOfs% = Regs.bx
  108.  
  109.   Regs.ax = &H1A00             '* DTA auf eigenen Puffer,
  110.   Regs.ds = VARSEG(DTA$)       '* enthält Suchkriterien
  111.   Regs.dx = SADD(DTA$)
  112.   CALL InterruptX(&H21, Regs, Regs)
  113.  
  114.   Regs.ax = &H4F00             '* suche nächsten Eintrag
  115.   CALL InterruptX(&H21, Regs, Regs)
  116.  
  117.   IF (Regs.Flags AND 1) = 1 THEN   '* Fehlererkennung
  118.     Fehler% = Regs.ax
  119.   ELSE
  120.     Fehler% = 0
  121.   END IF
  122.  
  123.   Regs.ax = &H1A00             '* DTA zurücksetzen
  124.   Regs.ds = DTASeg%
  125.   Regs.dx = DTAOfs%
  126.   CALL InterruptX(&H21, Regs, Regs)
  127.  
  128. END SUB
  129.  
  130. '* ------------------------------------------------------- *
  131. SUB GetCurrDrive (LW$)
  132. DIM Regs AS Registers
  133.  
  134.   Regs.ax = &H1900
  135.   CALL InterruptX(&H21, Regs, Regs)
  136.  
  137.   LW$ = CHR$((Regs.ax AND &HFF) + 65) + ":\"
  138.  
  139. END SUB
  140.  
  141. '* ------------------------------------------------------- *
  142. SUB GetDir (Path$)
  143. SHARED counter%
  144.  
  145.   CALL FindFirstFile(Path$+"*.*", Directory, DTA$, Fehler%)
  146.   IF Fehler% = 0 THEN
  147.     Attr = ASC(MID$(DTA$, 22, 1))
  148.     temp$ = MID$(DTA$, 31) + CHR$(0)
  149.     Nam$ = LEFT$(temp$, INSTR(temp$, CHR$(0)) - 1)
  150.     IF Attr = Directory AND LEFT$(Nam$, 1) <> "." THEN
  151.       counter% = counter% + 1
  152.       NewPath$ = Path$ + Nam$
  153.       EntryArray(counter%) = NewPath$
  154.       PRINT counter%, EntryArray(counter%)
  155.       CALL GetDir(NewPath$ + "\")
  156.     END IF
  157.  
  158.     DO
  159.       CALL FindNextFile(DTA$, Fehler%)
  160.       IF Fehler% = 0 THEN
  161.         Attr = ASC(MID$(DTA$, 22, 1))
  162.         temp$ = MID$(DTA$, 31) + CHR$(0)
  163.         Nam$ = LEFT$(temp$, INSTR(temp$, CHR$(0)) - 1)
  164.         IF Attr = Directory AND LEFT$(Nam$, 1) <> "." THEN
  165.           counter% = counter% + 1
  166.           NewPath$ = Path$ + Nam$
  167.           EntryArray(counter%) = NewPath$
  168.           PRINT counter%, EntryArray(counter%)
  169.           CALL GetDir(NewPath$ + "\")
  170.         END IF
  171.       END IF
  172.     LOOP UNTIL Fehler% = 18
  173.   END IF
  174.  
  175. END SUB
  176. '* ------------------------------------------------------- *
  177. '*                Ende von TREE.BAS                        *
  178.