home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / cebit_91 / dirwin / dirwin.bas next >
Encoding:
BASIC Source File  |  1990-08-23  |  48.6 KB  |  1,729 lines
  1. '*-------------------------------------------------------*
  2. '*                     DIRWIN.BAS                        *
  3. '*-------------------------------------------------------*
  4. '* Version:            1.12/PB                           *
  5. '* Sprache:            Basic                             *
  6. '* Compiler:           PowerBASIC V. 2.0                 *
  7. '* Autor:              J. Braun                          *
  8. '* Copyright:          TOOLBOX im DMV-Verlag             *
  9. '* letzte Änderungen:  22.8.90                           *
  10. '*-------------------------------------------------------*
  11. '* Stellt  ein  Bildschirmfenster  zur Verfügung, in dem *
  12. '* die Einträge des angewählten Verzeichnisses mit einem *
  13. '* Auswahlbalken angewählt und  mit <RETURN>  übernommen *
  14. '* werden können. Verzeichnis- und Laufwerkswechsel sind *
  15. '* möglich. Die Zahl der Platten/Diskettenlaufwerke wird *
  16. '* überprüft.  Die  Unit  arbeitet  äquivalent zur Turbo *
  17. '* Pascal Unit DIRWIN(.PAS) ohne  die Implementation der *
  18. '* Huckepack-Routinen (kein Zugriff auf 'Paramstr(0)'!)  *
  19. '*                                                       *
  20. '* FindFirst(),  FindNext()  und  GetCurrDrive$ (c) 1989 *
  21. '* W. Rinke & TOOLBOX (TOOLBOX 10/89 und 11/89). Konver- *
  22. '* tiert von Quick Basic nach PowerBASIC von J. Braun.   *
  23. '*                                                       *
  24. '* NICHT GEEIGNET FÜR TURBO BASIC (STRSEG/STRPTR-FUNKT.) *
  25. '*-------------------------------------------------------*
  26.  
  27. $COMPILE UNIT
  28. $ERROR ALL -
  29. $STACK 32766
  30. $CPU 8086
  31. $DEBUG MAP -
  32. $EVENT -
  33. $LIB ALL -
  34. $FLOAT EMULATE
  35. $OPTION AUTODIM -
  36. $OPTION CNTLBREAK -
  37. $SOUND 0
  38. $COM 0
  39.  
  40. DEFINT A-Z
  41.  
  42. %Normal    = 0
  43. %ReadOnly  = 1
  44. %Hidden    = 2
  45. %SysFile   = 4
  46. %VolumeID  = 8
  47. %Directory = 16
  48. %Archive   = 32
  49. %AnyFile   = 63
  50.  
  51. %MaxDirs   = 512
  52.  
  53. %Flags = 0
  54. %AX    = 1
  55. %BX    = 2
  56. %CX    = 3
  57. %DX    = 4
  58. %SI    = 5
  59. %DI    = 6
  60. %BP    = 7
  61. %DS    = 8
  62. %ES    = 9
  63.  
  64. %MessFore = 14
  65. %MessBack = 0
  66. %WinFore  = 7
  67. %WinBack  = 0
  68. %BarFore  = 0
  69. %BarBack  = 7
  70. %shade    = 177
  71.  
  72. %MaxEntryLength = 12
  73.  
  74. %TRUE = -1
  75. %FALSE = 0
  76.  
  77. DIM DirArray$ [1 : %MaxDirs]
  78. DIM FrameArray$[1 : 10]
  79.  
  80. SUB InitDirWin(cfg$) PUBLIC
  81. ' Initialisierung der Unit. Nur einmal im
  82. ' Hauptprogramm aufrufen.
  83. SHARED FrameArray$[], ArrayNum%, MessFore%, MessBack%
  84. SHARED WinFore%, WinBack%, BarFore%, BarBack%, shade%
  85. SHARED OrgAttribute%, BIOSCursor%, GetFMask$, ConfigFile$
  86. SHARED initialized%, DriveCount%, floppies%, OwnName$
  87. SHARED DriveStr1$, DriveStr2$, ESCBack$, NoDriveB$
  88. SHARED CFGFile$
  89.   IF cfg$ <> "" THEN ConfigFile$ = cfg$
  90.   IF NOT initialized% THEN
  91.   MessFore% = %MessFore
  92.   MessBack% = %MessBack
  93.   WinFore%  = %WinFore
  94.   WinBack%  = %WinBack
  95.   BarFore%  = %BarFore
  96.   BarBack%  = %BarBack
  97.   shade%    = %shade
  98.     DEF SEG = &H40
  99.       BIOSCursor% = PEEKI(&H60)
  100.     DEF SEG
  101.     GetFMask$ = ""
  102.     initialized% = %TRUE
  103.     x% = POS(x%)
  104.     y% = CSRLIN
  105.     OrgAttribute% = SCREEN(y%, x%, 1)
  106.     FrameArray$[1]  = "╔╗╚╝║═╡╞"
  107.     FrameArray$[2]  = "┌┐└┘│─┤├"
  108.     FrameArray$[3]  = "╒╕╘╛│═╡╞"
  109.     FrameArray$[4]  = "╓╖╙╜║─┤├"
  110.     FrameArray$[5]  = STRING$(8, 176)
  111.     FrameArray$[6]  = STRING$(8, 177)
  112.     FrameArray$[7]  = STRING$(8, 178)
  113.     FrameArray$[8]  = STRING$(8, 219)
  114.     FrameArray$[9]  = STRING$(8, 254)
  115.     FrameArray$[10] = SPACE$(8)
  116.     ArrayNum%   = 1
  117.     DriveCount% = GetDrives%
  118.     floppies%   = GetFloppy%
  119.     DriveStr1$  = "≡≡ [ "
  120.     DriveStr2$  = ": ] ≡≡"
  121.     ESCBack$    = "<ESC>"
  122.     NoDriveB$   = "≡≡ [ ≡≡ ] ≡≡"
  123.     CALL GetDir(0, CFGFile$)
  124.     IF RIGHT$(CFGFile$, 1) = "\" THEN
  125.        CFGFile$ = CFGFile$ + Configfile$
  126.     ELSE
  127.        CFGFile$ = CFGFile$ + "\" + Configfile$
  128.     END IF
  129.     IF ConfigFile$ = "" THEN ConfigFile$ = "CONFIG.DAT"
  130.     ON ERROR GOTO NoConfigFile
  131.     x% = FREEFILE
  132.     OPEN "I", x%, CFGFile$
  133.     INPUT #x%, ArrayNum%, MessFore%, MessBack%, _
  134.                WinFore%, WinBack%, BarFore%, _
  135.                BarBack%, shade%, GetFMask$
  136.     CLOSE x%
  137.     ON ERROR GOTO 0
  138.     IF ArrayNum% = 0 THEN ArrayNum% = 1
  139.     IF MessFore% = 0 AND MessBack% = 0 THEN
  140.       MessFore% = %MessFore
  141.       MessBack% = %MessBack
  142.     END IF
  143.     IF WinFore% = 0 AND WinBack% = 0 THEN
  144.       WinFore%  = %WinFore
  145.       WinBack%  = %WinBack
  146.     END IF
  147.     IF BarFore% = 0 AND BarBack% = 0 THEN
  148.       BarFore%  = %BarFore
  149.       BarBack%  = %BarBack
  150.     END IF
  151.     IF shade% = 0 THEN shade% = %shade
  152.   END IF
  153.   EXIT SUB
  154. NoConfigFile:
  155.   RESUME StdOption
  156. StdOption:
  157.   ON ERROR GOTO 0
  158. END SUB
  159.  
  160. SUB BarColor
  161. ' Setzen der Farbe des Auswahlbalkens
  162. SHARED BarFore%, BarBack%
  163.   IF BarFore% <= 0 AND BarBack% <= 0 THEN
  164.     BarFore% = %BarFore
  165.     BackBack%= %BarBack
  166.   END IF
  167.   COLOR BarFore%, BarBack%
  168. END SUB
  169.  
  170. SUB ChangeActDir
  171. ' Wechseln des aktuellen Verzeichnisses
  172. ' zum ausgewählten Verzeichnis
  173. SHARED PathString$
  174. LOCAL ChangeDir$, Filename$, FileExt$
  175.   CALL FSplit(PathString$, ChangeDir$, Filename$, FileExt$)
  176.   ChangeDir$ = LEFT$(ChangeDir$, LEN(ChangeDir$) - 1)
  177.   IF LEN(ChangeDir$) = 2 THEN
  178.      IF LEFT$(ChangeDir$, 1) >= "A" AND _
  179.         LEFT$(ChangeDir$, 1) <= "Z" THEN
  180.        IF MID$(ChangeDir$, 2, 1) = ":" THEN
  181.          ChangeDir$ = ChangeDir$ + "\"
  182.        END IF
  183.      END IF
  184.    END IF
  185.    ON ERROR GOTO No.Change
  186.    CHDIR ChangeDir$
  187.    ON ERROR GOTO 0
  188.    EXIT SUB
  189. No.Change:
  190.    RESUME Changed.Dir
  191. Changed.Dir:
  192.    ON ERROR GOTO 0
  193. END SUB
  194.  
  195. FUNCTION Dec%(innum%, minnum%, maxnum%)
  196. ' Verkleinern einer Zahl bis zum anzugebenden
  197. ' Minimalwert und dann Sprung zum anzugebenen
  198. ' Maximalwert immer im Kreis herum.
  199.   DECR innum%
  200.   IF innum% < minnum% THEN innum% = maxnum%
  201.   Dec% = innum%
  202. END FUNCTION
  203.  
  204. FUNCTION Inc%(innum%, maxnum%, minnum%)
  205. ' Vergrößern einer Zahl bis zum anzugebenden
  206. ' anzugebenden Maximalwert und dann Sprung
  207. ' zum anzugebenden Minimalwert im Kreis herum
  208.   INCR innum%
  209.   IF innum% > maxnum% THEN innum% = minnum%
  210.   Inc% = innum%
  211. END FUNCTION
  212.  
  213. SUB MenuColorDisplay
  214. ' Unterprogramm für ChangeMenuColors
  215. SHARED FrameArray$[], ArrayNum%, MessFore%
  216. SHARED MessBack%, WinFore%, WinBack%, BarFore%
  217. SHARED BarBack%, shade%, OrgAttribute%
  218. SHARED OldWinBack%, OldWinFore%
  219. LOCAL CtrlX$
  220.   CtrlX$ = CHR$(24)
  221.   CALL MessageColor
  222.   LOCATE 8, 9
  223.   PRINT " Hilfsmeldungen    [ F1/";
  224.   PRINT CHR$(24); "F1: Vordergrund, F2/";
  225.   PRINT CHR$(24); "F2 Hintergrund ] ";
  226.   CALL WindowColor
  227.   LOCATE 9, 9
  228.   PRINT " Bildschirmfenster [ F3/";
  229.   PRINT CtrlX$; "F3: Vordergrund, F4/";
  230.   PRINT CtrlX$; "F4 Hintergrund ] ";
  231.   CALL BarColor
  232.   LOCATE 10, 9
  233.   PRINT " Auswahlbalken     [ F5/"; CtrlX$;
  234.   PRINT "F5: Vordergrund, F6/";
  235.   PRINT CtrlX$; "F6 Hintergrund ] ";
  236.   COLOR OldWinFore%, OldWinBack%
  237.   LOCATE 12, 12
  238.   PRINT " Art des Fensterrahmens  ";
  239.   PRINT "  [ Ändern mit F7/F8 ] : '";
  240.   PRINT LEFT$(FrameArray$[ArrayNum%], 4); "'";
  241.   LOCATE 13, 12
  242.   PRINT " Aktuelles Schattenzeichen ";
  243.   PRINT "[ Ändern mit F9/F10 ]: '";
  244.   CALL TextAttr(OrgAttribute%)
  245.   PRINT STRING$(4, shade%);
  246.   COLOR OldWinFore%, OldWinBack%
  247.   PRINT "'";
  248.   LOCATE 16, 6
  249.   PRINT " Ändern Sie die aktuellen Werte mit";
  250.   PRINT " den angezeigten Funktionstasten.";
  251.   LOCATE 17, 6
  252.   PRINT " Übernahme ohne Speichern: <ESC>, ";
  253.   PRINT "  Übernahme mit Speichern: <";
  254.   PRINT CHR$(17); "───┘>";
  255. END SUB
  256.  
  257. SUB ChangeMenuColors(GetFileMask$)
  258. ' Änderung und evtl. Abspeichern der
  259. ' Fensterfarben und des Rahmens
  260. SHARED FrameArray$[], ArrayNum%, MessFore%
  261. SHARED MessBack%, WinFore%, WinBack%
  262. SHARED BarFore%, BarBack%, shade%
  263. SHARED OldWinFore%, OldWinBack%
  264. LOCAL chh$, ch$, count%
  265.   CALL Save.Screen
  266.   OldWinBack% = WinBack%
  267.   OldWinFore% = WinFore%
  268.   CALL Frame(1, 5, 80, 19, " Ändern der Anzeigen ")
  269.   CALL MenuColorDisplay
  270.   DO
  271.     DO
  272.       DO
  273.         chh$ = ""
  274.         ch$ = INKEY$
  275.         IF (LEFT$(ch$, 1) = CHR$(0) AND LEN(ch$) = 2) THEN
  276.           chh$ = RIGHT$(ch$, 1)
  277.           ch$  = CHR$(0)
  278.         END IF
  279.       LOOP UNTIL ch$ <> ""
  280.       IF ch$ = CHR$(24) THEN CALL Stopp
  281.     LOOP UNTIL ch$ = CHR$(13) OR ch$ = CHR$(27) _
  282.          OR (ch$ = CHR$(0) AND chh$ <> "")
  283.     SELECT CASE ch$
  284.       CASE CHR$(0)
  285.       SELECT CASE chh$
  286.         CASE "-" : CALL Stopp
  287.         CASE ";"
  288.           MessFore% = Inc%(Messfore%, 15, 0)
  289.         CASE "T"
  290.           MessFore% = Dec%(MessFore%, 0, 15)
  291.         CASE "<"
  292.           MessBack% = Inc%(MessBack%, 7, 0)
  293.         CASE "U"
  294.           MessBack% = Dec%(MessBack%, 0, 7)
  295.         CASE "="
  296.           WinFore%  = Inc%(WinFore%, 15, 0)
  297.         CASE "V"
  298.           WinFore%  = Dec%(WinFore%, 0, 15)
  299.         CASE ">"
  300.           WinBack%  = Inc%(WinBack%, 7, 0)
  301.         CASE "W"
  302.           WinBack%  = Dec%(WinBack%, 0, 7)
  303.         CASE "?"
  304.           BarFore%  = Inc%(Barfore%, 15, 0)
  305.         CASE "X"
  306.           BarFore%  = Dec%(BarFore%, 0, 15)
  307.         CASE "@"
  308.           BarBack%  = Inc%(BarBack%, 15, 0)
  309.         CASE "Y"
  310.           BarBack%  = Dec%(BarBack%, 0, 15)
  311.         CASE "A"
  312.           ArrayNum% = Inc%(ArrayNum%, 10, 1)
  313.         CASE "B"
  314.           ArrayNum% = Dec%(ArrayNum%, 1, 10)
  315.         CASE "C"
  316.           SELECT CASE shade%
  317.             CASE  32:      shade% = 176
  318.             CASE 176, 177: INCR shade%
  319.             CASE 178:      shade% = 219
  320.             CASE ELSE:     shade% = 32
  321.           END SELECT
  322.         CASE "D"
  323.           SELECT CASE shade%
  324.             CASE 219:      shade% = 178
  325.             CASE 177, 178: DECR shade%
  326.             CASE 176:      shade% = 32
  327.             CASE ELSE:     shade% = 219
  328.           END SELECT
  329.         CASE ELSE: CALL ErrorBeep
  330.       END SELECT
  331.       CASE CHR$(27), CHR$(13)
  332.       CASE ELSE: CALL ErrorBeep
  333.     END SELECT
  334.     CALL MenuColorDisplay
  335.   LOOP UNTIL ch$ = CHR$(13) OR ch$ = CHR$(27)
  336.   IF ch$ = CHR$(13) THEN
  337.     CALL Frame(40, 19, 72, 22, "")
  338.     CALL MessageColor
  339.     LOCATE 20, 42
  340.     PRINT " Werte werden gespeichert ";
  341.     CALL SaveConfig(ArrayNum%, MessFore%, MessBack%, _
  342.                     WinFore%, WinBack%, BarFore%, _
  343.                     BarBack%, shade%, GetFileMask$)
  344.   END IF
  345.   CALL Restore.Screen
  346. END SUB
  347.  
  348. SUB ChangeOrgDir
  349. ' Wechseln zum ursprüngl. Verzeichnis
  350. SHARED OrgDirectory$
  351.   CHDIR OrgDirectory$
  352. END SUB
  353.  
  354. FUNCTION LINSTR% (instring$, testString$)
  355. ' INSTR gibt das erste Auftreten des Suchstrings
  356. ' im Hauptstring zurück, LINSTR% das letzte Auf-
  357. ' treten im Hauptstring
  358. LOCAL i%, testvar%
  359.   testvar% = 0
  360.   FOR i% = 1 TO LEN(instring$) + 1 - LEN(testString$)
  361.     IF MID$(instring$, i%, LEN(testString$)) = testString$ THEN
  362.       testvar% = i%
  363.     END IF
  364.   NEXT i%
  365.   LINSTR% = testvar%
  366. END FUNCTION
  367.  
  368. SUB DirWindow
  369. ' Bildschirmfenster für Dateiauswahl aufbauen
  370. SHARED PathString$, FrameArray$[], ArrayNum%
  371. SHARED first%, dmax%, last%, DriveStr1$, DriveStr2$
  372. LOCAL count%, drive%, x%, p%, displaystr$
  373.   DisplayStr$ = " " + PathString$ + " "
  374.   LOCATE 9, 10
  375.   CALL WindowColor
  376.   PRINT LEFT$(FrameArray$[ArrayNum%], 1);
  377.   x% = 40 - LEN(DisplayStr$) \ 2
  378.   WHILE POS(p%) < x%
  379.     PRINT MID$(FrameArray$[ArrayNum%], 6, 1);
  380.   WEND
  381.   CALL MessageColor
  382.   PRINT DisplayStr$;
  383.   CALL WindowColor
  384.   WHILE POS(x%) < 70
  385.     PRINT MID$(FrameArray$[ArrayNum%], 6, 1);
  386.   WEND
  387.   PRINT MID$(FrameArray$[ArrayNum%], 2, 1);
  388.   LOCATE 19, 10
  389.   PRINT MID$(FrameArray$[ArrayNum%], 3, 1);
  390.   CALL Shadow
  391.   LOCATE 19, 11
  392.   PRINT MID$(FrameArray$[ArrayNum%], 7, 1);
  393.   CALL MessageColor
  394.   PRINT " Übernahme: "; CHR$(17);
  395.   PRINT "──┘ Abbruch: <ESC>  neue Suchmaske: <SPACE> ";
  396.   CALL WindowColor
  397.   PRINT RIGHT$(FrameArray$[ArrayNum%], 1);
  398.   LOCATE 19, 70
  399.   PRINT MID$(FrameArray$[ArrayNum%], 4, 1);
  400.   CALL Shadow
  401.   FOR count% = 10 TO 18
  402.     LOCATE count%, 10
  403.     PRINT MID$(FrameArray$[ArrayNum%], 5, 1);
  404.     PRINT SPACE$(59);
  405.     PRINT MID$(FrameArray$[ArrayNum%], 5, 1);
  406.     CALL Shadow
  407.   NEXT count%
  408.   LOCATE 20, 11
  409.   CALL MessageColor
  410.   FOR count% = 0 TO 60
  411.      CALL Shadow
  412.   NEXT count%
  413. END SUB
  414.  
  415. SUB DwHelp(zusatzinfo%)
  416. ' Hilfefenster für Dateiauswahl
  417. LOCAL ch$, count%
  418.   CALL Save.Screen
  419.   CALL Frame(1, 5, 80, 19, " Hilfe zur Dateiauswahl ")
  420.   CALL WindowColor
  421.   LOCATE 7, 3
  422.   PRINT "Bewegen Sie das  Zeigerfeld  mit ";_
  423.         " den Cursortasten und wählen Sie dann eine";
  424.   LOCATE 8, 3
  425.   PRINT "Datei mit  der Eingabetaste  <"; CHR$(17);
  426.   PRINT "──┘>  aus. Wird statt  einer Datei  ein Ver-";
  427.   LOCATE 9, 3
  428.   PRINT "zeichnis oder  ein Laufwerk  angewählt,";
  429.   PRINT " wird in das  Verzeichnis  oder  zum";
  430.   LOCATE 10, 3
  431.   PRINT "aktuellen Verzeichnis des Laufwerks ";
  432.   PRINT "gewechselt. Soll die Suchmaske geändert";
  433.   LOCATE 11, 3
  434.   PRINT "werden, kann dies nach der  Betätigung";
  435.   PRINT " der Leertaste  in  einem gesonderten";
  436.   LOCATE 12, 3
  437.   PRINT "Bildschirmfenster erfolgen. Die Fenster";
  438.   PRINT "farben kann man mit F2 ändern.";
  439.   LOCATE 13, 3
  440.   PRINT "Alle Benutzer-Aktionen können mit der ";
  441.   PRINT "<ESC>-Taste abgebrochen werden.";
  442.   IF zusatzinfo% THEN
  443.     LOCATE 14, 3
  444.     PRINT "Wenn F10 gedrückt wird, kann in einem ";
  445.     PRINT "Fenster ein beliebiger Dateinamen von";
  446.     LOCATE 15, 3: PRINT "Hand eingegeben werden.";
  447.   END IF
  448.   LOCATE 17, 30, 0
  449.   PRINT "Ende mit beliebiger Taste";
  450.   DO
  451.     ch$ = INKEY$
  452.     IF (LEN(ch$) = 2 AND RIGHT$(ch$, 1) = "-") _
  453.     OR ch$ = CHR$(24) THEN
  454.       CALL Stopp
  455.       ch$ = ""
  456.     END IF
  457.   LOOP UNTIL ch$ <> ""
  458.   CALL Restore.Screen
  459. END SUB
  460.  
  461. SUB ErrorBeep
  462. ' Warnton bei falscher Eingabe ausgeben
  463.   SOUND 880, 0.10
  464. END SUB
  465.  
  466. SUB FillDirWindow
  467. ' Inhalt des Dateiauswahlfensters erstellen
  468. LOCAL x%, y%, cnt%
  469. SHARED dmax%, last%, DriveCount%, first%
  470. SHARED MarkedFile%, DirArray$[], att%
  471. SHARED DriveStr1$, DriveStr2$
  472.   x% = 11: y% = 10
  473.   IF att% THEN CALL DirWindow: att% = %FALSE
  474.   last% = dmax%
  475.   IF last% > 0 + DriveCount% THEN
  476.     IF last% > 35 + first% THEN last% = first% + 35
  477.     FOR cnt% = first% TO last%
  478.       LOCATE y%, x%
  479.       IF cnt% = MarkedFile% THEN CALL BarColor
  480.       PRINT " "; DirArray$[cnt%];
  481.       PRINT SPACE$(13 - LEN(DirArray$[cnt%]));
  482.       CALL WindowColor
  483.       INCR x%, 15
  484.       IF x% > 60 THEN x% = 11: INCR y%
  485.     NEXT cnt%
  486.   ELSE
  487.     IF last% > 35 + first% THEN last% = first% + 35
  488.     FOR cnt% = first% TO last%
  489.       LOCATE y%, x%
  490.       IF cnt% = MarkedFile% THEN CALL BarColor
  491.       PRINT " "; DirArray$[cnt%];
  492.       PRINT SPACE$(13 - LEN(DirArray$[cnt%]));
  493.       CALL WindowColor
  494.       INCR x%, 15
  495.       IF x% > 60 THEN x% = 11: INCR y%
  496.     NEXT cnt%
  497.     CALL MessageColor
  498.     LOCATE 14, 29: PRINT SPC(24);
  499.     LOCATE 15, 29: PRINT " keine Dateien gefunden ";
  500.     LOCATE 16, 29: PRINT SPC(24);
  501.     CALL WindowColor
  502.   END IF
  503. END SUB
  504.  
  505. FUNCTION FillUp$ (s$, i%)
  506. ' Hilfsfunktion für das Auslesen der 8-Bit-Register.
  507. ' Eine Binärzahl wird auf i% Stellen vorn mit "0"
  508. ' aufgefüllt
  509.   IF (i% < 1) OR (LEN(s$) >= i%) THEN
  510.     FillUp$ = s$
  511.     EXIT FUNCTION
  512.   END IF
  513.   WHILE LEN(s$) < i%
  514.     s$ = "0" + s$
  515.   WEND
  516.   FillUp$ = s$
  517. END FUNCTION
  518.  
  519. SUB FindFirst(Pattern$, Attr%, DTA$)
  520. ' Einlesen der Dateien/Verzeichnisse
  521. SHARED DosError%
  522.   Path$ = Pattern$ + CHR$(0)
  523.   REG %AX, &H2F00
  524.   CALL INTERRUPT &H21
  525.   DTASeg% = REG(%ES)
  526.   DTAOfs% = REG(%BX)
  527.   DTA$ = SPACE$(43)
  528.   REG %AX, &H1A00
  529.   REG %DS, STRSEG(DTA$)
  530.   REG %DX, STRPTR(DTA$)
  531.   CALL INTERRUPT &H21
  532.   REG %AX, &H4E00
  533.   REG %CX, Attr%
  534.   REG %DS, STRSEG(Path$)
  535.   REG %DX, STRPTR(Path$)
  536.   CALL INTERRUPT &H21
  537.   IF (REG(%Flags) AND 1) = 1 THEN
  538.     DosError% = REG(%AX)
  539.   ELSE
  540.     DosError% = 0
  541.   END IF
  542.   REG %AX, &H1A00
  543.   REG %DS, DTASeg%
  544.   REG %DX, DTAOfs%
  545.   CALL INTERRUPT &H21
  546. END SUB
  547.  
  548. SUB FindNext(DTA$)
  549. ' Weiter nach FindFirst
  550. SHARED DosError%
  551. LOCAL DTASeg%, DTAOfs%, PathName$
  552.   IF LEN(DTA$) <> 43 THEN
  553.     DosError% = 2
  554.   ELSE
  555.     DosError% = 0
  556.     REG %AX, &H2F00
  557.     CALL INTERRUPT &H21
  558.     DTASeg% = REG(%ES)
  559.     DTAOfs% = REG(%BX)
  560.     REG %AX, &H1A00
  561.     REG %DS, STRSEG(DTA$)
  562.     REG %DX, STRPTR(DTA$)
  563.     CALL INTERRUPT &H21
  564.     REG %AX, &H4F00
  565.     CALL INTERRUPT &H21
  566.     IF (REG(%Flags) AND 1) = 1 THEN
  567.       DosError% = REG(%AX)
  568.     ELSE
  569.       DosError% = 0
  570.     END IF
  571.     REG %AX, &H1A00
  572.     REG %DS, DTASeg%
  573.     REG %DX, DTAOfs%
  574.     CALL INTERRUPT &H21
  575.   END IF
  576. END SUB
  577.  
  578. SUB Frame(x1%, y1%, x2%, y2%, Header$)
  579. ' Rahmen mit Überschrift zeichnen
  580. LOCAL x%, y%, Oldx%, Oldy%
  581. SHARED FrameArray$[], ArrayNum%
  582.   CALL WindowColor
  583.   LOCATE y1%, x1%
  584.   PRINT LEFT$(FrameArray$[ArrayNum%], 1);
  585.   PRINT STRING$(x2% - x1% - 2, _
  586.         MID$(FrameArray$[ArrayNum%], 6, 1));
  587.   PRINT MID$(FrameArray$[ArrayNum%], 2, 1);
  588.   FOR y% = y1% + 1 TO y2% - 2
  589.     LOCATE y%, x1%
  590.     PRINT MID$(FrameArray$[ArrayNum%], 5, 1);
  591.     PRINT SPC(x2% - 2 - x1%);
  592.     PRINT MID$(FrameArray$[ArrayNum%], 5, 1);
  593.     CALL Shadow
  594.   NEXT y%
  595.   LOCATE y2% - 1, x1%
  596.   PRINT MID$(FrameArray$[ArrayNum%], 3, 1);
  597.   PRINT STRING$( x2% - x1% - 2, _
  598.         MID$(FrameArray$[ArrayNum%], 6,1));
  599.   PRINT MID$(FrameArray$[ArrayNum%], 4, 1);
  600.   CALL Shadow
  601.   LOCATE y2%, x1% + 1
  602.   FOR x% = 1 TO x2% - x1%
  603.     CALL Shadow
  604.   NEXT x%
  605.   LOCATE y1%, (CINT((x2% + x1%) / 2) - _
  606.                CINT(LEN(Header$) / 2))
  607.   CALL MessageColor
  608.   PRINT Header$;
  609.   CALL WindowColor
  610. END SUB
  611.  
  612. SUB FSplit(FilePathStr$, FilePath$, FileName$, FileExt$) PUBLIC
  613. ' Aus Pfad+Datei+Ext die Teile extrahieren
  614. LOCAL length%, length2%, count%
  615.   FilePath$ = ""
  616.   FileName$ = ""
  617.   FileExt$ = ""
  618.   length% = LINSTR%(FilePathStr$, "\")
  619.   IF length% THEN
  620.     FOR count% = 1 TO LEN(FilePathStr$)
  621.      IF length% >= count% THEN
  622.       FilePath$ = FilePath$ + MID$(FilePathStr$, count%, 1)
  623.      END IF
  624.     NEXT count%
  625.   END IF
  626.   length2% = INSTR(FilePathStr$, ".")
  627.   IF length2% > length% THEN
  628.     FileName$ = MID$(FilePathStr$, _
  629.                      length% + 1, length2% - length1%)
  630.   END IF
  631.   IF INSTR(FileName$, ".") THEN
  632.     FileExt$ = MID$(FileName$, INSTR(FileName$, "."), _
  633.           LEN(FileName$) - INSTR(FileName$, ".") + 1)
  634.     FileName$ = MID$(FileName$, 1, _
  635.           INSTR(FileName$, ".") - 1)
  636.   END IF
  637. END SUB
  638.  
  639. FUNCTION GetCurrDrive$ PUBLIC
  640. ' Fügt hinter GetDD$ :\ zu
  641.   GetCurrDrive$ = GetDD$ + ":\"
  642. END FUNCTION
  643.  
  644. FUNCTION GetDD$ PUBLIC
  645. ' Ermittelt den Buchstaben des aktuellen
  646. ' Laufwerkes
  647.   REG %AX, &H1900
  648.   CALL INTERRUPT &H21
  649.   GetDD$ = CHR$((REG(%AX) AND &HFF) + 65)
  650. END FUNCTION
  651.  
  652. SUB GetDirectory(GetFileMask$, SortDir%)
  653. ' Die Verzeichnisse und Dateien im aktuellen
  654. ' Verzeichnis ermitteln und für GetFile auf-
  655. ' arbeiten.
  656. LOCAL w%, i%, tstring1$, GFM$, drive%, ActFile%
  657. SHARED DosError%, PathString$, DriveCount%
  658. SHARED NextString$, DirArray$[], dmax%, last%
  659. SHARED first%, NoDriveB$, DriveStr1$, DriveStr2$
  660. SHARED drives%, floppies%
  661.   GetFileMask$ = UCASE$(GetFileMask$)
  662.   GFM$ = MID$(PathString$, 1, LEN(PathString$) - _
  663.               LEN(GetFileMask$)) + "*.*"
  664.   CALL FindFirst(GFM$, %Directory, DTA$)
  665.   WHILE NOT (DosError% = 18) AND (ActFile% <= %MaxDirs)
  666.     IF SRecord.Attr%(DTA$) = &H10 THEN
  667.       IF SRecord.Name$(DTA$) <> "." THEN
  668.         INCR ActFile%
  669.         DirArray$[ActFile%] = SRecord.Name$(DTA$) + "\"
  670.       END IF
  671.     END IF
  672.     CALL FindNext(DTA$)
  673.   WEND
  674.   CALL FindFirst(PathString$, &H20, DTA$)
  675.   WHILE NOT (DosError% = 18) AND (ActFile% <= %MaxDirs)
  676.     INCR ActFile%
  677.     DirArray$[ActFile%] = SRecord.Name$(DTA$)
  678.     CALL FindNext(DTA$)
  679.   WEND
  680.   IF DirArray$[1] = (GetCurrDrive$ + GetFileMask$) THEN
  681.     DECR ActFile%
  682.   END IF
  683.   dmax% = ActFile% + DriveCount%
  684.   FOR w% = DriveCount% TO 1 STEP -1
  685.     IF (w% = DriveCount% - 1) AND (floppies% < 2) THEN
  686.       DirArray$[dmax% - w% + 1] = NoDriveB$
  687.     ELSE
  688.       DirArray$[dmax% - w% + 1] = DriveStr1$ + _
  689.         CHR$(65 - w% + DriveCount%) + DriveStr2$
  690.     END IF
  691.   NEXT w%
  692.   IF SortDir% THEN
  693.     IF dmax% > 1 THEN
  694.        FOR i% = 1 TO dmax%
  695.          IF INSTR(DirArray$[i%], "\") THEN
  696.            DirArray$[i%] = CHR$(1) + DirArray$[i%]
  697.          END IF
  698.        NEXT i%
  699.        ARRAY SORT DirArray$[] FOR dmax%, FROM 1 TO 11, _
  700.                   COLLATE UCASE, ASCEND
  701.        FOR i% = 1 TO dmax%
  702.          IF INSTR(DirArray$[i%], "\") THEN
  703.            DirArray$[i%] = MID$(DirArray$[i%], 2)
  704.          END IF
  705.        NEXT i%
  706.     END IF
  707.   END IF
  708. END SUB
  709.  
  710. FUNCTION GetDrives%
  711. ' ermittelt die Zahl der tatsächlich verfügbaren
  712. ' Laufwerke
  713. LOCAL drives%, count%, control%
  714. SHARED active%
  715.   control% = &H0
  716.   Reg %AX, &H1900
  717.   CALL INTERRUPT &H21
  718.   Active% = REG(%AX) AND &HFF
  719.   REG %AX, &H0E00
  720.   REG %DX, &H0000
  721.   CALL INTERRUPT &H21
  722.   drives% = REG(%AX) AND &HFF
  723.   REG %AX, &H0E00 + drives%
  724.   REG %DX, active%
  725.   IF drives% > 2 THEN
  726.     FOR count% = 3 TO drives%
  727.       REG %AX, &H1C00
  728.       REG %DX, count%
  729.       CALL INTERRUPT &H21
  730.       IF GetLow%(REG(%AX)) = &HFF THEN INCR control%
  731.     NEXT count%
  732.   END IF
  733.   DECR drives%, control%
  734.   REG %AX, &H0E00
  735.   REG %DX, active%
  736.   CALL INTERRUPT &H21
  737.   GetDrives% = drives%
  738. END FUNCTION
  739.  
  740. SUB GetDir(drive%, directory$) PUBLIC
  741. ' Namen des aktuellen Verzeichnisses
  742. ' für Laufwerk drive% ermitteln
  743. LOCAL DTA$, ende%
  744. SHARED DosError%
  745.   DTA$ = SPACE$(63)
  746.   REG %AX, &H4700
  747.   REG %DX, drive%
  748.   REG %DS, STRSEG(DTA$)
  749.   REG %SI, STRPTR(DTA$)
  750.   CALL INTERRUPT &H21
  751.   DosError% = REG(%Flags)
  752.   IF DosError% <> 0 THEN
  753.     DosError% = REG(%AX) AND &HFF
  754.   END IF
  755.   directory$ = DTA$
  756.   ende% = INSTR(directory$, CHR$(0))
  757.   ON ERROR GOTO drivenotready
  758.   directory$ = LEFT$(directory$, ende% - 1)
  759.   IF drive% = 0 THEN
  760.     directory$ = GetCurrDrive$ + directory$
  761.   ELSE
  762.     directory$ = CHR$(drive% + 64) + ":\" + directory$
  763.   END IF
  764.   ON ERROR GOTO 0
  765.   EXIT SUB
  766. drivenotready:
  767.   RESUME backto0
  768. backto0:
  769.   CALL Save.Screen
  770.   CALL Frame(40, 19, 70, 22, " ACHTUNG ")
  771.   LOCATE 20, 42, 0
  772.   CALL MessageColor
  773.   PRINT "  Laufwerk nicht bereit!  ";
  774.   DELAY 2
  775.   CALL Restore.Screen
  776.   drive% = 0
  777.   ON ERROR GOTO 0
  778.   CALL GetDir(drive%, directory$) ' REKURSIV !
  779. END SUB
  780.  
  781. SUB SaveConfig(ArrayNum%, MessFore%, MessBack%, _
  782.                WinFore%, WinBack%, BarFore%, _
  783.                BarBack%, shade%, GetFileMask$)
  784. ' Abspeichern der Konfigurationsdaten in die
  785. ' Datei CFGFile$
  786. SHARED StartDirectory$, CFGFile$
  787. LOCAL x%
  788.   ON ERROR GOTO NoConfigFilewrite
  789.   x% = FREEFILE
  790.   OPEN CFGFile$ FOR OUTPUT AS #x%
  791.   WRITE #x%, ArrayNum%, MessFore%, MessBack%, _
  792.              WinFore%, WinBack%, BarFore%, _
  793.              BarBack%, shade%, GetFileMask$
  794.     CLOSE x%
  795.   ON ERROR GOTO 0
  796.   EXIT SUB
  797. NoConfigFilewrite:
  798.   RESUME StdOptionWriteNot
  799. StdOptionWriteNot:
  800.   ON ERROR GOTO 0
  801. END SUB
  802.  
  803. FUNCTION GetFloppy% PUBLIC
  804. ' Ermittelt die Zahl der vorhandenen Floppy-
  805. ' laufwerke (1 oder 2)
  806. LOCAL floppies%, drives%
  807.   DEF SEG = &H40
  808.     floppies% = PEEK(&H10)
  809.   DEF SEG
  810.   IF floppies% AND 1 = 0 THEN
  811.     drives% = 0
  812.   ELSE
  813.     drives% = CINT(((floppies% AND &HC0) / &H40) + 1)
  814.     IF drives% < 2 THEN drives% = 1
  815.   END IF
  816.    GetFloppy% = drives%
  817. END FUNCTION
  818.  
  819. FUNCTION GetHigh% (invar%)
  820. ' Rückgabe des High-Bytes eines 16-Bit-Wertes
  821.   GetHigh% = VAL("&B" + _
  822.              LEFT$(FillUp$(BIN$(invar%), 16), 8))
  823. END FUNCTION
  824.  
  825. FUNCTION GetLow% (invar%)
  826. ' Rückgabe des Low-Bytes eines 16-Bit-Wertes
  827.   GetLow% = VAL("&B" + _
  828.             RIGHT$(FillUp$(BIN$(invar%), 16), 8))
  829. END FUNCTION
  830.  
  831. FUNCTION GetTextAttr%
  832. ' Ermittelt das Textattribut an der aktuellen
  833. ' Cursorposition
  834.   GetTextAttr% = SCREEN(CSRLIN, POS(x%), 1)
  835. END FUNCTION
  836.  
  837. FUNCTION ManualInput$
  838. ' Eingabe des Dateinamens in einem Bildschirm-
  839. ' fenster mithilfe der Funktion ReadString$()
  840. SHARED PathString$
  841. LOCAL length%, ExitChar%, XPos%, YPos%
  842. LOCAL pe%, i%, TestName$, MInput$
  843. LOCAL OldFilePath$, NewFilePath$
  844. LOCAL Extension$, FileName$, GetExt$
  845. LOCAL ok%, ch$, ccx$, ScreenARRAY$
  846.   YPos% = CSRLIN
  847.   XPos% = POS(x%)
  848.   FileName$ = ""
  849.   CALL FSplit(PathString$, OldFilePath$, _
  850.               FileName$, GetExt$)
  851.   IF INSTR(GetExt$, "?") OR INSTR(GetExt$, "*") THEN
  852.     GetExt$ = "."
  853.   END IF
  854.   DO
  855.     DO
  856.       ok% = %TRUE
  857.       CALL Frame(10, 14, 71, 17, " Manuelle Eingabe ")
  858.       LOCATE 15, 12, 1
  859.       MInput$ = ReadString$(OldFilePath$, 58, ExitChar%)
  860.       LOCATE , , 0
  861.       IF LEN(MInput$) > 0 THEN
  862.         IF INSTR(MInput$, ".") = 0 THEN
  863.           MInput$ = MInput$ + GetExt$
  864.         END IF
  865.         IF INSTR(MInput$, "\") = 0 THEN
  866.           MInput$ = OldFilePath$ + MInput$
  867.         END IF
  868.         CALL FSplit(MInput$, NewFilePath$, _
  869.                     FileName$, SetExt$)
  870.       END IF
  871.     LOOP UNTIL LEN(FileName$) > 0 OR ExitChar% = 27
  872.     IF ExitChar% = 27 THEN MInput$ = ""
  873.     IF MInput$ = "" THEN
  874.       ManualInput$ = ""
  875.       EXIT FUNCTION
  876.     END IF
  877.     testname$ = MInput$
  878.     CALL FSplit(testname$, testnamepath$, _
  879.                 testnamename$, testnameext$)
  880.     IF INSTR(extension$, "*") = 0 AND _
  881.        INSTR(extension$, "?") = 0 THEN
  882.       testname$ = testname$ + extension$
  883.     END IF
  884.     pe% = FREEFILE
  885.     ON ERROR GOTO File.Not.Found
  886.     OPEN "I", pe%, testname$
  887.     IF LOF(pe%) = 0 THEN ok% = %FALSE ' 0-Byte-Datei
  888.     CLOSE pe%
  889. Resume.Address:
  890.   LOOP UNTIL ok%
  891.   ON ERROR GOTO 0
  892.   ManualInput$ = testname$
  893.   EXIT FUNCTION
  894. File.Not.Found:
  895.   CALL Save.Screen
  896.   CALL Frame(3, 3, 50, 6, " ACHTUNG ! ")
  897.   LOCATE 4, 5, 1
  898.   PRINT "Die Datei ist nicht vorhanden. OK? (J/N): ";
  899.   DO
  900.     DO
  901.       ccx$ = UCASE$(INKEY$)
  902.     LOOP UNTIL ccx$ <> ""
  903.     IF ccx$ = CHR$(13) THEN
  904.       ccx$ = "J"
  905.     ELSEIF ccx$ = CHR$(27) THEN
  906.       ccx$ = "N"
  907.     END IF
  908.     IF (LEN(ccx$) = 2 AND RIGHT$(ccx$, 1) = "-") _
  909.     OR ccx$ = CHR$(24) THEN
  910.       CALL Stopp
  911.       LOCATE , , 1
  912.     END IF
  913.   LOOP UNTIL INSTR("JN", ccx$)
  914.   CALL Restore.Screen
  915.   IF ccx$ = "N" THEN ok% = %FALSE ELSE ok% = %TRUE
  916.   RESUME Resume.Address
  917. END FUNCTION
  918.  
  919. SUB MessageColor
  920. ' Farbe für Meldungen setzen
  921. SHARED MessFore%, MessBack%
  922.   IF MessFore% < 0 OR MessFore% > 15 THEN MessFore% = 0
  923.   IF MessBack% < 0 OR MessBack% > 7 THEN MessBack% = 0
  924.   IF MessFore% <= 0 AND MessBack% <= 0 THEN
  925.     MessFore% = %MessFore
  926.     MessBack% = %MessBack
  927.   END IF
  928.   COLOR MessFore%, MessBack%
  929. END SUB
  930.  
  931. SUB MessageWindow
  932. ' Erstellen des kleinen Infofensters
  933. ' über dem Dateiauswahlfenster.
  934. LOCAL XPos%, YPos%, x%
  935.   YPos% = CSRLIN
  936.   XPos% = POS(x%)
  937.   IF XPos% < 1 OR XPos% > 25 THEN YPos% = 1
  938.   IF YPos% < 1 OR YPos% > 80 THEN XPos% = 1
  939.   CALL Frame(26, 4, 57, 7, "")
  940.   LOCATE 5, 28, 0
  941.   PRINT " Wählen Sie eine Datei aus ";
  942.   LOCATE YPos%, XPos%, 0
  943. END SUB
  944.  
  945. FUNCTION NewMask$(GetFileMask$, lastchar%)
  946. ' Ändern der Dateisuchmaske in einem Bildschirm-
  947. ' fenster mithilfe der Funktion ReadString$()
  948. LOCAL test%, NMask$, XPos%, YPos%
  949.   YPos% = CSRLIN
  950.   XPos% = POS(x%)
  951.   CALL Frame(27, 10, 58, 13, " Neue Suchmaske ")
  952.   LOCATE 11, 29, 1
  953.   NMask$ = ReadString$(GetFileMask$, 11, test%)
  954.   lastchar% = test%
  955.   IF NMask$ = "" THEN NMask$ = GetFileMask$
  956.   IF test% = 27 THEN
  957.     NewMask$ = GetFileMask$
  958.   ELSE
  959.     NewMask$ = NMask$
  960.   END IF
  961.   LOCATE YPos%, XPos%, 0
  962. END FUNCTION
  963.  
  964. FUNCTION ReadString$(EntryStr$, entrylen%, lastchar%) PUBLIC
  965. ' Editierroutine, Ersetzt die in Powerbasic miserable
  966. ' INPUT-Routine
  967. LOCAL entry$, ch$, chh$ Insmode%, count%
  968. LOCAL ready%, curpoint%, x%, y%, s1$, s2$
  969.   y% = CSRLIN
  970.   x% = POS(x%)
  971.   DECR entryLen%
  972.   entry$ = EntryStr$
  973.   PRINT SPACE$(entrylen% + 1);
  974.   IF CrtMode% = 7 THEN
  975.     LOCATE y%, x%, 1, 11, 13
  976.   ELSE
  977.     LOCATE y%, x%, 1, 6, 7
  978.   END IF
  979.   PRINT entry$;
  980.   curpoint% = LEN(entry$)
  981.   InsMode% = %TRUE
  982.   ready%   = %FALSE
  983.   DO
  984.     DO
  985.       ch$ = UCASE$(INKEY$)
  986.     LOOP UNTIL ch$ <> ""
  987.     IF LEN(ch$) = 2 THEN
  988.       chh$ = RIGHT$(ch$, 1)
  989.       ch$ = CHR$(0)
  990.     END IF
  991.     SELECT CASE ch$
  992.       CASE CHR$(10), CHR$(13)
  993.         lastchar% = 13
  994.         ready% = %TRUE
  995.       CASE CHR$(3), CHR$(27)
  996.         lastchar% = 27
  997.         ready% = %TRUE
  998.         entry$ = ""
  999.         curpoint% = 0
  1000.       CASE Chr$(7)
  1001.         IF curpoint% >= 0 AND _
  1002.            curpoint% <> LEN(entry$) THEN
  1003.           FOR count% = curpoint% + 1 TO LEN(entry$) - 1
  1004.             MID$(entry$, count%, 1) = _
  1005.               MID$(entry$, count% + 1, 1)
  1006.           NEXT count%
  1007.           entry$ = LEFT$(entry$, LEN(entry$) - 1)
  1008.           LOCATE y%, x%, 1
  1009.           PRINT entry$; " ";
  1010.           LOCATE y%, x% + curpoint%
  1011.         ELSE
  1012.           BEEP
  1013.         END IF
  1014.       CASE CHR$(8)
  1015.         IF curpoint% > 0 THEN
  1016.           inter$ = entry$
  1017.           FOR count% = curpoint% TO LEN(entry$) - 1
  1018.             MID$(inter$, count%, 1) = _
  1019.               MID$(entry$, count% + 1, 1)
  1020.           NEXT count%
  1021.           entry$ = LEFT$(inter$, LEN(inter$) - 1)
  1022.           DECR curpoint%
  1023.           LOCATE y%, x%, 0
  1024.           PRINT entry$, " ";
  1025.           LOCATE y%, x% + curpoint%, 1
  1026.         END IF
  1027.       CASE CHR$(24)
  1028.         CALL Stopp
  1029.         LOCATE , , 1
  1030.       CASE CHR$(127)
  1031.         curpoint% = 0
  1032.         entry$ = ""
  1033.         LOCATE y%, x%
  1034.         PRINT SPACE$(entrylen% + 1);
  1035.         LOCATE y%, x%
  1036.       CASE "!" TO "&", "(" TO "*", _
  1037.            "-" TO ".", "0" TO ";", _
  1038.            "=", "?" TO "Z", "\", _
  1039.            "_" TO "{", "}", "~", _
  1040.            "Ç" TO "Ñ", "α" TO "■"
  1041.         IF len(entry$) <= entrylen% THEN
  1042.           IF curpoint% >= LEN(entry$) THEN
  1043.             entry$ = entry$ + ch$
  1044.             INCR curpoint%
  1045.             PRINT ch$;
  1046.           ELSE
  1047.             IF InsMode% THEN
  1048.               s1$ = LEFT$(entry$, curpoint%)
  1049.               s2$ = RIGHT$(entry$, _
  1050.                     LEN(entry$) - curpoint% + 1)
  1051.               entry$ = s1$ + ch$ + s2$
  1052.               LOCATE y%, x%, 1
  1053.               PRINT entry$; " ";
  1054.               INCR curpoint%
  1055.               LOCATE y%, curpoint% + x%, 1
  1056.             ELSE ' IF NOT InsMode% THEN
  1057.               PRINT ch$;
  1058.               INCR curpoint%
  1059.               MID$(entry$, curpoint%, 1) = ch$
  1060.             END IF
  1061.           END IF
  1062.         ELSE
  1063.           IF NOT Insmode% AND curpoint% <= entrylen% THEN
  1064.             PRINT ch$;
  1065.             INCR curpoint%
  1066.             MID$(entry$, curpoint%, 1) = ch$
  1067.           ELSEIF Insmode% AND curpoint% <= entrylen% THEN
  1068.             s1$ = LEFT$(entry$, curpoint%)
  1069.             s2$ = RIGHT$(entry$, LEN(entry$) - LEN(s1$))
  1070.             entry$ = s1$ + ch$ + s2$
  1071.             entry$ = LEFT$(entry$, LEN(entry$) - 1)
  1072.             INCR curpoint%
  1073.             IF CrtMode% = 7 THEN
  1074.               LOCATE y%, x%, 1, 11, 13
  1075.             ELSE
  1076.               LOCATE y%, x%, 1, 6, 7
  1077.             END IF
  1078.             PRINT entry$; " "
  1079.             LOCATE y%, curpoint% + x%, 1
  1080.           ELSE
  1081.             BEEP
  1082.           END IF
  1083.         END IF
  1084.       CASE CHR$(0)
  1085.         SELECT CASE chh$
  1086.            CASE "-"
  1087.             CALL Stopp
  1088.             LOCATE , , 1
  1089.           CASE ";"
  1090.             LOCATE , , 0
  1091.             CALL ReadStringHelp
  1092.             LOCATE , , 1
  1093.           CASE "R"
  1094.             IF Insmode% THEN
  1095.               Insmode% = %FALSE
  1096.               LOCATE , , 1, 0, 16
  1097.             ELSE
  1098.               Insmode% = %TRUE
  1099.               IF CrtMode% = 7 THEN
  1100.                 LOCATE , , 1, 11, 13
  1101.               ELSE
  1102.                 LOCATE , , 1, 6, 7
  1103.               END IF
  1104.             END IF
  1105.           CASE "G"
  1106.             curpoint% = 0
  1107.             LOCATE y%, x%, 1
  1108.             PRINT entry$; " ";
  1109.             LOCATE y%, x%, 1
  1110.           CASE "O"
  1111.             curpoint% = LEN(entry$)
  1112.             LOCATE y%, x%, 1
  1113.             PRINT entry$; " ";
  1114.             LOCATE y%, x% + curpoint%, 1
  1115.           CASE "S"
  1116.             IF curpoint% >= 0 AND _
  1117.                curpoint% <> LEN(entry$) THEN
  1118.               FOR count% = curpoint% + 1 TO LEN(entry$) - 1
  1119.                 MID$(entry$, count%, 1) = _
  1120.                   MID$(entry$, count% + 1, 1)
  1121.               NEXT count%
  1122.               entry$ = LEFT$(entry$, LEN(entry$) - 1)
  1123.               LOCATE y%, x%, 1
  1124.               PRINT entry$; " ";
  1125.               LOCATE y%, x% + curpoint%
  1126.             END IF
  1127.           CASE "H", "K"
  1128.             IF curpoint% <> 0 THEN
  1129.               DECR curpoint%
  1130.               LOCATE y%, x% + curpoint%
  1131.             END IF
  1132.           CASE "M", "P"
  1133.             IF curpoint% <> LEN(entry$) THEN
  1134.               INCR curpoint%
  1135.               LOCATE y%, x% + curpoint%
  1136.             END IF
  1137.       END SELECT
  1138.     END SELECT
  1139.   LOOP UNTIL ready%
  1140.   ReadString$ = entry$
  1141.   LOCATE , , 0
  1142. END FUNCTION
  1143.  
  1144. SUB ReadStringHelp
  1145. ' Hilfe für die Editierroutine
  1146. LOCAL OldX%, OldY%, a$, ch$, OldAttr%
  1147.   CALL Save.Screen
  1148.   OldX% = POS(x%)
  1149.   OldY% = CSRLIN
  1150.   OldAttr% = GetTextAttr%
  1151.   CALL ClearKeyBoard
  1152.   a$ = ""
  1153.   CALL Frame(5, 13, 44, 24, " Hilfe für Editierfenster ")
  1154.   LOCATE 14, 7
  1155.   PRINT "Sie können die Eingabe frei editie-";
  1156.   LOCATE 15, 7
  1157.   PRINT "ren.  ^BackSpace löscht die Eingabe";
  1158.   LOCATE 16, 7
  1159.   PRINT "vollständig, Ins wechselt  zwischen";
  1160.   LOCATE 17, 7
  1161.   PRINT "Überschreibemodus     (BlockCursor)";
  1162.   LOCATE 18, 7
  1163.   PRINT "und Einfügemodus (Strichcursor).";
  1164.   LOCATE 19, 7
  1165.   PRINT "Nicht erlaubte Zeichen werden igno-";
  1166.   LOCATE 20, 7
  1167.   PRINT "riert.  Löschen  einzelner  Zeichen";
  1168.   LOCATE 21, 7
  1169.   PRINT "mit Del  und  Backspace.  Übernahme";
  1170.   LOCATE 22, 7
  1171.   PRINT "mit <"; CHR$(17); "──┘>, Abbruch mit <ESC>";
  1172.   WHILE a$ = ""
  1173.     a$ = INKEY$
  1174.     IF (LEN(a$) = 2 AND RIGHT$(a$, 1) = "-") _
  1175.     OR a$ = CHR$(24) THEN
  1176.       CALL Stopp
  1177.       a$ = ""
  1178.     END IF
  1179.   WEND
  1180.   CALL Restore.Screen
  1181.   CALL TextAttr(OldAttr%)
  1182.   LOCATE OldY%, OldX%, 1
  1183. END SUB
  1184.  
  1185. SUB Restore.Screen
  1186. ' Lokale Restaurierung des Bildschirminhaltes.
  1187. ' korresondiert mit SUB Save.Screen
  1188. SHARED Peeked.Screen$
  1189. LOCAL ScreenSeg%
  1190.   IF CrtMode% = 7 THEN
  1191.     ScreenSeg% = &HB000
  1192.   ELSE
  1193.     ScreenSeg% = &HB800
  1194.   END IF
  1195.   DEF SEG = ScreenSeg%
  1196.     POKE$ 0, Peeked.Screen$
  1197.   DEF SEG
  1198. END SUB
  1199.  
  1200. SUB RestoreScreen PUBLIC
  1201. ' Globale Restaurierung des Bildschirm-
  1202. ' inhaltes. Korrespondiert mit SUB SaveScreen.
  1203. ' Kann auch im Hautprogramm verwendet werden.
  1204. SHARED PeekedScreen$
  1205. LOCAL ScreenSeg%
  1206.   IF CrtMode% = 7 THEN
  1207.     ScreenSeg% = &HB000
  1208.   ELSE
  1209.     ScreenSeg% = &HB800
  1210.   END IF
  1211.   DEF SEG = ScreenSeg%
  1212.     POKE$ 0, PeekedScreen$
  1213.   DEF SEG
  1214. END SUB
  1215.  
  1216. SUB Save.Screen
  1217. ' Lokale Sicherung des Bildschirminhaltes.
  1218. ' Korrespondiert mit SUB Restore.Screen
  1219. SHARED Peeked.Screen$
  1220. LOCAL ScreenSeg%
  1221.   IF CrtMode% = 7 THEN
  1222.     ScreenSeg% = &HB000
  1223.   ELSE
  1224.     ScreenSeg% = &HB800
  1225.   END IF
  1226.   DEF SEG = ScreenSeg%
  1227.     Peeked.Screen$ = PEEK$(0, 4000)
  1228.   DEF SEG
  1229. END SUB
  1230.  
  1231. SUB SaveScreen PUBLIC
  1232. ' Globale Sicherung des Bildschirminhaltes.
  1233. ' Korrespondiert mit SUB RestoreScreen. Kann
  1234. ' auch im Hautprogramm verwendet werden.
  1235. SHARED PeekedScreen$
  1236. LOCAL ScreenSeg%
  1237.   IF CrtMode% = 7 THEN
  1238.     ScreenSeg% = &HB000
  1239.   ELSE
  1240.     ScreenSeg% = &HB800
  1241.   END IF
  1242.   DEF SEG = ScreenSeg%
  1243.     PeekedScreen$ = PEEK$(0, 4000)
  1244.   DEF SEG
  1245. END SUB
  1246.  
  1247. SUB Shadow
  1248. ' Schreiben des Schattenzeichens mit
  1249. ' der Zeichennummer shade% um den Rahmen
  1250. ' des definierten Bildschirmfensters
  1251. SHARED OrgAttribute%, shade%
  1252.   CALL TextAttr(OrgAttribute%)
  1253.   PRINT CHR$(shade%);
  1254.   CALL WindowColor
  1255. END SUB
  1256.  
  1257. FUNCTION SRecord.Attr% (DTA$)
  1258. ' Rückgabe des Attributes aus der
  1259. ' Disk Transfer Area (DTA)
  1260.   SRecord.Attr% = ASC(MID$(DTA$, 22, 1))
  1261. END FUNCTION
  1262.  
  1263. FUNCTION SRecord.Name$ (DTA$)
  1264. 2' Rückgabe des Namens aus der
  1265. ' Disk Transfer Area (DTA)
  1266. LOCAL Temp$
  1267.   temp$ = MID$(DTA$, 31) + CHR$(0)
  1268.   SRecord.Name$ = LEFT$(temp$, INSTR(temp$, CHR$(0)) - 1)
  1269. ' * Dateiname aus DTA holen
  1270. END FUNCTION
  1271.  
  1272. SUB Stopit(Breaktest%)
  1273. ' Abbruch-Routine für ALT-X, ^X
  1274. ' wegen der Verschachtelungen muß eine eigene
  1275. ' Bildschirmsicherungsroutine verwendet werden!
  1276. LOCAL OldCurs%, OldY%, OldX%, ScreenSeg%, a$, OldAttr%
  1277.   Breaktest% = %FALSE
  1278.   OldX% = POS(x%)
  1279.   OldY% = CSRLIN
  1280.   DEF SEG = &H40
  1281.     OldCurs% = PEEKI(&H60)
  1282.     Crt%     = PEEK(&H49)
  1283.   DEF SEG
  1284.   IF Crt% = 7 THEN
  1285.     ScreenSeg% = &HB000
  1286.   ELSE
  1287.     ScreenSeg% = &HB800
  1288.   END IF
  1289.   DEF SEG = ScreenSeg%
  1290.     ScreenArray$ = PEEK$(0, 4000)
  1291.   DEF SEG
  1292.   OldAttr% = GetTextAttr%
  1293.   CALL Frame(21, 11, 62, 14, " ACHTUNG ")
  1294.   LOCATE 12, 23, 1
  1295.   PRINT "Programm wirklich abbrechen? (J/N): ";
  1296.   DO
  1297.     DO
  1298.       a$ = UCASE$(INKEY$)
  1299.       IF a$ = CHR$(13) OR _
  1300.          a$ = CHR$(24) OR _
  1301.          (LEN(a$) = 2 AND RIGHT$(a$, 1) = "-") THEN
  1302.         a$ = "J"   ' j, J,  <───┘, ^X, Alt-X
  1303.       ELSEIF a$ = CHR$(27) THEN
  1304.         a$ = "N"   ' n, N, ESC
  1305.       END IF
  1306.     LOOP UNTIL a$ <> ""
  1307.   LOOP UNTIL INSTR("JN", a$)
  1308.   PRINT a$;
  1309.   IF a$ = "N" THEN
  1310.     LOCATE OldY%, OldX%, 0
  1311.     DEF SEG = ScreenSeg%
  1312.       POKE$ 0, ScreenArray$
  1313.     DEF SEG
  1314.     CALL TextAttr(OldAttr%)
  1315.     EXIT SUB
  1316.   END IF
  1317.   CLS
  1318.   LOCATE , , 1
  1319.   Breaktest% = %TRUE
  1320. END SUB
  1321.  
  1322. SUB Stopp
  1323. ' Abbruchprozedur
  1324. LOCAL break%
  1325.   CALL Stopit(break%)
  1326.   IF break% THEN CALL ChangeOrgDir: STOP
  1327. END SUB
  1328.  
  1329. SUB TextAttr(Attr%)
  1330. ' Schreiben des Textattributes statt des
  1331. ' Color-Prozedur, Wird benötigt, wenn das
  1332. ' Attribut mit SCREEN ,,1 ermittelt wurde
  1333. ' z.B. in FUNCTION GetTextAttr%().
  1334.   IF Attr% > &HFF THEN Attr% = Attr% MOD &HFF
  1335.   IF Attr% >= 0 AND Attr% < &H100 THEN
  1336.     IF Attr% > 126 THEN
  1337.       COLOR Attr% MOD &H10 + &H10, Attr% \ &H10
  1338.     ELSE
  1339.       COLOR Attr% MOD &H10, Attr% \ &H10
  1340.     END IF
  1341.   END IF
  1342. END SUB
  1343.  
  1344. SUB WindowColor
  1345. ' Setzen des Fensterfarben
  1346. SHARED WinFore%, WinBack%
  1347.   IF WinFore% <= 0 AND WinBack% <= 0 THEN
  1348.     WinFore% = %WinFore
  1349.     WinBack% = %WinBack
  1350.   END IF
  1351.   COLOR WinFore%, WinBack%
  1352. END SUB
  1353.  
  1354. FUNCTION GetFile$(GetFileMask$, _
  1355.                   InputAllowed%, _
  1356.                   SortDir%) PUBLIC
  1357. ' Funktion zum Einlesen eines Dateinamens (mit Pfad)
  1358. ' aus einem Bildschirmfenster mit Wechsel von Lauf-
  1359. ' werk und Verzeichnis. Bei Abbruch mit <ESC> wird
  1360. ' der String "<ESC>" zurückgegeben, auf den ium Haupt-
  1361. ' programm getestet werden muß, da es sich um keine
  1362. ' valide Dateikennung handelt.
  1363. SHARED GetFMask$, OrgAttribute%, CursorStart%
  1364. SHARED MarkedFile%, DirArray$[], PathString$
  1365. SHARED OrgDirectory$, DirString$, att%, ConfigFile$
  1366. SHARED ESCBack$, DriveStr1$, DriveStr2$, ManualName$
  1367. SHARED dmax%, drives%, first%, last%, BarBack%
  1368. SHARED MessFore%, MessBack%, WinFore%, initialized%
  1369. SHARED shade%, ArrayNum%, WinBack%, BarFore%
  1370. LOCAL OldX%, OldY%, ch$, cx$, chh$, drive%
  1371. LOCAL tcount%, ctx%, x%
  1372.   IF NOT initialized% THEN CALL InitDirwin("DIRWIN.CFG")
  1373.   OldY% = CSRLIN
  1374.   OldX% = POS(x%)
  1375.   IF GetFMask$ <> "" THEN GetFileMask$ = GetFMask$
  1376.   GetFileMask$ = UCASE$(GetFileMask$)
  1377.   drives% = GetDrives%
  1378.   drive% = 0
  1379.   ActFile% = 1
  1380.   CALL SaveScreen
  1381.   CALL GetDir(drive%, OrgDirectory$)
  1382.   PathString$ = ""
  1383. Looplabel:
  1384.   IF PathString$ <> "" THEN CALL ChangeActDir
  1385.   CALL GetDir(drive%, DirString$)
  1386.   MarkedFile% = 1
  1387.   IF LEN(DirString$) = 3 THEN
  1388.     DirString$ = LEFT$(DirString$, 2)
  1389.   END IF
  1390.   PathString$ = DirString$ + "\" + GetFileMask$
  1391.   CALL MessageWindow
  1392.   LOCATE , , 0
  1393.   CALL GetDirectory(GetFileMask$, SortDir%)
  1394.   att% = %TRUE
  1395.   first% = 1
  1396.   CALL FillDirWindow
  1397.   DO
  1398.     ch$  = ""
  1399.     ccx$ = ""
  1400.     chh$ = ""
  1401.     DO
  1402.       ch$ = INKEY$
  1403.       IF LEN(ch$) > 1 THEN
  1404.          ccx$ = RIGHT$(ch$, 1)
  1405.          ch$ = CHR$(0)
  1406.       END IF
  1407.     LOOP UNTIL ch$ <> ""
  1408.     SELECT CASE ch$
  1409.       CASE CHR$(0)
  1410.         SELECT CASE ccx$
  1411.           CASE "-"
  1412.             CALL Stopp
  1413.           CASE ";", "^", "T", "h"
  1414.             CALL DwHelp(InputAllowed%)
  1415.           CASE "<", "_", "U", "i"
  1416.             CALL ChangeMenuColors(GetFileMask$)
  1417.             CALL MessageWindow
  1418.             CALL DirWindow
  1419.             CALL FillDirWindow
  1420.           CASE "g", "]", "q", "D"
  1421.             IF InputAllowed% THEN
  1422.               ManualName$ = ManualInput$
  1423.               IF ManualName$ = "" THEN GOTO LoopLabel
  1424.               GetFile$ = ManualName$
  1425.               CALL RestoreScreen
  1426.               LOCATE OldY%, OldX%, 1
  1427.               CALL TextAttr(OrgAttribute%)
  1428.               CALL ChangeOrgDir
  1429.               EXIT FUNCTION
  1430.             END IF
  1431.           CASE "K"
  1432.             IF MarkedFile% > first% THEN DECR MarkedFile%
  1433.           CASE "M"
  1434.             IF MarkedFile% < dmax% THEN
  1435.               IF MarkedFile% < 35 + first% THEN
  1436.                 INCR MarkedFile%
  1437.               END IF
  1438.             END IF
  1439.           CASE "G"
  1440.             MarkedFile% = first%
  1441.           CASE "O"
  1442.             WHILE MarkedFile% < dmax% AND _
  1443.                   MarkedFile% < 35 + first%
  1444.               INCR MarkedFile%
  1445.             WEND
  1446.           CASE "w", "ä"
  1447.             first% = 1
  1448.             MarkedFile% = 1
  1449.             CALL DirWindow
  1450.             CALL FillDirWindow
  1451.           CASE "v"
  1452.             IF dmax% > 35 THEN
  1453.               DO
  1454.                 INCR first%, 4
  1455.                 MarkedFile% = first%
  1456.               LOOP UNTIL MarkedFile% >= dmax% - 35 AND _
  1457.                          MarkedFile% <= dmax% - 31
  1458.               CALL DirWindow
  1459.               CALL FillDirWindow
  1460.             END IF
  1461.           CASE "u"
  1462.             IF first% < dmax% - 3 THEN
  1463.               DO
  1464.                 INCR first%, 4
  1465.                 MarkedFile% = first%
  1466.               LOOP UNTIL MarkedFile% >= dmax% - 3 AND _
  1467.                          MarkedFile% <= dmax%
  1468.               CALL DirWindow
  1469.               CALL FillDirWindow
  1470.             END IF
  1471.           CASE "I"
  1472.             IF MarkedFile% < 37 THEN
  1473.               first% = 1
  1474.               MarkedFile% = 1
  1475.             ELSE
  1476.               IF first% > 35 THEN
  1477.                 DECR first%, 36
  1478.               ELSE
  1479.                 first% = 1
  1480.               END IF
  1481.               MarkedFile% = first%
  1482.               CALL DirWindow
  1483.               CALL FillDirWindow
  1484.             END IF
  1485.           CASE "Q"
  1486.             IF dmax% < 37 THEN
  1487.               MarkedFile% = dmax%
  1488.             ELSE
  1489.               IF NOT (first% >= dmax% - 3 AND _
  1490.                       first% <= dmax%) THEN
  1491.                 IF dmax% > 35 THEN
  1492.                   IF first% < dmax% - 35 THEN
  1493.                     INCR first%, 36
  1494.                   ELSE
  1495.                     DO
  1496.                       INCR first%, 4
  1497.                       markedfile% = first%
  1498.                     LOOP UNTIL MarkedFile% >= dmax% - 3  _
  1499.                            AND MarkedFile% <= dmax%
  1500.                   END IF
  1501.                 END IF
  1502.               END IF
  1503.             END IF
  1504.             MarkedFile% = first%
  1505.             CALL DirWindow
  1506.             CALL FillDirWindow
  1507.           CASE "H"
  1508.             IF first% - 1 < MarkedFile% AND _
  1509.                first% + 4 > MarkedFile% THEN
  1510.               IF MarkedFile% - 3 > 1 THEN
  1511.                 DECR first%, 4
  1512.                 DECR MarkedFile%, 4
  1513.                 CALL DirWindow
  1514.                 CALL FillDirWindow
  1515.               END IF
  1516.             ELSE
  1517.               IF MarkedFile% > 3 + first% THEN
  1518.                 DECR MarkedFile%, 4
  1519.               END IF
  1520.             END IF
  1521.           CASE "P"
  1522.             IF first% + 31 < MarkedFile% AND _
  1523.                first% + 36 > MarkedFile% THEN
  1524.               IF MarkedFile% + 4 < dmax% THEN
  1525.                 INCR first%, 4
  1526.                 INCR MarkedFile%, 4
  1527.                 CALL DirWindow
  1528.                 CALL FillDirWindow
  1529.               ELSE
  1530.                 IF MarkedFile% <> dmax% THEN
  1531.                   INCR first%, 4
  1532.                   MarkedFile% = dmax%
  1533.                   CALL DirWindow
  1534.                   CALL FillDirWindow
  1535.                 END IF
  1536.               END IF
  1537.             ELSE
  1538.               IF MarkedFile% <= dmax% - 4 AND _
  1539.                  MarkedFile% <= dmax% + first% THEN
  1540.                 INCR MarkedFile%, 4
  1541.               ELSE
  1542.                 IF MarkedFile% > dmax% - 4 THEN
  1543.                   MarkedFile% = dmax%
  1544.                 END IF
  1545.               END IF
  1546.             END IF
  1547.           CASE ELSE: CALL ErrorBeep
  1548.         END SELECT
  1549.       CASE CHR$(24)
  1550.         CALL Stopp
  1551.       CASE CHR$(32)
  1552.         CALL Save.Screen
  1553.         GetFMask$ = NewMask$(GetFileMask$, LastChar%)
  1554.         IF LEFT$(GetFMsk$, 1) = "." THEN
  1555.           GetFMask$ = "*" + GetFMask$
  1556.         END IF
  1557.         IF GetFileMask$ = GetFMask$ THEN
  1558.           LastChar% = 27
  1559.         ELSE
  1560.           GetFileMask$ = GetFMask$
  1561.         END IF
  1562.         IF LastChar% <> 27 THEN
  1563.           CALL Frame (3, 3, 43, 6, "")
  1564.           LOCATE 4, 5, 1
  1565.           PRINT "Als Standardmaske speichern (J/N): ";
  1566.           DO
  1567.             DO
  1568.               chh$ = UCASE$(INKEY$)
  1569.             LOOP UNTIL chh$ <> ""
  1570.             IF chh$ = CHR$(13) THEN
  1571.               chh$ = "J"
  1572.             ELSEIF chh$ = CHR$(27) THEN
  1573.               chh$ = "N"
  1574.             END IF
  1575.           LOOP UNTIL INSTR("JN", chh$)
  1576.           LOCATE , , 0
  1577.           PRINT chh$;
  1578.           DELAY 0.4
  1579.           IF chh$ = "J" THEN
  1580.             CALL Frame(40, 19, 70, 22, "")
  1581.             LOCATE 20, 42, 0
  1582.             CALL MessageColor
  1583.             PRINT " Maske wird gespeichert ! ";
  1584.             CALL SaveConfig(ArrayNum%, MessFore%, _
  1585.                             MessBack%, WinFore%, _
  1586.                             WinBack%, BarFore%, _
  1587.                             BarBack%, shade%, _
  1588.                             GetFileMask$)
  1589.           END IF
  1590.         END IF
  1591.         CALL Restore.Screen
  1592.         GOTO Looplabel
  1593.       CASE CHR$(07), CHR$(09)
  1594.         IF MarkedFile% < dmax% AND _
  1595.            MarkedFile% < 35 + first% THEN
  1596.           INCR MarkedFile%
  1597.         END IF
  1598.       CASE CHR$(10), CHR$(13)
  1599.         IF INSTR(DirArray$[MarkedFile%], "\") THEN
  1600.           IF DirArray$[MarkedFile%] <> ".\" THEN
  1601.             IF DirArray$[MarkedFile%] = "..\" THEN
  1602.               IF PathString$ <> GetFileMask$ THEN
  1603.                 CALL GetDir(drive%, PathString$)
  1604.                 drv$ = LEFT$(PathString$, 2) + ".."
  1605.                 CHDIR drv$
  1606.                 CALL GetDir(drive%, PathString$)
  1607.                 PathString$ = PathString$ _
  1608.                       + "\" + GetFileMask$
  1609.                 x% = INSTR(PathString$, "\\")
  1610.                 IF x% > 0 THEN
  1611.                   PathString$ = EXTRACT$(PathString$, _
  1612.                     "\\") + MID$(PathString$, x% + 1)
  1613.                 END IF
  1614.               END IF
  1615.             ELSE
  1616.               CALL GetDir(drive%, PathString$)
  1617.               PathString$ = PathString$ + "\" + _
  1618.                           DirArray$[MarkedFile%]
  1619.               PathString$ = LEFT$(PathString$, _
  1620.                           LEN(PathString$) - 1)
  1621.               x% = INSTR(PathString$, "\\")
  1622.               IF x% > 0 THEN
  1623.                 PathString$ = EXTRACT$(PathString$, _
  1624.                   "\\") + MID$(PathString$, x% + 1)
  1625.               END IF
  1626.               CHDIR PathString$
  1627.               PathString$ = PathString$ + "\" + GetFileMask$
  1628.               x% = INSTR(PathString$, "\\")
  1629.               IF x% > 0 THEN
  1630.                 PathString$ = EXTRACT$(PathString$, _
  1631.                   "\\") + MID$(PathString$, x% + 1)
  1632.               END IF
  1633.             END IF
  1634.             Att% = %TRUE
  1635.             MarkedFile% = 1
  1636.             CALL GetDirectory(GetFileMask$, SortDir%)
  1637.             CALL FillDirWindow
  1638.           END IF
  1639.         ELSE
  1640.           IF INSTR(DirArray$[MarkedFile%], _
  1641.                    DriveStr1$) > 0 AND _
  1642.              INSTR(DirArray$[MarkedFile%), _
  1643.                    DriveStr2$) > 0 AND _
  1644.              MID$(DirArray$[MarkedFile%], 6, 1) > "@" AND _
  1645.              MID$(DirArray$[MarkedFile%], 6, 1) < "[" THEN
  1646.             drive% = ASC(MID$(DirArray$[MarkedFile%], _
  1647.                          6, 1)) - ASC("@")
  1648.             IF (drive% < 3) AND (drive% <> 0) THEN
  1649.               CALL Save.Screen
  1650.               CALL Frame(38, 19, 77, 22, " ACHTUNG ")
  1651.               LOCATE 20, 40, 0
  1652.               CALL MessageColor
  1653.               CALL ClearKeyBoard
  1654.               PRINT " Diskette einlegen, Taste drücken! ";
  1655.               DO
  1656.                c$ = INKEY$
  1657.                IF c$ = CHR$(27) THEN
  1658.                  CALL Restore.Screen
  1659.                  drive% = 0
  1660.                  GOTO LoopLabel
  1661.                ELSEIF (LEN(c$) = 2 AND RIGHT$(c$, 1) = "-") _
  1662.                OR c$ = CHR$(24) THEN
  1663.                  CALL Stopp
  1664.                  c$ = ""
  1665.                END IF
  1666.               LOOP UNTIL c$ <> ""
  1667.               CALL Restore.Screen
  1668.             END IF
  1669.             CALL GetDir(drive%, PathString$)
  1670.             CALL ChangeActDir
  1671.             PathString$ = PathString$ + "\" + GetFileMask$
  1672.             GOTO Looplabel
  1673.           ELSE
  1674.             IF DirArray$[MarkedFile%] = NoDriveB$ THEN
  1675.               drive% = 0
  1676.               CALL ErrorBeep
  1677.               GOTO Looplabel
  1678.             ELSE
  1679.               cxt% = LINSTR%(PathString$, "\")
  1680.               IF cxt% > 0 THEN
  1681.                 PathString$ = LEFT$(PathString$, cxt%)
  1682.               END IF
  1683.               GetFile$ = PathString$ + _
  1684.                          DirArray$[MarkedFile%]
  1685.               CALL RestoreScreen
  1686.               LOCATE OldY%, OldX%, 1
  1687.               CALL TextAttr(OrgAttribute%)
  1688.               CALL ChangeOrgDir
  1689.               EXIT FUNCTION
  1690.             END IF
  1691.           END IF
  1692.         END IF
  1693.       CASE CHR$(27)
  1694.       CASE ELSE: CALL ErrorBeep
  1695.     END SELECT
  1696.     CALL FillDirWindow
  1697.   LOOP UNTIL ch$ = CHR$(27)
  1698.   CALL RestoreScreen
  1699.   CALL TextAttr(OrgAttribute%)
  1700.   IF CrtMode% = 7 THEN
  1701.     LOCATE OldY%, OldX%, 1, 11, 13
  1702.   ELSE
  1703.     LOCATE OldY%, OldX%, 1, 6, 7
  1704.   END IF
  1705.   GetFile$ = ESCBack$
  1706.   CALL ChangeOrgDir
  1707. END FUNCTION
  1708.  
  1709. SUB ClearKeyBoard
  1710. ' Löschen des Tastaturpuffers über das
  1711. ' Ignorieren der Eingabe und Schicken
  1712. ' der Tasteneingaben ins Nichts.
  1713. LOCAL ch$
  1714.   WHILE INSTAT
  1715.     ch$ = INKEY$
  1716.   WEND
  1717. END SUB
  1718.  
  1719. FUNCTION CrtMode%
  1720. ' Bildschirmmodus ermitteln über das
  1721. ' BIOS-Datensegment bei 40h:49h
  1722. LOCAL Crt%
  1723.   DEF SEG = &H40
  1724.     Crt% = PEEK(&H49)
  1725.   DEF SEG
  1726.   CrtMode% = Crt%
  1727. END FUNCTION
  1728.  
  1729.