home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Oakland CPM Archive
/
oakcpm.iso
/
cpmug
/
cpmug006.ark
/
MAINT.BAS
< prev
next >
Wrap
BASIC Source File
|
1984-04-29
|
8KB
|
340 lines
REM CACHE MAILING LIST MAINTENANCE PROGRAM
PRINT "MAINT VERSION 1.3"
FILE.NAME$="CACHE.FIL"
FILE.SIZE = 512
REC.LENG = 128
KB = 1 :REM KEYBOARD INPUT
ABORT = 255 :REM KB VALUE TO ABORT
FIELD.COUNT = 10 :REM # FIELDS IN RECORD
FILE FILE.NAME$(REC.LENG)
DIM FIELD.NAME$(FIELD.COUNT)
DIM RECORD$(FIELD.COUNT)
DIM MAC.COMD$(11)
REM READ FIELD NAMES
DATA SORT,NAME,ORG,STREET,CITY,ZIP,\
PHONE,COMPUTER,PAID,TYPE
FOR I = 1 TO FIELD.COUNT
READ FIELD.NAME$(I)
NEXT I
REM MAIN PROCESSING LOOP
100 IF INP(KB) = ABORT THEN MAC.COUNT = 0
IF MAC.COUNT > 0 THEN 8100
INPUT "COMMAND--->";C$
IF C$="MACRO" THEN 8000
110 IF C$="HELP" THEN 200
IF LEFT$(C$,5)="FIND " THEN 1000
IF LEFT$(C$,5)="READ " THEN 1100
IF LEFT$(C$,5)="DUMP " THEN 1200
IF LEFT$(C$,2)="C " THEN 1300
IF C$="LIST" THEN 1400
IF LEFT$(C$,2)="? " THEN 1500
IF LEFT$(C$,2)="F "THEN 1600
IF C$="WRITE" THEN 1700
IF C$="ADD" THEN 1800
IF C$="ERASE" THEN 1900
IF C$="UPDATE" THEN GOSUB 9100:GOTO 100
IF C$="FREE" THEN PRINT FRE:GOTO 100
IF LEFT$(C$,6)="PURGE " THEN 9200
IF C$="END" THEN 9999
199 PRINT "INVALID COMMAND ";C$
MAC.COUNT = 0
GOTO 100
REM GIVE HELP
200 PRINT "SUBSTITUTE PROPER VALUES ";\
"FOR THOSE IN PARENTHESES."
PRINT
PRINT "FIND (NAME) SEE NOTE 1"
PRINT "READ (REC #)"
PRINT "DUMP (REC #) SEE NOTE 1"
PRINT "C (FIELD NAME) (VALUE) CHANGE"
PRINT "LIST"
PRINT "? (FIELD NAME) (VALUE) SEE NOTE 2"
PRINT "F (FIELD NAME) (VALUE) SEE NOTE 3"
PRINT "WRITE RANDOMIZE AND WRITE"
PRINT" (USE AFTER ADD)"
PRINT "ADD ADD A NEW RECORD"
PRINT "ERASE ERASES CURRENT RECORD"
PRINT "FREE HOW MUCH SPACE FREE IN MEM"
PRINT "UPDATE REWRITES CURRENT RECORD"
PRINT "PURGE YYDD PURGE FILE FOR A MONTH"
PRINT "END END OF PROGRAM"
PRINT
PRINT "NOTE 1: PRESS DEL TO STOP"
PRINT "NOTE 2: ? MATCHES STARTING IN COL. 1"
PRINT "NOTE 3: F SCANS ENTIRE FIELD"
PRINT
GOTO 100
REM FIND RECORD
1000 KEY$=MID$(C$,6,99)
GOSUB 8700
IF FLAG = 0 THEN\
PRINT "NO RECORD FOUND" :\
GOTO 100
GOSUB 9000
GOTO 100
REM READ BY RECORD NUMBER
1100 KEY=VAL(MID$(C$,6,99))
IF KEY < 1 OR KEY > 512 THEN \
PRINT "INVALID KEY":GOTO 100
GOSUB 8800
IF FLAG = 1 THEN\
GOSUB 9000
GOTO 100
REM DUMP FILE
1200 KEY=VAL(MID$(C$,6,99))
IF KEY<1 OR KEY>FILE.SIZE THEN \
PRINT "INVALID KEY":\
GOTO 100
1210 GOSUB 8800
IF FLAG = 1 THEN GOSUB 9000
IF INP(KB)=ABORT THEN 100
KEY = KEY + 1
IF KEY >FILE.SIZE THEN \
KEY = 1 :\
MAC.COUNT = 0
GOTO 1210
REM SCAN FILE FOR MATCHING FIELD
1300 GOSUB 8910
PRINT "FIELD WAS: ";RECORD$(FIELD.NO)
IF LEFT$(FIELD.VALUE$,1)="/" THEN 1320
RECORD$(FIELD.NO)=FIELD.VALUE$
1310 GOSUB 9000
GOTO 100
REM FIELD CHANGE BY CHAR SUBSTITUTION
1320 IF RIGHT$(FIELD.VALUE$,1)="/" THEN \
FIELD.VALUE$ = LEFT$(FIELD.VALUE$,\
LEN(FIELD.VALUE$)-1)
FIELD.VALUE$=MID$(FIELD.VALUE$,2,99)
FOR I=LEN(FIELD.VALUE$) TO 1 STEP -1
IF MID$(FIELD.VALUE$,I,1)="/" THEN \
FROM$=LEFT$(FIELD.VALUE$,I-1):\
TO$=MID$(FIELD.VALUE$,I+1,99)
NEXT I
TEMP$=RECORD$(FIELD.NO)
FOR I=1 TO LEN(TEMP$)-LEN(FROM$)+1
IF MID$(TEMP$,I,LEN(FROM$))=FROM$ THEN 1330
NEXT I
PRINT "NOT FOUND"
GOTO 100
1330 RECORD$(FIELD.NO)=""
IF I=1 THEN 1340
RECORD$(FIELD.NO)=LEFT$(TEMP$,I-1)
1340 RECORD$(FIELD.NO)=RECORD$(FIELD.NO)+TO$+\
MID$(TEMP$,I+LEN(FROM$),99)
GOTO 1310
REM PRINT RECORD
1400 IF FLAG = 0 THEN\
PRINT "NO RECORD":\
GOTO 100
GOSUB 9000
GOTO 100
REM SCAN FILE FOR VALUE
1500 FIND.FLAG = 0
1505 GOSUB 8910 :REM GET NO. ,VALUE
PRINT "SCANNING FROM ";\
KEY;"FOR ";FIELD$;\
"=";FIELD.VALUE$
NUMBER.SCANNED = 0
LENGTH = LEN(FIELD.VALUE$)
1510 NUMBER.SCANNED = NUMBER.SCANNED + 1
IF NUMBER.SCANNED = FILE.SIZE THEN\
PRINT "NOT FOUND":\
GOTO 100
IF INP(KB)=ABORT THEN 100
KEY=KEY+1
IF KEY>FILE.SIZE THEN\
KEY=1:\
MAC.COUNT = 0
GOSUB 8800
IF FLAG = 0 THEN 1510
PRINT KEY,RECORD$(FIELD.NO)
IF FIND.FLAG = 1 THEN 1550
IF LEFT$(RECORD$(FIELD.NO),LENGTH)\
=FIELD.VALUE$ THEN\
GOSUB 9000:\
GOTO 100
GOTO 1510
REM SCAN THE FIELD FOR THE VALUE
1550 TEMP$=RECORD$(FIELD.NO)
IF LENGTH > LEN(TEMP$) THEN 1510
FOR I=1 TO 1+LEN(TEMP$)-LENGTH
IF MID$(TEMP$,I,LENGTH)\
=FIELD.VALUE$ THEN\
GOSUB 9000:\
GOTO 100
NEXT I
GOTO 1510
REM FIND VALUE IN FILE FOR PARTICULAR FIELD
1600 FIND.FLAG = 1
GOTO 1505
REM RANDOMLY WRITE A RECORD
1700 KEY$=RECORD$(2)
GOSUB 8900 :REM CALCULATE KEY
1710 PRINT KEY
READ #1,KEY;FLAG
IF FLAG = 0 THEN\
GOSUB 9100:\
GOTO 100
KEY = KEY + 1
IF KEY > FILE.SIZE THEN \
KEY = 1 :\
MAC.COUNT = 0
IF INP(KB) = ABORT THEN 100
GOTO 1710
REM INPUT A NEW RECORD (ADD)
1800 FOR I=1 TO FIELD.COUNT
PRINT FIELD.NAME$(I);" ";
INPUT RECORD$(I)
IF RECORD$(I)="QUIT" THEN 100
NEXT I
GOSUB 9000
GOTO 100
REM ERASE A RECORD
1900 IF KEY < 1 OR KEY > FILE.SIZE THEN 199
PRINT #1,KEY;0,RECORD$(2)
PRINT "DELETED"
GOTO 100
REM INIT MACRO PROCESSING
8000 INPUT "NUMBER OF TIMES TO REPEAT";MAC.COUNT
FOR I=1 TO 10
INPUT "MACRO COMMAND";MAC.COMD$(I)
IF MAC.COMD$(I)="END" THEN 8010
NEXT I
MAC.COMD$(11)="END"
8010 INPUT "OK TO START";ANS$
IF LEFT$(ANS$,1)="Y" THEN \
MAC.NO = 1 :\
GOTO 100
8020 MAC.COUNT = 0
PRINT "MACRO ABORTED"
GOTO 100
REM MACRO COMMANDS
8100 C$=MAC.COMD$(MAC.NO)
MAC.NO = MAC.NO + 1
IF C$<>"END" THEN \
GOTO 110
MAC.COUNT = MAC.COUNT -1
IF MAC.COUNT = 0 THEN 8020
MAC.NO = 1
GOTO 8100
REM READ RECORD K$
8700 GOSUB 8900 :REM CALCULATE KEY
TRIES = 0 :REM ALLOW UP TO 100 TRIES
8710 GOSUB 8800
IF FLAG = 1 AND KEY$=NAME$ THEN RETURN
IF FLAG =1 THEN PRINT KEY;NAME$
TRIES = TRIES + 1
IF INP(KB)=ABORT THEN 8750
KEY = KEY + 1
IF KEY > FILE.SIZE THEN \
KEY = 1
IF TRIES < 100 THEN 8710
REM CAN'T FIND RECORD
8750 FLAG = 0 :REM SHOW NOT FOUND
RETURN
REM PHYSICAL READ RECORD # IN KEY
8800 READ #1,KEY;FLAG
IF FLAG=0 THEN RETURN
READ #1,KEY;\
FLAG,\
RECORD$(1),\
RECORD$(2),\
RECORD$(3),\
RECORD$(4),\
RECORD$(5),\
RECORD$(6),\
RECORD$(7),\
RECORD$(8),\
RECORD$(9),\
RECORD$(10)
REM SET VARIABLE NAMES FROM RECORD$(N)
8850 SORT$=RECORD$(1)
NAME$=RECORD$(2)
ORG$=RECORD$(3)
STREET$=RECORD$(4)
CITY$=RECORD$(5)
ZIP$=RECORD$(6)
PHONE$=RECORD$(7)
COM$=RECORD$(8)
PAID$=RECORD$(9)
TYPE$=RECORD$(10)
RETURN
REM KEY CALCULATING ROUTINE - INPUT IN KEY$
8900 KEY=0
FOR I=1 TO LEN(KEY$) STEP 2
KEY=2*KEY+(15 AND ASC(MID$(KEY$,I,1)))
NEXT I
KEY = KEY-FILE.SIZE*INT(KEY/FILE.SIZE)
KEY = INT(KEY+.1)
IF KEY = 0 THEN KEY = 1
PRINT "RANDOMIZED TO ";KEY
RETURN
REM EXTRACT FIELD NAME, VALUE FROM C$
8910 C$=MID$(C$,3,99)
BP=0
REM FIND BLANK AFTER FIELD NAME
FOR I=LEN(C$) TO 1 STEP -1
IF MID$(C$,I,1)=" " THEN BP=I
NEXT I
IF BP<2 THEN 199
BP=BP-1
FIELD$=LEFT$(C$,BP)
FIELD.NO = 0
FOR I=1 TO FIELD.COUNT
IF LEFT$(FIELD.NAME$(I),BP)=FIELD$ THEN\
FIELD.NO = I
NEXT I
IF FIELD.NO=0 THEN\
PRINT "NO SUCH FIELD ";FIELD$:\
GOTO 100
FIELD.VALUE$=MID$(C$,BP+2,99)
FIELD$=FIELD.NAME$(FIELD.NO)
RETURN
REM RECORD PRINT ROUTINE
9000 PRINT
PRINT "RECORD #";KEY;" ";RECORD$(1) :REM SORT
PRINT RECORD$(2) :REM NAME
PRINT RECORD$(3) :REM ORG
PRINT RECORD$(4) :REM STREET
PRINT RECORD$(5);" ";RECORD$(6)
PRINT RECORD$(7);";";\
RECORD$(8);";";\
RECORD$(9);";";\
RECORD$(10)
PRINT
RETURN
REM WRITE RECORD(KEY)
9100 IF KEY < 1 OR KEY > FILE.SIZE THEN\
PRINT "INVALID KEY FOR WRITE":\
GOTO 100
PRINT #1,KEY;1,RECORD$(1),\
RECORD$(2),\
RECORD$(3),\
RECORD$(4),\
RECORD$(5),\
RECORD$(6),\
RECORD$(7),\
RECORD$(8),\
RECORD$(9),\
RECORD$(10)
RETURN
REM FILE PURGE BY DATE
9200 PRINT "FILE PURGE ROUTINE:"
DEL.DATE$=MID$(C$,7,99)
PRINT "PURGING DATE '";DEL.DATE$;"'"
PRINT:PRINT "TURN ON PRINTER."
INPUT"STARTING, ENDING RECORD";STARTING,ENDING
FOR I=STARTING TO ENDING
READ #1,I;FLAG
IF FLAG=0 THEN 9210
READ #1,I;FLAG,SO$,NA$,OR$,ST$,CI$,ZI$,PH$,CO$,PA$,TY$
IF PA$<>DEL.DATE$ THEN 9210
PRINT "DELETED ";PA$;" ";NA$
FLAG=0
PRINT #1,I;FLAG,SO$,NA$,OR$,ST$,CI$,ZI$,PH$,CO$,PA$,TY$
IF INP(1)=255 THEN 100
9210 NEXT I
PRINT "END OF PURGE"
GOTO 100
9999 END