1000 ! * VERS.BAC
1005 INTEGER : EXTEND 
1020 ; '** Utility versions **'
1040 ; '   Ver X.00, 1984-09-27'
1060 ; '   Copyright 1982 Dataindustrier AB'
1080 ! *
1100 ! *  Written by G|ran Nordenborg
1120 ! ** ** ** ** ** ** ** ** ** ** **
1140 ! *
1160 ! * Ver date / Ver nb / Sign / Note
1180 ! * 84-09-27 /  X.00  /  GN  / Main
1200 ! *
1220 ! ** ** ** ** ** ** ** ** ** ** **
1240 ! *
1260 ! EJECT
1280 ! ********************************
1300 ! *
1320 ! *  Main routine
1340 ! *
1360 IF FNVers THEN ; 'VERS abort'
1380 END 
1400 ! EJECT
1420 ! ***********************************
1440 ! *
1460 ! *  List utility versions 
1480 ! *
1500 DEF FNVers
1520   IF FNInitialize THEN RETURN T
1540   ; 'Command: ';
1560   INPUT LINE Cmd$
1580   ; 
1600   IF FNCmdscan(FNCapstr$(LEFT$(Cmd$,LEN(Cmd$)-2))) THEN RETURN T
1620   OPEN Outfile$ AS FILE Lud
1640   IF INSTR(1,Option$,'?') THEN RETURN FNHelp
1660   IF INSTR(1,Option$,'D') THEN IF FNGetdate THEN RETURN T
1670   IF INSTR(1,Option$,'V') THEN IF FNGetver THEN RETURN T
1680   IF Infile$='CON:' AND Selfile$<>'' THEN RETURN FNPrintvers(Selfile$)
1700   ON ERROR GOTO 1920
1720   OPEN Infile$ AS FILE Lus
1740   INPUT LINE #Lus Chkfile$
1760   IF Infile$='CON:' THEN ; 
1780   Chkfile$=FNCapstr$(LEFT$(Chkfile$,LEN(Chkfile$)-2))
1800   WHILE Chkfile$<>''
1820     IF FNPrintvers(Chkfile$) THEN RETURN T
1840     INPUT LINE #Lus Chkfile$
1860     Chkfile$=FNCapstr$(LEFT$(Chkfile$,LEN(Chkfile$)-2))
1880   WEND 
1900   RETURN F
1920   ! *
1940   ! *  Read error on source file
1960   ! *
1980   RESUME 2000
2000   IF ERRCODE=21 THEN ; 'Can''t find source file ''' Infile$ '''' : RETURN T
2020   IF ERRCODE<>34 THEN ; 'Error' ERRCODE 'during read on ''' Infile$ '''' : RETURN T
2040   RETURN F
2060 FNEND 
2080 ! **********************************
2100 ! *
2120 ! *  All initialisations
2140 ! *
2160 DEF FNInitialize
2180   F=0
2200   T=NOT F
2220   Lus=1
2240   Lud=2
2260   Lut=3
2280   Tbnam=1
2300   Tbver=Tbnam+15
2320   Tbhdr=Tbver+40
2340   Tbhst=Tbnam+15
2360   Buffl=(SYS(4)-2000)/2
2380   DIM Buffer$=Buffl
2400   RETURN F
2420 FNEND 
2440 ! ***********************************
2460 ! *
2480 ! *   Pring utility version
2500 ! *
2520 DEF FNPrintvers(Chkfilep$)
2540   Chkfile$=Chkfilep$
2560   IF INSTR(1,Chkfile$,'.')=0 THEN Chkfile$=Chkfile$+'.BAC'
2580   ON ERROR GOTO 3000
2600   OPEN Chkfile$ AS FILE Lut
2620   IF INSTR(1,Chkfile$,'.BAC')=0 THEN 3140
2640   POSIT #Lut 20
2660   IF FNGetcomment OR FNGetcomment THEN RETURN T
2680   Header$=Comment$
2700   IF FNGetcomment THEN RETURN T
2720   Ver$=RIGHT$(Comment$,4)
2740   IF MID$(Ver$,5,4)<Testver$ OR MID$(Ver$,13,8)<Testdate$ THEN CLOSE Lut : RETURN F
2760   ; #Lud TAB(Tbnam) Chkfile$ TAB(Tbver) Ver$ TAB(Tbhdr) LEFT$(Header$+SPACE$(79-Tbhdr),79-Tbhdr)
2780   ; #Lud TAB(Tbhst) 'Ver date / Ver nr / Sign / Note'
2800   WHILE FNGetcomment=F
2810     IF INSTR(1,Comment$,'EJECT') THEN CLOSE Lut : RETURN F
2820     ON ERROR GOTO 2920
2839     Pnt=INSTR(1,Comment$,'* 8')
2840     IF Pnt THEN IF MID$(Comment$,14,4)>Testver$ AND MID$(Comment$,3,8)>Testdate$ ; #Lud TAB(Tbhst) LEFT$(RIGHT$(Comment$,3)+SPACE$(79),79-Tbhst)
2860   WEND 
2880   CLOSE Lut
2900   RETURN F
2920   ! *
2940   ! *  Error during search of date string
2960   ! *
2980   RESUME 2860
3000   ! *
3020   ! *  Error during file open
3040   ! *
3060   RESUME 3080
3080   IF Error=21 THEN ; 'Can''t find ''' Chkfile$ '''' : RETURN T
3100   ; 'Error' ERRCODE 'during open of ''' Chkfile$ ''''
3120   RETURN T
3140   ! *
3160   ! *  Non BAC file listing
3180   ! *
3200   ON ERROR GOTO 3440
3210   Buffer$=SPACE$(Buffl)
3220   GET #Lut Buffer$ COUNT Buffl
3240   WHILE INSTR(1,Buffer$,'Ver ')=0
3260     GET #Lut Buffer$ COUNT Buffl
3280   WEND 
3300   Pnt=INSTR(1,Buffer$,'Ver ')
3340   IF Pnt=0 THEN CLOSE Lut : ; #Lud TAB(Tbnam) Chkfile$ TAB(Tbver) 'Version not found' : RETURN F
3360   IF MID$(Buffer$,Pnt+4,4)<Testver$ OR MID$(Buffer$,Pnt+12,8)<Testdate$ THEN CLOSE Lut : RETURN F
3380   ; #Lud TAB(Tbnam) Chkfile$ TAB(Tbver) MID$(Buffer$,Pnt,20)
3400   CLOSE Lut
3420   RETURN F
3440   ! *
3460   ! *  EOF found
3480   ! *
3500   IF ERRCODE<>34 AND ERRCODE<>38 THEN ; 'Error' ERRCODE 'during read on ''' Chkfile$ '''' : RETURN T
3520   RESUME 3300
3540 FNEND 
3560 ! *********************************
3580 ! *
3600 ! *  Get next comment line from code
3620 ! *
3640 DEF FNGetcomment
3660   GET #Lut Code$
3680   IF Code$<>CHR$(135) THEN ; 'Bad file' : RETURN T
3700   GET #Lut Length$
3720   GET #Lut Dummy$ COUNT 2
3740   GET #Lut Code$
3760   IF Code$=CHR$(144) THEN GET #Lut Count$ : GET #Lut Comment$ COUNT ASCII(Count$)-1 : RETURN F
3780   IF Code$<>CHR$(147) AND Code$<>CHR$(148) THEN RETURN T
3800   IF ASCII(Length$)=5 THEN Comment$='' : RETURN F
3820   GET #Lut Code$
3840   IF Code$<>CHR$(203) AND Code$<>CHR$(204) THEN RETURN T
3860   GET #Lut Count$ COUNT 1
3880   GET #Lut Comment$ COUNT ASCII(Count$)
3900   GET #Lut Dummy$
3920   RETURN F
3940 FNEND 
3960 ! ********************************
3980 ! *
4000 ! *  Get date
4020 ! *
4040 DEF FNGetdate
4060   ON ERROR GOTO 4200
4080   Year=0
4100   Month=0
4120   Day=0
4140   INPUT 'Give date (YY,MM,DD): 'Year,Month,Day
4160   Testdate$=NUM$(Year)+'-'+RIGHT$(NUM$(100+Month),2)+'-'+RIGHT$(NUM$(100+Day),2)
4180   RETURN F
4200   ! *
4220   ! *  Bad date given
4240   ! *
4260   RESUME 4160
4280 FNEND 
4281 ! ************************************
4282 ! *
4283 ! *  Get version number
4284 ! *
4285 DEF FNGetver
4287   Ver=0
4288   Rev=0
4289   INPUT 'Give version number (V.RR): 'Testver$
4290   Testver$=FNCapstr$(Testver$)
4291   RETURN F
4299 FNEND 
4300 ! ************************************
4320 ! *
4340 ! *  Help texts
4360 ! *
4380 DEF FNHelp
4400   ; #Lud 'VERS is a utility to list version numbers on other utilities'
4420   ; #Lud 'Command syntax is ''FILE <INFILE >OUTFILE -OPTIONS''.'
4422   ; #Lud 'If FILE is specified, only version number of that file will be listed.'
4440   ; #Lud 'Infile holds filenames on files to be listed. If no infile'
4460   ; #Lud 'is given, CON: is assumed. Options avaliable:'
4480   ; #Lud 'D  - List utilities changed after a specified date'
4500   ; #Lud 'V  - List utilities with special version number (or greater)'
4520   RETURN F
4540 FNEND 
4560 ! **************************************
4580 ! *
4600 ! *  Make string block letters
4620 ! *
4640 DEF FNCapstr$(Str$)
4660   FOR Strpnt=1 TO LEN(Str$)
4680     IF MID$(Str$,Strpnt,1)>=CHR$(97) THEN MID$(Str$,Strpnt,1)=CHR$(ASCII(MID$(Str$,Strpnt,1)) AND 223)
4700   NEXT Strpnt 
4720   RETURN Str$
4740 FNEND 
4760 ! * CMDSCAN.BAC
4780 ! '** Command handler **'
4800 ! '   Ver X.00, 1984-08-09'
4820 ! '   Copyright 1984 Dataindustrier AB'
4840 ! 
4860 ! *  Written by G|ran Nordenborg
4880 ! ** ** ** ** ** ** ** ** ** ** **
4900 ! *
4920 ! * Ver date / Ver nb / Sign / Note
4940 ! * 84-08-09 /  X.00  /  GN  / Main
4960 ! *
4980 ! ** ** ** ** ** ** ** ** ** ** **
5000 ! *
5020 ! EJECT
5040 ! ********************************
5060 ! *
5080 ! *  Main routine
5100 ! *
5120 DEF FNCmdscan(Str$)
5140   Selfile$=''
5160   Infile$='CON:'
5180   Outfile$='CON:'
5200   FOR Pnt=1 TO LEN(Str$)
5220     IF MID$(Str$,Pnt,1)>=CHR$(97) THEN MID$(Str$,Pnt,1)=CHR$(ASCII(MID$(Str$,Pnt,1)) AND 223)
5240   NEXT Pnt 
5260   FOR Pnt=1 TO LEN(Str$)
5280     ON INSTR(1,' <>-',MID$(Str$,Pnt,1))+1 GOSUB 5360,5460,5560,5820,6080
5300   NEXT Pnt 
5320   GOSUB 5460
5340   RETURN Error
5360   ! *
5380   ! *  No special but ascii character cound
5400   ! *
5420   File$=File$+MID$(Str$,Pnt,1)
5440   RETURN 
5460   ! *
5480   ! *  ' ' found
5500   ! *
5520   IF Termcont=0 THEN IF File$='' THEN RETURN ELSE Selfile$=File$ : RETURN 
5540   ON Termcont GOSUB 5680,5940,6180
5560   ! *
5580   ! *  '<' found. Infile descriptor
5600   ! *
5620   File$=''
5640   Termcont=1
5660   RETURN 
5680   ! *
5700   ! *  '<' termination
5720   ! *
5740   IF Infile$<>'CON:' THEN Error=3 : RETURN 
5760   Infile$=File$
5780   Termcont=0
5800   RETURN 
5820   ! *
5840   ! *  '>' found. Out file descriptor
5860   ! *
5880   File$=''
5900   Termcont=2
5920   RETURN 
5940   ! *
5960   ! *  '>' termination
5980   ! *
6000   IF Outfile$<>'CON:' THEN Error=4 : RETURN 
6020   Outfile$=File$
6040   Termcont=0
6060   RETURN 
6080   ! *
6100   ! *  '-' found. Option descriptor
6120   ! *
6140   Termcont=3
6160   RETURN 
6180   ! *
6200   ! *  '-' termination
6220   ! *
6240   Option$=Option$+File$
6260   Termcont=0
6280   RETURN 
6300 FNEND 
6310 DEF FNP
6320   FOR I=0 TO 100
6330     A=ASCII(MID$(Buffer$,I+1,1))
6340     IF A=13 THEN ; ELSE IF A<32 THEN ; '''' A ''''; ELSE ; CHR$(A);
6350   NEXT I 
6360 FNEND