REM CREATE.BAS * PROGRAM TO CREATE DATA FILES (STRINGS) REM * 2330 REM 06 29 83 * J.BUTLER REM SYSTEM CONTROL PROGRAM NUMBER : REM COMMONS GO HERE COMMON CLEAR$,NAME$,LINE$,DEMO$,CRSR$,EOL$,DATE$,ID$,SCRPARA,EOS$ COMMON ROWOFF,COLOFF,DIO REM DIMENSIONS GO HERE DIM MONTHS$(12),CA$(10),CA(10),S(35) DIO=0DB00H FOR X=1 TO 33:READ S(X):POKE DIO-1+X,S(X):NEXT X REV$="052983" BLANK$="........................................................":ERR=1 IF END #1 THEN 9992 OPEN "SCREEN.FIL" RECL 18 AS 1 1 REM OPEN ANY MORE FILES HERE REM ** GET SCREEN PARAMETERS FROM SCREEN.FIL ** READ #1,1;A$,B$,C$ CLEAR$=CHR$(VAL(A$))+CHR$(VAL(B$)) READ #1,2;A$,B$,C$ CRSR$=CHR$(VAL(A$))+CHR$(VAL(B$)) READ #1,3;A$,B$,C$ EOS$=CHR$(VAL(A$))+CHR$(VAL(B$)) READ #1,4;A$,B$,C$ EOL$=CHR$(VAL(A$))+CHR$(VAL(B$)) READ #1,5;A$,B$,C$ CLRFORE$=CHR$(VAL(A$))+CHR$(VAL(B$)) READ #1,6;A$,B$,C$ CLRBACK$=CHR$(VAL(A$))+CHR$(VAL(B$)) READ #1,7;A$,B$,C$ HIGH$=CHR$(VAL(A$))+CHR$(VAL(B$)) READ #1,8;A$,B$,C$ LOW$=CHR$(VAL(A$))+CHR$(VAL(B$)) READ #1,9;A$,B$,C$ HOME$=CHR$(VAL(A$))+CHR$(VAL(B$)) READ #1,13;A$,B$,C$ ROWOFF=VAL(A$):COLOFF=VAL(B$):SCRPARA=VAL(C$) CLOSE 1 REM MASK INITIALIZATION GOES HERE 6 REM PASSWORD ROUTINE GOES HERE 7 NAME$="Creative Data":LINE$="*************":GOTO 11 8 REM VERTICAL CURSOR POSITIONING ROUTINE FOR ZZ=1 TO VV:PRINT:NEXT ZZ:RETURN 9 REM DATE FORMATTING ROUTINE DATE$=MID$(P$,1,2)+"-"+MID$(P$,3,2)+"-"+MID$(P$,5,2) RETURN 10 REM CURSOR ADDRESS IF SCRPARA=1 THEN \ PRINT CRSR$;CHR$(ROW+ROWOFF);CHR$(COLUMN+COLOFF);:RETURN PRINT CRSR$;CHR$(COLUMN+COLOFF);CHR$(ROW+ROWOFF);:RETURN 11 REM LENGTHS OF EACH FIELD CA(1)=12:CA(2)=1:CA(3)=4:CA(4)=2:CA(5)=4:CA(6)=1:CA(7)=1 15 REM COMPANY INFO HERE NUM=7:GOSUB 2000:PRINT TAB(22);"PROGRAM TO CREATE CBASIC DATA FILES" ROW=7:COLUMN=1:GOSUB 10:PRINT:REM 46+ PRINT TAB(13);" 1. NAME OF FILE TO CREATE : " PRINT TAB(13);" 2. DISK WHERE IT RESIDES : " PRINT TAB(13);" 3. LENGTH OF EACH RECORD : " PRINT TAB(13);" 4. NUMBER OF FIELDS : " PRINT TAB(13);" 5. NUMBER OF RECORDS : " PRINT TAB(13);" 6. 'S'TRING OR 'V'ARIABLE : " PRINT TAB(13);" 7. 'C'OMMA OR 'S'PACE DELIMITER: ":PRINT PRINT TAB(9);"For Record Length : Use the formula X * 16." PRINT TAB(9);"e.g.: 016 032 048 064 080 096 112 128 144 160" PRINT TAB(9);" 176 192 208 224 240 256 272 288 304 320" PRINT TAB(9);" 336 352 368 384 400 416 432 448 464 480" IF SECOND=1 THEN SECOND=0:RETURN 20 PRINT HIGH$ 25 PRINT CLRFORE$:GOSUB 60 30 PRINT LOW$;:COLUMN=11:ROW=21:GOSUB 10 PRINT "IS THIS DATA CORRECT :";:Y%=CONCHAR%:GOSUB 10:PRINT EOL$; IF Y%=13 OR Y%=89 THEN 2001 IF Y%=5EH THEN 9990 40 REM ERROR CHECKING STATEMENT HERE GOSUB 8802:RECUR$="":COLUMN=11:ROW=21:GOSUB 10 PRINT EOL$;"'S'TOP, 'D'ELETE, 'R'ECUR @, FIELD # :"; INPUT "";LINE CHANGE$ IF LEFT$(CHANGE$,1)="S" THEN GOSUB 2001:GOTO 9990 IF CHANGE$="" THEN 15 IF CHANGE$="D" THEN 8900 IF MID$(CHANGE$,1,1)="R" THEN RECUR$="R": \ CHANGE$=MID$(CHANGE$,2,LEN(CHANGE$)-1) IF VAL(CHANGE$)=0 THEN 15 50 IF VAL(CHANGE$)<1 OR VAL(CHANGE$)>NUM THEN 40 GOSUB 7010 IF RECUR$="R" AND VAL(CHANGE$)<=NUM THEN \ CHANGE$=STR$(VAL(CHANGE$)+1):GOTO 50 SECOND=1:GOSUB 15:GOTO 25 60 REM SCREEN PRINT HERE COLUMN=46 FOR X=1 TO NUM ROW=7+X:GOSUB 10 IF CA$(X)<>"" THEN PRINT CA$(X) ELSE PRINT LEFT$(BLANK$,CA(X)) NEXT X RETURN 1000 IF END #1 THEN 6000 1001 READ #1,REC1;CA$(1),CA$(2),CA$(3),CA$(4),CA$(5) RETURN 2000 PRINT CLEAR$:PRINT TAB(40-LEN(NAME$)/2);NAME$ PRINT TAB(40-LEN(LINE$)/2);LINE$:PRINT:RETURN 2001 A%=(241-SIZE(CA$(2)+":*.*"))*1024:B%=(VAL(CA$(3))+2)*VAL(CA$(5)) IF B%>A% THEN 6000 IF END #1 THEN 6100 CREATE CA$(2)+":"+CA$(1) RECL VAL(CA$(3)) AS 1 GOSUB 2000:VV=8:GOSUB 8 PRINT TAB(21);"NOW CREATING YOUR FILE ";CA$(2);":";CA$(1);" "; 2002 B$="" IF CA$(6)="S" THEN B2$=CHR$(34)+""+CHR$(34) ELSE B2$="0" IF CA$(7)="C" THEN B3$="," ELSE B3$=" " FOR X=1 TO VAL(CA$(4)) B$=B$+B2$+B3$ NEXT X B$=LEFT$(B$,LEN(B$)-1) IF LEN(B$)+2>VAL(CA$(3)) THEN 6200 FOR Y=1 TO VAL(CA$(5)) PRINT USING "&";#1,Y;B$ NEXT Y FOR X=1 TO NUM:CA$(X)="":NEXT X CLOSE 1:GOTO 15 6000 COLUMN=2:ROW=21:GOSUB 10 PRINT EOL$;"NOT ENOUGH DISK SPACE FOR ";CA$(2);":";CA$(1);CHR$(7); FOR X=1 TO 200:NEXT X GOSUB 10:PRINT EOL$:GOTO 15 6100 COLUMN=2:ROW=21:GOSUB 10 PRINT EOL$;"NOT ENOUGH DIRECTORY SPACE FOR ";CA$(2);":";CA$(1);CHR$(7); FOR X=1 TO 200:NEXT X GOSUB 10:PRINT EOL$:GOTO 15 6200 COLUMN=2:ROW=21:GOSUB 10 PRINT EOL$;"RECORD LENGTH OF";CA$(3);" IS TOO SMALL FOR";CA$(4); PRINT " FIELDS ";CHR$(7); FOR X=1 TO 200:NEXT X DELETE 1:GOSUB 10:PRINT EOL$:GOTO 15 7010 REM SCREEN INPUT FUNCTIONS HERE Y$="":HOLDIT$=CA$(VAL(CHANGE$)):Y=1 COLUMN=46:ROW=7+VAL(CHANGE$):GOSUB 10 PRINT LEFT$(BLANK$,CA(VAL(CHANGE$))):GOSUB 10 7015 POKE DIO,0:CALL DIO+1 CHR%=PEEK(DIO) AND 127 IF CHR%=0 THEN 7015 IF CHR%=8 AND LEN(Y$)<1 THEN 7015 IF CHR%=27 THEN RECUR$="":RETURN IF CHR%=24 THEN 7010 IF CHR%=13 THEN 7020 IF CHR%=8 THEN Y$=LEFT$(Y$,LEN(Y$)-1):Y=Y-1:PRINT CHR$(8);" ";CHR$(8); IF CHR%<32 OR CHR%>122 THEN 7015 IF Y>CA(VAL(CHANGE$)) THEN PRINT CHR$(7);:GOTO 7015 PRINT CHR$(CHR%);:Y$=Y$+CHR$(CHR%):Y=Y+1:GOTO 7015 7018 CA$(VAL(CHANGE$))=HOLDIT$:RETURN 7020 ON VAL(CHANGE$) GOTO 7021,7022,7023,7024,7025,7026,7027 7021 IF MATCH(".",Y$,1)=0 THEN PRINT CHR$(7);:GOTO 7010 GOTO 7120 7022 Z=ASC(Y$)-64 IF Z<1 OR Z>2 THEN PRINT CHR$(7);:GOTO 7010 GOTO 7120 7023 Z=VAL(Y$) IF Z<1 OR Z>1024 THEN PRINT CHR$(7);:GOTO 7010 GOTO 7120 7024 Z=VAL(Y$) IF Z<1 OR Z>99 THEN PRINT CHR$(7);:GOTO 7010 GOTO 7120 7025 Z=VAL(Y$) IF Z<1 OR Z>5000 THEN PRINT CHR$(7);:GOTO 7010 GOTO 7120 7026 Z=ASC(Y$) IF Z<>86 AND Z<>83 THEN PRINT CHR$(7);:GOTO 7010 GOTO 7120 7027 Z=ASC(Y$) IF Z<>83 AND Z<>67 THEN PRINT CHR$(7);:GOTO 7010 GOTO 7120 7120 IF Y$=" " THEN CA$(VAL(CHANGE$))="":RETURN IF Y$<>"" THEN CA$(VAL(CHANGE$))=Y$ ELSE CA$(VAL(CHANGE$))=HOLDIT$ ROW=21:RETURN 8802 ROW=ROW-1:GOSUB 10:PRINT EOS$:RETURN 8900 REM DELETE RECORD FUNCTION HERE FOR X=1 TO 5:CA$(X)="":NEXT X GOTO 15 9000 REM DIRECT CONSOLE I/O DB DATA 0,229,213,197,245,30,255,14,6,205,5,0,183,202,5,219,50,0 DATA 219,241,193,209,225,201,0,14,2,30,8,205,5,0,201 REM DB 9990 PRINT LOW$;CLEAR$:STOP 9992 FOR X=1 TO 24:PRINT:NEXT X PRINT TAB(20);"ACCESS NOT PERMITTED! SEE YOUR SYSTEM SUPERVISOR..";ERR; Y%=CONCHAR% IF Y%=5EH THEN 9999 GOTO 9992 9999 PRINT LOW$;CLEAR$ STOP