10 CLEAR:CLOSE:SCREEN 0:WIDTH 80:KEY OFF:COLOR 7,1,1:CLS:DEFINT A-Z:OPTION BASE 1
20 CHECK.RESULT$="BAD":PRINT "+++ Program CODEBOOK.BAS, version 1.1 by Jim Groeneveld, 21 December 1990. +++"
25 MAX.N.OF.VARS=0:WHILE MAX.N.OF.VARS=0 ''' or max.n.of.vars<-32767 or max.n.of.vars>32767
30 PRINT "--- Enter (at least) total number of variables to reserve array space or";" enter a NEGATIVE starting number for automatic adaptation";" to the actual number in the codebook file [-100]: ";
35 INPUT"",MAX.N.OF.VARS '====== in order to reserve array space
40 IF MAX.N.OF.VARS=0 THEN MAX.N.OF.VARS=-100
50 IF MAX.N.OF.VARS<-32767 OR MAX.N.OF.VARS>32767 THEN BEEP:PRINT "*** Illegal number of variables entered! ***"
55 IF MAX.N.OF.VARS<0 THEN MAX.N.OF.VARS=-MAX.N.OF.VARS:EXTRA.VARS=MAX.N.OF.VARS:AUTO.NOV$="YES" ELSE AUTO.NOV$="NO"
204 IF FIRST.COLUMN$=CHR$(13) THEN SECOND.COLUMN$=INPUT$(1,#1):ON ERROR GOTO 0:GOTO 285 '====== (reading LF as the second character) This is an empty line (only CRLF)
206 IF FIRST.COLUMN$<>" " AND FIRST.COLUMN$<>"'" AND FIRST.COLUMN$<>CHR$(34) THEN LINE INPUT #1,COMMENT.LINE$:J=LEN(COMMENT.LINE$):GOSUB 1050:ON ERROR GOTO 0:GOTO 285 '====== this is a comment line
208 IF TOT.N.OF.VARS=>MAX.N.OF.VARS AND AUTO.NOV$="NO" THEN BEEP:PRINT "*** Number of variables exceeds maximum of";MAX.N.OF.VARS;", correct and rerun ***";STRING$(80-POS(0),32):CLOSE:STOP
210 IF TOT.N.OF.VARS=100 THEN PRINT "If running under interpreter BASIC time consuming garbage collection may occur!"
212 IF TOT.N.OF.VARS=MAX.N.OF.VARS AND AUTO.NOV$="YES" THEN GOSUB 1100 '------ increase arrays VAR.TYPE$, MISSING.VALUE$, BEGIN.COLUMN!, END.COLUMN! and VARIABLE.NAME$ by EXTRA.VARS elements and continue
214 TOT.N.OF.VARS=TOT.N.OF.VARS+1:VAR.TYPE$(TOT.N.OF.VARS)=FIRST.COLUMN$ ''''':if var.type$(tot.n.of.vars)=" " then var.type$(tot.n.of.vars)="" leads to erroneous copying to another array!!!
218 IF (TOT.N.OF.VARS MOD 10)=0 THEN PRINT "===";TOT.N.OF.VARS;"variables processed from codebook file ";CODEBOOK.COL$;STRING$(80-POS(0),32);:LOCATE ,1
220 IF CHECK.RESULT$<>"OK" THEN BEEP:PRINT "*** Error";ERROR.NUMBER;"in codebook at line";LINE.COUNT;", variable";TOT.N.OF.VARS;", program abort! ***";STRING$(80-POS(0),32):CLOSE:STOP
230 WHILE LEFT$(VARIABLE.NAME$(TOT.N.OF.VARS),1)=" ":VARIABLE.NAME$(TOT.N.OF.VARS)=MID$(VARIABLE.NAME$(TOT.N.OF.VARS),2):WEND
250 IF J<>0 AND (I>J OR I=0) THEN I=J 'else I remains I
255 IF I<>0 THEN VARIABLE.NAME$(TOT.N.OF.VARS)=LEFT$(VARIABLE.NAME$(TOT.N.OF.VARS),I-1)
260 IF VARIABLE.NAME$(TOT.N.OF.VARS)="" THEN VARIABLE.NAME$(TOT.N.OF.VARS)="Var"+MID$(STR$(TOT.N.OF.VARS),2) '====== if no variable name defined, use "Var"&VarNumber
262 IF CHECK.VAR.NAME$<>"NO" THEN GOSUB 13100 '====== optional check for identical variable names
265 IF BEGIN.COLUMN!(TOT.N.OF.VARS)<=0 OR END.COLUMN!(TOT.N.OF.VARS)<=0 THEN GOSUB 999:PRINT "*** Illegal fields for variable";TOT.N.OF.VARS;", ";VARIABLE.NAME$(TOT.N.OF.VARS);" at line";LINE.COUNT;" ***";STRING$(80-POS(0),32)
270 IF BEGIN.COLUMN!(TOT.N.OF.VARS)>END.COLUMN!(TOT.N.OF.VARS) THEN GOSUB 999:PRINT "*** Starting field > ending one for variable";TOT.N.OF.VARS;", ";VARIABLE.NAME$(TOT.N.OF.VARS);" at line";LINE.COUNT;" ***";STRING$(80-POS(0),32)
271 IF FIELD.WIDTH=0 THEN FIELD.WIDTH=END.COLUMN!(TOT.N.OF.VARS)-BEGIN.COLUMN!(TOT.N.OF.VARS)+1 '###### added in vs. 1.1 to support additional check of field width if FIELD.WIDTH not given
272 IF FIELD.WIDTH<0 OR FIELD.WIDTH>255 THEN GOSUB 999:PRINT "*** Illegal field width for variable";TOT.N.OF.VARS;", ";VARIABLE.NAME$(TOT.N.OF.VARS);" at line";LINE.COUNT;" ***";STRING$(80-POS(0),32)
275 IF FIELD.WIDTH<>END.COLUMN!(TOT.N.OF.VARS)-BEGIN.COLUMN!(TOT.N.OF.VARS)+1 AND FIELD.WIDTH<>0 THEN GOSUB 999:PRINT "*** Non-matching field width for variable";TOT.N.OF.VARS;", ";VARIABLE.NAME$(TOT.N.OF.VARS);" at line";LINE.COUNT;" ***" '#
281 IF END.COLUMN!(TOT.N.OF.VARS)>MAX.COL.SPEC! THEN MAX.COL.SPEC!=END.COLUMN!(TOT.N.OF.VARS) ELSE 285
475 GOSUB 14000:IF CHECK.RESULT$<>"OK" THEN BEEP:PRINT "*** File name error: numerical extension not permitted, used for output! ***":PRINT "*** Rename database file to a valid name and rerun......program abort ***":STOP
480 ON ERROR GOTO 11400:OPEN "I",#1,DATABASE.DAT$:ON ERROR GOTO 0:CLOSE 1
490 IF CHECK.RESULT$<>"OK" THEN BEEP:PRINT CHECK.RESULT$
500 WEND:DIM DATA.LINE$(N.OF.DATA.LINES)
501 PRINT "--- Do you want to check the database for equal record lengths? Y/[N]: ";
502 CHECK.RECORD.LENGTH$="":WHILE CHECK.RECORD.LENGTH$="":WHILE CHECK.RECORD.LENGTH$="":CHECK.RECORD.LENGTH$=INKEY$:WEND:IF INSTR("YyNn"+CHR$(13),CHECK.RECORD.LENGTH$)=0 THEN BEEP:CHECK.RECORD.LENGTH$=""
503 WEND:IF INSTR("Yy",CHECK.RECORD.LENGTH$)>0 THEN CHECK.RECORD.LENGTH$="YES" ELSE CHECK.RECORD.LENGTH$="NO"
504 PRINT CHECK.RECORD.LENGTH$
505 PRINT "=== Output files wil be called: ";DATABASE$;" with a numerical extension."
510 PRINT "--- Do you want to overwrite any already existing output file? [Y]/N: ";
512 OVERWRITE$="":WHILE OVERWRITE$="":WHILE OVERWRITE$="":OVERWRITE$=INKEY$:WEND:IF INSTR("YyNn"+CHR$(13),OVERWRITE$)=0 THEN BEEP:OVERWRITE$=""
514 WEND:IF INSTR("Yy"+CHR$(13),OVERWRITE$)>0 THEN OVERWRITE$="YES" ELSE OVERWRITE$="NO"
516 PRINT OVERWRITE$
520 PRINT "--- Choose type of output data files: BLANK or COMMA delimited or FIXED";" formatted or Report with 1..9 spaces as delimiters: B/[C]/F/1/../9: ";
522 DELIMITER$="":WHILE DELIMITER$="":WHILE DELIMITER$="":DELIMITER$=INKEY$:WEND:IF INSTR("BbCcFf"+CHR$(13),DELIMITER$)=0 AND VAL(DELIMITER$)=0 THEN BEEP:DELIMITER$=""
525 IF INSTR("Bb",DELIMITER$)>0 THEN DELIMITER$="BLANK" ELSE IF INSTR("Ff",DELIMITER$)>0 THEN DELIMITER$="FIXED" ELSE DELIMITER$="COMMA"
526 PRINT DELIMITER$:IF DEL.SPACES>0 THEN DELIMITER$="" ELSE IF DELIMITER$="BLANK" THEN DELIMITER$=" " ELSE IF DELIMITER$="FIXED" THEN DELIMITER$="" ELSE DELIMITER$=","
530 PRINT "--- Do you want a header with variable names as the first line of each output":IF DELIMITER$="" AND DEL.SPACES=0 THEN PRINT " file? Y/[N]: "; ELSE PRINT " file? [Y]/N: ";
532 HEADER$="":WHILE HEADER$="":WHILE HEADER$="":HEADER$=INKEY$:WEND:IF INSTR("YyNn"+CHR$(13),HEADER$)=0 THEN BEEP:HEADER$=""
534 WEND:IF INSTR("Yy",HEADER$)>0 OR (HEADER$=CHR$(13) AND (DELIMITER$<>"" OR DEL.SPACES>0)) THEN HEADER$="YES" ELSE HEADER$="NO"
536 PRINT HEADER$
540 MISSING$="":WHILE MISSING$=""
542 PRINT "--- Enter (missing) value to replace entirely blank fields for variables for";" which not yet specified in the codebook file [-1]: ";:LINE INPUT MISSING$
544 IF MISSING$="" THEN MISSING$="-1"
546 WEND
550 IF DELIMITER$="" THEN REM.SPACES$="NO":GOTO 560 ELSE PRINT "--- Do you want to remove insignificant spaces from the values? [Y]/N: ";
552 REM.SPACES$="":WHILE REM.SPACES$="":WHILE REM.SPACES$="":REM.SPACES$=INKEY$:WEND:IF INSTR("YyNn"+CHR$(13),REM.SPACES$)=0 THEN BEEP:REM.SPACES$=""
554 WEND:IF INSTR("Yy"+CHR$(13),REM.SPACES$)>0 THEN REM.SPACES$="YES" ELSE REM.SPACES$="NO"
556 PRINT REM.SPACES$
560 N.VARS.PER.FILE=0:N.OF.OUTPUT.FILES=0:WHILE N.VARS.PER.FILE<=0 OR N.VARS.PER.FILE>MAX.VARS.PER.FILE OR N.OF.OUTPUT.FILES>999
562 PRINT "--- Enter (max.) number of variables per output file (max.";MAX.VARS.PER.FILE;") [58]: ";:INPUT"",N.VARS.PER.FILE
564 IF N.VARS.PER.FILE=0 THEN N.VARS.PER.FILE=58
566 IF N.VARS.PER.FILE<0 OR N.VARS.PER.FILE>MAX.VARS.PER.FILE THEN BEEP:PRINT "*** Illegal number of variables entered! ***"
570 IF N.OF.OUTPUT.FILES>999 THEN BEEP:PRINT "*** Too few variables per file, needing more than 999 output files, specified,";" minimum number of variables per output file is";INT((TOT.N.OF.VARS-1)/999)+1;"***"
572 WEND
580 LINES.PER.PAGE=0:WHILE LINES.PER.PAGE<=0 AND DEL.SPACES>0
582 PRINT "--- Enter (max.) number of lines (header/records) per page [60]: ";:INPUT"",LINES.PER.PAGE
584 IF LINES.PER.PAGE=0 THEN LINES.PER.PAGE=60
586 IF LINES.PER.PAGE<1-(HEADER$="YES") OR LINES.PER.PAGE>32767 THEN BEEP:PRINT "*** Illegal number of lines per page entered! Minimum:";1-(HEADER$="YES");", maximum: 32767 ***":LINES.PER.PAGE=0
588 WEND
590 PRINT "=== Processing database ";DATABASE.DAT$;"......please wait and see......"
600 FOR OUTPUT.FILE.NUMBER=1 TO N.OF.OUTPUT.FILES
602 PRINT STRING$(40,"-");" Pass";OUTPUT.FILE.NUMBER;STRING$(5,"-");" Passes to follow:";N.OF.OUTPUT.FILES-OUTPUT.FILE.NUMBER
605 ON ERROR GOTO 11400:OPEN "I",#2,DATABASE$+"."+MID$(STR$(OUTPUT.FILE.NUMBER),2):ON ERROR GOTO 0:CLOSE 2 '====== check for existence of output file
607 IF CHECK.RESULT$="*** FILE NOT FOUND ***" THEN CHECK.RESULT$="OK":GOTO 610 ELSE IF CHECK.RESULT$<>"OK" THEN BEEP:PRINT CHECK.RESULT$:PRINT " This may not occur: program bug! Notify author! Program abort!":STOP
609 IF OVERWRITE$="NO" THEN PRINT "*** Output file ";DATABASE$+"."+MID$(STR$(OUTPUT.FILE.NUMBER),2);" already exists; skipped this pass ***":GOTO 790 '====== BAD=not existing, OK=existing
610 OPEN "O",#2,DATABASE$+"."+MID$(STR$(OUTPUT.FILE.NUMBER),2) '====== open DATABASE.nr as output file with freefield data
615 ON ERROR GOTO 11400:OPEN "I",#1,DATABASE.DAT$:ON ERROR GOTO 0
620 FIRST=OUTPUT.FILE.NUMBER*N.VARS.PER.FILE-N.VARS.PER.FILE+1:LAST=OUTPUT.FILE.NUMBER*N.VARS.PER.FILE:IF LAST>TOT.N.OF.VARS THEN LAST=TOT.N.OF.VARS
655 GOSUB 2000 '====== header with variable names if applicable
660 RECORD.COUNT#=0:MAX.LENGTH#=0:MIN.LENGTH#=-1
670 WHILE NOT EOF(1) '====== process all records in database file
675 IF DEL.SPACES>0 AND LINE.COUNT#=LINES.PER.PAGE THEN PRINT #2,CHR$(12);:GOSUB 2000 '====== header with variable names if applicable
685 IF I=>N.OF.DATA.LINES THEN J=MAX.LINE.INPUT.LENGTH:GOSUB 1050:RECORD.LENGTH#=RECORD.LENGTH#+ADD.LENGTH#:ADD.LENGTH#=0#:GOTO 700 '====== read record until EOL
690 I=I+1:LINE INPUT #1,DATA.LINE$(I):RECORD.LENGTH#=RECORD.LENGTH#+LEN(DATA.LINE$(I)) '====== read complete record by multiple LINE INPUT's until CRLF
700 WEND:IF RECORD.LENGTH#>MAX.LENGTH# THEN MAX.LENGTH#=RECORD.LENGTH#
701 IF RECORD.LENGTH#<MIN.LENGTH# OR MIN.LENGTH#<0 THEN MIN.LENGTH#=RECORD.LENGTH#
702 IF CHECK.RECORD.LENGTH$="YES" AND RECORD.COUNT#>1 AND PREVIOUS.RECORD.LENGTH#<>RECORD.LENGTH# THEN PRINT "*** Length";RECORD.LENGTH#;"of record";RECORD.COUNT#;"is unequal to length";PREVIOUS.RECORD.LENGTH#;"of record";RECORD.COUNT#-1;"***" '#
710 FOR VARIABLE.NUMBER=FIRST TO LAST:VALUE$="":FIELD.WIDTH=END.COLUMN!(VARIABLE.NUMBER)-BEGIN.COLUMN!(VARIABLE.NUMBER)+1 '====== process variables in parts of max. N.VARS.PER.FILE
720 FOR COLUMN!=BEGIN.COLUMN!(VARIABLE.NUMBER) TO END.COLUMN!(VARIABLE.NUMBER)
730 IF COLUMN!<=RECORD.LENGTH# THEN VALUE$=VALUE$+MID$(DATA.LINE$(INT((COLUMN!-1)/MAX.LINE.INPUT.LENGTH)+1),((COLUMN!-1) MOD MAX.LINE.INPUT.LENGTH)+1,1)
731 '====== IF statement to prevent 'Subscript out of range' and to prevent interpreting DATA.LINE$-elements which have not not been read, but contain characters
733 IF COLUMN!>RECORD.LENGTH# THEN VALUE$=VALUE$+" " '====== add trailing spaces after incomplete fields
735 IF COLUMN!>RECORD.LENGTH# AND COLUMN!=END.COLUMN!(VARIABLE.NUMBER) AND LEN(READ.PAST.EOL$)<=250 THEN READ.PAST.EOL$=READ.PAST.EOL$+STR$(VARIABLE.NUMBER) '====== remember variable number(s) read past EOL
740 NEXT COLUMN!:IF VALUE$<>STRING$(LEN(VALUE$)," ") THEN 743 '###### '744' changed into '743' in vs. 1.1 to solve bug in vs. 1.0 concerning EXTRA.SPACE$
742 IF MISSING.VALUE$(VARIABLE.NUMBER)<>"" THEN VALUE$=MISSING.VALUE$(VARIABLE.NUMBER) ELSE IF MISSING$<>"" THEN VALUE$=MISSING$ '=== replace entirely blank fields by the value MISSING(.VALUE)$
743 EXTRA.SPACE$=""
744 IF DELIMITER$="" THEN IF LEN(VALUE$)<FIELD.WIDTH+DEL.SPACES THEN EXTRA.SPACE$=STRING$(FIELD.WIDTH+DEL.SPACES-LEN(VALUE$),32) ELSE IF LEN(VALUE$)>FIELD.WIDTH+DEL.SPACES THEN VALUE$=RIGHT$(VALUE$,FIELD.WIDTH+DEL.SPACES)
750 GOSUB 3000:GOSUB 13000:GOSUB 1011:PRINT #2,EXTRA.SPACE$;VALUE$;:GOSUB 1011 '====== remove leading and trailing spaces or enclose value within quotes and double embedded quotes, and write (un)formatted literal value to the output file
755 IF VARIABLE.NUMBER<LAST THEN PRINT #2,DELIMITER$; '====== DELIMITER$ is empty ("") with FIXED format and Report output
760 NEXT VARIABLE.NUMBER:LINE.COUNT#=LINE.COUNT#+1#:PRINT #2, '====== eol
765 IF CHECK.RECORD.LENGTH$="YES" AND READ.PAST.EOL$<>"" THEN PRINT "*** Record";RECORD.COUNT#;"read past end-of-line for variable number(s):";READ.PAST.EOL$;" ***";STRING$(80-POS(0),32)
770 WEND:CLOSE 2:CLOSE 1
780 PRINT "===";LAST-FIRST+1;"variables";FIRST;"to";LAST;"for";RECORD.COUNT#;"records processed into file ";DATABASE$+"."+MID$(STR$(OUTPUT.FILE.NUMBER),2);STRING$(80-POS(0),32)
785 PRINT "=== Minimum record length was";MIN.LENGTH#;" / Maximum record length was";MAX.LENGTH#
790 NEXT OUTPUT.FILE.NUMBER
800 PRINT "=== End of program CODEBOOK === Rerun? [Y]/N: ";:COMMENT$=INPUT$(1):IF INSTR("Yy"+CHR$(13),COMMENT$) THEN RUN ELSE KEY ON:END '====== routines follow
999 CHECK.FIELD.WIDTH$="BAD":RETURN
1011 IF VAR.TYPE$(VARIABLE.NUMBER)<>" " AND DELIMITER$<>"" THEN PRINT #2,VAR.TYPE$(VARIABLE.NUMBER);:RETURN
1050 ADD.LENGTH#=0#:WHILE J=MAX.LINE.INPUT.LENGTH:LINE INPUT #1,COMMENT.LINE$:J=LEN(COMMENT.LINE$):ADD.LENGTH#=ADD.LENGTH#+J:WEND:RETURN '====== read line until length NE 255: CRLF encountered
1100 REM ====== Adapt maximum number of variables to actual one (from codebook file) by adjusting dimensions of BEGIN.COLUMN!, END.COLUMN! and VARIABLE.NAME$ increasing them by EXTRA.VARS after temporaryly saving their contents to SHADOW! and SHADOW$
1101 IF EXTRA.VARS=MAX.N.OF.VARS THEN PRINT "!!! If running under interpreter BASIC auto-adaptation may be time consuming!"
1103 PRINT "=== Automatic adaptation to more than";MAX.N.OF.VARS;"variables in progress......";STRING$(80-POS(0),32);:LOCATE ,1
1110 IF MAX.N.OF.VARS=32767 THEN BEEP:PRINT "*** Number of variables exceeds maximum of";MAX.N.OF.VARS;", correct and rerun ***";STRING$(80-POS(0),32):CLOSE:STOP
1115 I!=MAX.N.OF.VARS+EXTRA.VARS:IF I!>32767 THEN I!=32767 '====== define increasing maximum number of variables (compromise between speed and memory space)
1120 DIM SHADOW!(MAX.N.OF.VARS),SHADOW$(MAX.N.OF.VARS):FOR J=1 TO MAX.N.OF.VARS:SHADOW!(J)=BEGIN.COLUMN!(J):SHADOW$(J)=VAR.TYPE$(J)+VARIABLE.NAME$(J):NEXT J
1130 ERASE BEGIN.COLUMN!,VARIABLE.NAME$,VAR.TYPE$:DIM BEGIN.COLUMN!(I!),VARIABLE.NAME$(I!),VAR.TYPE$(I!):FOR J=1 TO MAX.N.OF.VARS:BEGIN.COLUMN!(J)=SHADOW!(J):VAR.TYPE$(J)=LEFT$(SHADOW$(J),1):VARIABLE.NAME$(J)=MID$(SHADOW$(J),2):NEXT J
1150 FOR J=1 TO MAX.N.OF.VARS:SHADOW!(J)=END.COLUMN!(J):SHADOW$(J)=MISSING.VALUE$(J):NEXT J:ERASE END.COLUMN!,MISSING.VALUE$:DIM END.COLUMN!(I!),MISSING.VALUE$(I!)
1160 FOR J=1 TO MAX.N.OF.VARS:END.COLUMN!(J)=SHADOW!(J):MISSING.VALUE$(J)=SHADOW$(J):NEXT J:ERASE SHADOW!,SHADOW$:MAX.N.OF.VARS=I!:RETURN '===================================
2000 REM ========== Header with variable names if applicable ==========
2010 LINE.COUNT#=0#:IF HEADER$="NO" THEN 2060
2020 FOR VARIABLE.NUMBER=FIRST TO LAST:VAR.NAME$=VARIABLE.NAME$(VARIABLE.NUMBER):FIELD.WIDTH=END.COLUMN!(VARIABLE.NUMBER)-BEGIN.COLUMN!(VARIABLE.NUMBER)+1:EXTRA.SPACE$=""
2030 IF DELIMITER$="" THEN IF LEN(VAR.NAME$)<FIELD.WIDTH+DEL.SPACES THEN EXTRA.SPACE$=STRING$(FIELD.WIDTH+DEL.SPACES-LEN(VAR.NAME$),32) ELSE IF LEN(VAR.NAME$)>FIELD.WIDTH+DEL.SPACES THEN VAR.NAME$=RIGHT$(VAR.NAME$,FIELD.WIDTH+DEL.SPACES)
2040 PRINT #2,EXTRA.SPACE$;VAR.NAME$;:IF VARIABLE.NUMBER<LAST THEN PRINT #2,DELIMITER$; '====== write variable names on the same line separated by spaces or commas to the deduced data file for STATGRAPHICS
2050 NEXT VARIABLE.NUMBER:LINE.COUNT#=LINE.COUNT#+1#:PRINT #2, '====== eol
2060 RETURN
3000 REM ========== double embedded single or double quotes within quoted string values ==========
3010 IF VAR.TYPE$(VARIABLE.NUMBER)=" " OR DELIMITER$="" THEN 3060 'return
3020 I=INSTR(VALUE$,VAR.TYPE$(VARIABLE.NUMBER)):IF I=0 THEN 3060 'return
3030 WHILE I>0 AND I<255:IF LEN(VALUE$)=255 THEN VALUE$=LEFT$(VALUE$,254) '====== if VALUE$ has maximum length delete last character to make room for extra quote
10000 REM ********** Remove leading and trailing spaces from file name *********
10010 WHILE LEFT$(D.PATH.FILENAME.EXT$,1)=" ":D.PATH.FILENAME.EXT$=MID$(D.PATH.FILENAME.EXT$,2):WEND
10020 WHILE RIGHT$(D.PATH.FILENAME.EXT$,1)=" ":D.PATH.FILENAME.EXT$=LEFT$(D.PATH.FILENAME.EXT$,LEN(D.PATH.FILENAME.EXT$)-1):WEND
10030 RETURN
11000 REM ********** check drv:path\file names ********** (result in CHECK.RESULT$)
11010 GOSUB 10000:CHECK.RESULT$="OK"
11020 U=INSTR(D.PATH.FILENAME.EXT$,":"):IF U=1 OR U>2 THEN CHECK.RESULT$="*** ILLEGALLY PLACED ':' ***":RETURN
11030 D$="":IF U=2 THEN W=ASC(LEFT$(D.PATH.FILENAME.EXT$,1)):IF W>96 AND W<123 THEN W=W-32:D$=CHR$(W)+":" ELSE IF W>64 AND W<91 THEN D$=CHR$(W)+":" ELSE CHECK.RESULT$="*** ILLEGAL DRIVE NAME ***":RETURN
11040 PATH$="":PATH.FILENAME.EXT$=MID$(D.PATH.FILENAME.EXT$,U+1):U=INSTR(PATH.FILENAME.EXT$,"\"):IF U=1 THEN PATH$="\":PATH.FILENAME.EXT$=MID$(PATH.FILENAME.EXT$,2)
11050 U=INSTR(PATH.FILENAME.EXT$,"\"):IF U=0 THEN FILENAME.EXT$=PATH.FILENAME.EXT$:WILDCARD$="YES":GOSUB 11110:WILDCARD$="NO":IF CHECK.RESULT$<>"OK" THEN RETURN ELSE D.PATH.FILENAME.EXT$=D$+PATH$+FILENAME.EXT$:D.PATH.FILENAME$=D$+PATH$+FILENAME$:RETURN
11060 PATHNAME.EXT$=LEFT$(PATH.FILENAME.EXT$,U-1):IF PATHNAME.EXT$<>"." AND PATHNAME.EXT$<>".." THEN FILENAME.EXT$=PATHNAME.EXT$:GOSUB 11110:IF CHECK.RESULT$<>"OK" THEN RETURN ELSE PATHNAME.EXT$=FILENAME.EXT$
11070 PATH$=PATH$+PATHNAME.EXT$+"\":PATH.FILENAME.EXT$=MID$(PATH.FILENAME.EXT$,U+1):GOTO 11050 '====== repeat check for every subdirectory name
11110 REM ********** check file names ********** (result in CHECK.RESULT$)
11120 CHECK.RESULT$="OK":IF LEN(FILENAME.EXT$)=0 THEN CHECK.RESULT$="*** ZERO LENGTH PATH/FILENAME ***":RETURN
11125 CHECK.RESULT$="OK":IF LEN(FILENAME.EXT$)>12 THEN CHECK.RESULT$="*** TOO LONG PATH/FILENAME ***":RETURN
11130 V=INSTR(FILENAME.EXT$,"."):IF V=0 AND LEN(FILENAME.EXT$)>8 THEN CHECK.RESULT$="*** PATH/FILENAME TOO LONG ***":RETURN
11133 IF V=0 THEN EXPL.PERIOD$="NO" ELSE EXPL.PERIOD$="YES"
11140 IF V>0 AND INSTR(V+1,FILENAME.EXT$,".")>0 THEN CHECK.RESULT$="*** TOO MANY PERIODS IN PATH/FILENAME ***":RETURN
11150 IF V>9 OR V=1 THEN CHECK.RESULT$="*** ILLEGALLY PLACED '.' IN PATH/FILENAME ***":RETURN
11160 IF V>0 AND (LEN(FILENAME.EXT$)-V)>3 THEN CHECK.RESULT$="*** TOO LONG EXTENSION IN PATH/FILENAME ***":RETURN
11170 IF INSTR(FILENAME.EXT$,"\")>0 THEN CHECK.RESULT$="*** ILLEGAL '\' IN PATH/FILENAME ***":RETURN
11180 IF INSTR(FILENAME.EXT$,"+")>0 THEN CHECK.RESULT$="*** ILLEGAL '+' IN PATH/FILENAME ***":RETURN
11190 IF INSTR(FILENAME.EXT$,"=")>0 THEN CHECK.RESULT$="*** ILLEGAL '=' IN PATH/FILENAME ***":RETURN
11200 IF INSTR(FILENAME.EXT$,"[")>0 THEN CHECK.RESULT$="*** ILLEGAL '[' IN PATH/FILENAME ***":RETURN
11210 IF INSTR(FILENAME.EXT$,"]")>0 THEN CHECK.RESULT$="*** ILLEGAL ']' IN PATH/FILENAME ***":RETURN
11220 IF INSTR(FILENAME.EXT$,":")>0 THEN CHECK.RESULT$="*** ILLEGAL ':' IN PATH/FILENAME ***":RETURN
11230 IF INSTR(FILENAME.EXT$,";")>0 THEN CHECK.RESULT$="*** ILLEGAL ';' IN PATH/FILENAME ***":RETURN
11240 IF INSTR(FILENAME.EXT$,CHR$(34))>0 THEN CHECK.RESULT$="*** ILLEGAL '"+CHR$(34)+"' IN PATH/FILENAME ***":RETURN
11250 IF INSTR(FILENAME.EXT$,"/")>0 THEN CHECK.RESULT$="*** ILLEGAL '/' IN PATH/FILENAME ***":RETURN
11260 IF INSTR(FILENAME.EXT$,",")>0 THEN CHECK.RESULT$="*** ILLEGAL ',' IN PATH/FILENAME ***":RETURN
11270 IF INSTR(FILENAME.EXT$,"|")>0 THEN CHECK.RESULT$="*** ILLEGAL '|' IN PATH/FILENAME ***":RETURN
11280 IF INSTR(FILENAME.EXT$,"<")>0 THEN CHECK.RESULT$="*** ILLEGAL '<' IN PATH/FILENAME ***":RETURN
11290 IF INSTR(FILENAME.EXT$,">")>0 THEN CHECK.RESULT$="*** ILLEGAL '>' IN PATH/FILENAME ***":RETURN
11292 IF INSTR(FILENAME.EXT$,"*")>0 AND WILDCARD$="NO" THEN CHECK.RESULT$="*** ILLEGAL '*' IN PATH/FILENAME ***":RETURN
11294 IF INSTR(FILENAME.EXT$,"?")>0 AND WILDCARD$="NO" THEN CHECK.RESULT$="*** ILLEGAL '?' IN PATH/FILENAME ***":RETURN
11300 FOR W = 1 TO LEN(FILENAME.EXT$):V = ASC(MID$(FILENAME.EXT$,W,1)):IF V > 96 AND V < 123 THEN V=V-32:MID$(FILENAME.EXT$,W,1)=CHR$(V) '====== change lower case to upper case
11310 IF V <= 32 THEN CHECK.RESULT$="*** ILLEGAL SPACE OR CONTROL CHARACTER IN PATH/FILENAME ***":W = LEN(FILENAME.EXT$)
