0  BEGIN PGM 90351_de MM 
1  ;NC-Programm um den Dateinamen
2  ;aus dem kompletten Pfad zu
3  ;extrahieren. Dazu wird zunaechst
4  ;die Textdatei in ein NC-Programm
5  ;kopiert. In diesem Programm ist
6  ;dem Stringparameter QS1 der
7  ;Dateipfad zugewiesen.
8  ;Aus diesem String separiert das
9  ;Programm den Dateinamen.
10 ;Dazu wird der String nach dem
11 ;"\" durchsucht, und der davor
12 ;stehende Teil im String wird
13 ;entfernt. Dieser Schritt wird
14 ;wiederholt, bis kein "\" mehr
15 ;gefunden wird. Im Anschluss
16 ;entfernt die Steuerung noch die
17 ;Dateiendung ".h", so dass nur
18 ;der Dateiname uebrig bleibt.
19 ;Diesen uebergibt die Steuerung 
20 ;dann im QS1 an das
21 ;Ursprungsprogramm.
22 ;Am Programmende loescht die
23 ;Steuerung noch die Textdatei
24 ;"FILE.a" und das NC-Programm
25 ;"FILE.H".
26 ;
27 ;Textdatei in ein NC-Programm
28 ;kopieren
29 FUNCTION FILECOPY "FILE.a" TO "FILE.H"
30 ;
31 ;Dateinamen aus Pfad selektieren
32 ;zu suchendes Zeichen
33 QS2 = "\"
34 ;
35 ;Programm "FILE.H" aufrufen, um
36 ;den QS1 mit dem darin
37 ;hinterlegten Pfad auszulesen 
38 CALL PGM FILE.H
39 ;
40 LBL 1 ;Beginn Schleife
41 ;
42 ;String QS1 durchsuchen nach "\"
43 Q50 = INSTR( SRC_QS1 SEA_QS2 BEG0 )
44 ;Ergebnis in Q50 ist die Stelle an
45 ;der der "\" gefunden wurde
46 ;
47 ;Ergebnis des Q50 um 1 erhoehen
48 Q52 = Q50 + 1
49 ;
50 ;Auslesen Gesamtlaenge String,
51 ;speichern im Q53
52 Q53 = STRLEN( SRC_QS1 )
53 ;
54 ;Gesamtlaenge String -1
55 Q55 = Q53 - 1
56 ;Wenn der Befehl INSTR das Zeichen
57 ;"\" nicht findet, gibt er die
58 ;Laenge des Strings zurueck,
59 ;begonnen bei Stelle 1
60 ;Wenn das Zeichen "\" nicht mehr im
61 ;QS1 vorhanden ist, springt die 
62 ;Steuerung zum LBL "END"
63 FN 9: IF +Q50 EQU +Q53 GOTO LBL "END"
64 ;
65 ;Laenge String - alle Zeichen bis
66 ;zum "\"
67 Q54 = Q53 - Q52
68 QS1 = SUBSTR( SRC_QS1 BEGQ52 LENQ54 )
69 ;
70 ;Sprung zu LBL 1
71 FN 9: IF +0 EQU +0 GOTO LBL 1
72 ;
73 ;Dateiendung entfernen
74 ;Dateiname mit Endung extrahiert
75 LBL "END"
76 ;
77 ;Dateiendung, z. B. .H entfernen
78 ;Q56 = Gesamtlaenge String
79 ;(Dateiname+Endung)-2
80 Q56 = Q53 - 2
81 ;Dateiname auslesen
82 QS1 = SUBSTR( SRC_QS1 BEG0 LENQ56 )
83 ;
84 ;Hilfsdateien loeschen
85 FUNCTION FILEDELETE "FILE.a"
86 FUNCTION FILEDELETE "FILE.h"
87 ;
88 ;Programmende, der Dateiname wird
89 ;im QS1 mit in das rufende
90 ;Programm uebergeben
91 END PGM 90351_de MM