home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 10 / heimwerk / request.bas next >
Encoding:
BASIC Source File  |  1989-07-25  |  8.1 KB  |  275 lines
  1. DECLARE SUB FindNextFile (DTA$, Fehler%)
  2. DECLARE SUB FindFirstFile (Path$, DTA$, Fehler%)
  3. '* ------------------------------------------------------- *
  4. '*                    REQUEST.BAS                          *
  5. '*  stellt ein Bildschirmfenster zur Verfügung, in dem     *
  6. '*  die Einträge des angewählten Verzeichnisses mit einem  *
  7. '*  Auswahlbalken angewählt und mit <RETURN> übernommen    *
  8. '*  werden können.                                         *
  9. '*          (c) 1989  W.Rinke  &  TOOLBOX                  *
  10. '* ------------------------------------------------------- *
  11. CONST IstNormal       = 0
  12. CONST IstReadOnly     = 1
  13. CONST IstHidden       = 2
  14. CONST IstSystem       = 4
  15. CONST IstVolumeLabel  = 8
  16. CONST IstSubDirectory = 16
  17. CONST IstArchive      = 32    '* Die Dateiattribute ...
  18.  
  19. CONST MaxEintraege    = 100   '* Anzahl der Einträge im
  20.                               '* Verzeichnis
  21.  
  22. TYPE Regs                     '* Turbo Basic:
  23.   ax AS INTEGER               '* Register 1
  24.   bx AS INTEGER               '* Register 2
  25.   cx AS INTEGER               '* Register 3
  26.   dx AS INTEGER               '* Register 4
  27.   bp AS INTEGER               '* Register 7
  28.   si AS INTEGER               '* Register 5
  29.   di AS INTEGER               '* Register 6
  30.   flags AS INTEGER            '* Register 0
  31.   ds AS INTEGER               '* Register 8
  32.   es AS INTEGER               '* Register 9 von REG
  33. END TYPE
  34.  
  35. DIM Dir$(0 TO MaxEintraege)   '* bzW. 0:MaxEintraege
  36. DIM VideoBuffer%(4000)
  37.  
  38. '* suche die erste Datei, die auf das Muster "*.*" paßt
  39. '* (komplette Pfade können eingetragen werden)
  40.  
  41. CALL FindFirstFile("*.*", Eintrag$, Ergebnis%)
  42.  
  43. IF Ergebnis% = 0 THEN         '* Datei gefunden
  44.   i = 1
  45.   temp$ = MID$(Eintrag$, 31) + CHR$(0)
  46.   Dir$(i) = LEFT$(temp$, INSTR(temp$, CHR$(0)) - 1)
  47.                               '* Dateiname aus DTA holen
  48.   DO
  49.     CALL FindNextFile(Eintrag$, Ergebnis%)
  50.     i = i + 1
  51.     IF Ergebnis% = 0 THEN
  52.       temp$ = MID$(Eintrag$, 31) + CHR$(0)
  53.       Dir$(i) = LEFT$(temp$, INSTR(temp$, CHR$(0)) - 1)
  54.                               '* Dateiname aus DTA holen
  55.     END IF
  56.   LOOP UNTIL Ergebnis% = 18 OR Ergebnis% <> 0
  57.                               '* keine weitere Datei
  58. END IF
  59.  
  60. IstEintraege% = i - 1         '* gefundene Dateien
  61.  
  62. CLS                           '* für Testzwecke ...
  63.  
  64.                               '* ... Bildschirm sichern
  65. DEF SEG = &H40
  66. VideoMode% = PEEK(&H49)       '* ... Videomodus erkennen
  67. DEF SEG
  68.  
  69. IF VideoMode% = 7 THEN        '* Monochrom
  70.   DEF SEG = &HB000
  71. ELSE
  72.   DEF SEG = &HB800            '* Farbe
  73. END IF
  74.  
  75. FOR i% = 0 TO 3999
  76.   VideoBuffer%(i%) = PEEK(i%)
  77. NEXT i%
  78. DEF SEG
  79.  
  80. LOCATE 10, 10: COLOR 1, 7     '* Aufbau des Fensters
  81. PRINT "╔════════════════╗";
  82. LOCATE 11, 10: COLOR 1, 7
  83. PRINT "║                ║";
  84. COLOR 1, 0: PRINT CHR$(176);
  85. LOCATE 12, 10: COLOR 1, 7
  86. PRINT "║                ║";
  87. COLOR 1, 0: PRINT CHR$(176);
  88. LOCATE 13, 10: COLOR 1, 7
  89. PRINT "║                ║";
  90. COLOR 1, 0: PRINT CHR$(176);
  91. LOCATE 14, 10: COLOR 1, 7
  92. PRINT "║                ║";
  93. COLOR 1, 0: PRINT CHR$(176);
  94. LOCATE 15, 10: COLOR 1, 7
  95. PRINT "║                ║";
  96. COLOR 1, 0: PRINT CHR$(176);
  97. LOCATE 16, 10: COLOR 1, 7
  98. PRINT "║                ║";
  99. COLOR 1, 0: PRINT CHR$(176);
  100. LOCATE 17, 10: COLOR 1, 7
  101. PRINT "║                ║";
  102. COLOR 1, 0: PRINT CHR$(176)
  103. LOCATE 18, 10: COLOR 1, 7
  104. PRINT "║                ║";
  105. COLOR 1, 0: PRINT CHR$(176)
  106. LOCATE 19, 10: COLOR 1, 7
  107. PRINT "║                ║";
  108. COLOR 1, 0: PRINT CHR$(176)
  109. LOCATE 20, 10: COLOR 1, 7
  110. PRINT "║                ║";
  111. COLOR 1, 0: PRINT CHR$(176)
  112. LOCATE 21, 10: COLOR 1, 7
  113. PRINT "╚════════════════╝";
  114. COLOR 1, 0: PRINT CHR$(176)
  115. LOCATE 22, 11: COLOR 1, 0
  116. PRINT "░░░░░░░░░░░░░░░░░░";   '* das geht so am schnellsten
  117. COLOR 1, 7
  118.  
  119. FOR i = 1 TO 10
  120.   LOCATE 10 + i, 13: PRINT Dir$(i);
  121. NEXT
  122. LOCATE 11, 13
  123. EintragCtr = 1
  124. PosCtr = 1
  125. COLOR 1, 7
  126. LOCATE 10 + PosCtr, 13: COLOR 7, 1
  127. PRINT Dir$(EintragCtr); SPACE$(12 - LEN(Dir$(EintragCtr)))
  128. COLOR 1, 7
  129.                            '* Initialisierung abgeschlossen
  130.  
  131. DO                         '* Hauptschleife
  132.   DO
  133.     Taste$ = INKEY$        '* auf Eingabe warten
  134.   LOOP UNTIL Taste$ <> ""
  135.   Taste = ASC(Taste$)
  136.   IF Taste = 0 THEN                  '* Erweiterter
  137.     Taste = ASC(RIGHT$(Taste$, 1))   '* Tastencode liegt an
  138.   END IF
  139.                            '*  ESC -> Taste = 27
  140.                            '*  CR  -> Taste = 13
  141.                            '*  Cup -> Taste = 72
  142.                            '*  CDn -> Taste = 80
  143.   IF Taste = 72 THEN
  144.     LOCATE 10 + PosCtr, 13
  145.     PRINT Dir$(EintragCtr);
  146.     PRINT SPACE$(12 - LEN(Dir$(EintragCtr)))
  147.     EintragCtr = EintragCtr - 1
  148.     IF EintragCtr < 1 THEN EintragCtr = 1
  149.     PosCtr = PosCtr - 1
  150.     IF PosCtr < 1 THEN PosCtr = 1
  151.     LOCATE 10 + PosCtr, 13
  152.     COLOR 7, 1: PRINT Dir$(EintragCtr);
  153.     PRINT SPACE$(12 - LEN(Dir$(EintragCtr)))
  154.     COLOR 1, 7
  155.     IF PosCtr = 1 THEN
  156.       FOR i = 1 TO 9               '* "UpDate" des Fensters
  157.         LOCATE 10 + PosCtr + i, 13
  158.         PRINT Dir$(EintragCtr + i);
  159.         PRINT SPACE$(12 - LEN(Dir$(EintragCtr + i)))
  160.       NEXT i
  161.     END IF
  162.   END IF
  163.   IF Taste = 80 THEN
  164.     LOCATE 10 + PosCtr, 13
  165.     PRINT Dir$(EintragCtr);
  166.     PRINT SPACE$(12 - LEN(Dir$(EintragCtr)))
  167.     EintragCtr = EintragCtr + 1
  168.     IF EintragCtr > IstEintraege% THEN
  169.       EintragCtr = IstEintraege%
  170.     END IF
  171.     PosCtr = PosCtr + 1
  172.     IF PosCtr > 10 THEN PosCtr = 10
  173.     LOCATE 10 + PosCtr, 13
  174.     COLOR 7, 1: PRINT Dir$(EintragCtr);
  175.     PRINT SPACE$(12 - LEN(Dir$(EintragCtr)))
  176.     COLOR 1, 7
  177.     IF PosCtr = 10 THEN
  178.       FOR i = 1 TO 9               '* "UpDate" des Fensters
  179.         LOCATE 10 + PosCtr + i - 10, 13
  180.         PRINT Dir$(EintragCtr - 10 + i);
  181.         PRINT SPACE$(12 - LEN(Dir$(EintragCtr - 10 + i)))
  182.       NEXT i
  183.     END IF
  184.   END IF
  185. LOOP UNTIL (Taste = 27) OR (Taste = 13)
  186.  
  187. IF Taste = 13 THEN               '* <RETURN>?
  188.   Rueckgabe$ = Dir$(EintragCtr)
  189. ELSE
  190.   Rueckgabe$ = ""                '* oder <ESC>?
  191. END IF
  192.  
  193.                            '* Bildschirm wiederherstellen
  194. IF VideoMode% = 7 THEN     '* Monochrom
  195.   DEF SEG = &HB000
  196. ELSE                       '* Farbe
  197.   DEF SEG = &HB800
  198. END IF
  199.  
  200. FOR i% = 0 TO 3999
  201.   POKE i%, VideoBuffer%(i%)
  202. NEXT i%
  203. DEF SEG
  204. PRINT Rueckgabe$    '* der Dateieintrag,
  205.                     '* der verarbeitet werden soll
  206.  
  207.  
  208. '* ------------------------------------------------------- *
  209. SUB FindFirstFile (Path$, DTA$, Fehler%) STATIC
  210.   DIM Reg AS Regs
  211.  
  212.   PathName$ = Path$ + CHR$(0)    '* CHR$(0) für DOS
  213.  
  214.   Reg.ax = &H2F00                '* hole aktuelle DTA
  215.   CALL INTERRUPTX(&H21, Reg, Reg)
  216.   DTASeg% = Reg.es
  217.   DTAOfs% = Reg.bx
  218.  
  219.   DTA$ = SPACE$(43)              '* eigene DTA setzen
  220.   Reg.ax = &H1A00
  221.   Reg.ds = VARSEG(DTA$)
  222.   Reg.dx = SADD(DTA$)
  223.   CALL INTERRUPTX(&H21, Reg, Reg)
  224.  
  225.   Reg.ax = &H4E00                '* Suche ersten Eintrag
  226.   Reg.cx = IstNormal + IstArchive
  227.   Reg.ds = VARSEG(PathName$)
  228.   Reg.dx = SADD(PathName$)
  229.   CALL INTERRUPTX(&H21, Reg, Reg)
  230.  
  231.   Fehler% = Reg.flags AND 1
  232.  
  233.   Reg.ax = &H1A00                '* Original-DTA rücksetzen
  234.   Reg.ds = DTASeg%
  235.   Reg.dx = DTAOfs%
  236.   CALL INTERRUPTX(&H21, Reg, Reg)
  237.  
  238. END SUB
  239.  
  240. '* ------------------------------------------------------- *
  241. SUB FindNextFile (DTA$, Fehler%) STATIC
  242.   DIM Reg AS Regs
  243.  
  244.   IF LEN(DTA$) <> 43 THEN
  245.     Fehler% = 2            '* Find First nicht aufgerufen!
  246.     EXIT SUB
  247.   END IF
  248.  
  249.   Reg.ax = &H2F00                '* hole aktuelle DTA
  250.   CALL INTERRUPTX(&H21, Reg, Reg)
  251.   DTASeg% = Reg.es
  252.   DTAOfs% = Reg.bx
  253.  
  254.   Reg.ax = &H1A00                '* eigene DTA setzen
  255.   Reg.ds = VARSEG(DTA$)
  256.   Reg.dx = SADD(DTA$)
  257.   CALL INTERRUPTX(&H21, Reg, Reg)
  258.  
  259.   Reg.ax = &H4F00                '* Suche nächsten Eintrag
  260.   Reg.cx = IstNormal
  261.   Reg.ds = VARSEG(PathName$)
  262.   Reg.dx = SADD(PathName$)
  263.   CALL INTERRUPTX(&H21, Reg, Reg)
  264.  
  265.   Fehler% = Reg.flags AND 1
  266.  
  267.   Reg.ax = &H1A00                '* DTA wiederherstellen
  268.   Reg.ds = DTASeg%
  269.   Reg.dx = DTAOfs%
  270.   CALL INTERRUPTX(&H21, Reg, Reg)
  271.  
  272. END SUB
  273. '* ------------------------------------------------------- *
  274. '*                  Ende von REQUEST.BAS                   *
  275.