0 BEGIN PGM 90351_nl MM 
1 ;NC-programma om de bestandsnaam uit het
2 ;volledige pad te extraheren. Daarvoor
3 ;wordt eerst het tekstbestand in een
4 ;NC-programma gekopieerd. In dit programma
5 ;is aan stringparameter QS1 het bestandspad
6 ;toegewezen.
7 ;Uit deze string neemt het programma de
8 ;bestandsnaam. Daartoe wordt de string na het
9 ;deel dat in de string staat verwijderd.
10 ;Deze stap wordt herhaald totdat er geen
11 ;"\" meer wordt gevonden. Aansluitend
12 ;verwijdert de besturing nog de
13 ;bestandsextensie ".h”, zodat alleen de
14 ;bestandsnaam resteert.
15 ;Deze geeft de besturing dan door in QS1
16 ;aan het oorspronkelijke programma.
17 ;Aan het programma-einde wist de besturing
18 ;nog het tekstbestand "FILE.a" en het
19 ;NC-programma "FILE.H".
20 ;
21 ;Tekstbestand naar een NC-programma
22 ;kopiëren
23 FUNCTION FILECOPY "FILE.a" TO "FILE.H"
24 ;
25 ;Bestandsnaam uit pad selecteren.
26 ;Te zoeken teken
QS2 = "\"
27 ;
28 ;Programma "FILE.H" oproepen om de QS1
29 ;met het daarin opgeslagen pad uit te
30 ;lezen
31 CALL PGM FILE.H
32 ;
33 LBL 1 ;Begin lus
34 ;
35 ;String QS1 doorzoeken op "\"
Q50 = INSTR( SRC_QS1 SEA_QS2 BEG0 )
36 ;Resultaat in Q50 is de plaats waar het
37 ;teken "\" is gevonden
38 ;
39 ;Resultaat van de Q50 met 1 verhogen
Q52 = Q50 + 1
40 ;
41 ;Uitlezen totale lengte string, opslaan
42 ;in Q53
Q53 = STRLEN( SRC_QS1 )
43 ;
44 ;Totale lengte string -1
Q55 = Q53 - 1
45 ;Als het commando INSTR het teken "\"
46 ;niet kan vinden, wordt de lengte van de
47 ;string geretourneerd, beginnend bij plaats
48 ;1. Indien het teken "\" niet meer in QS1
49 ;aanwezig is, springt de besturing naar de
50 ;LBL "END"
51 FN 9: IF +Q50 EQU +Q53 GOTO LBL "END"
52 ;
53 ;Lengte string - alle tekens tot "\"
Q54 = Q53 - Q52
QS1 = SUBSTR( SRC_QS1 BEGQ52 LENQ54 )
54 ;
55 ;Sprong naar LBL 1
56 FN 9: IF +0 EQU +0 GOTO LBL 1
57 ;
58 ;Bestandsextensie verwijderen
59 ;Bestandsnaam met extensie geëxtraheerd
60 LBL "END"
61 ;
62 ;Bestandsextensie, bijv. .H verwijderen
63 ;Q56 = totale lengte string
64 ;(Bestandsnaam+extensie)-2
Q56 = Q53 - 2
65 ;Bestandsnaam uitlezen
QS1 = SUBSTR( SRC_QS1 BEG0 LENQ56 )
66 ;
67 ;Hulpbestanden wissen
68 FUNCTION FILEDELETE "FILE.a"
69 FUNCTION FILEDELETE "FILE.h"
70 ;
71 ;Programma-einde, bestandsnaam wordt in QS1
72 ;met het oproepende programma verzonden.
73 END PGM 90351_nl MM