home *** CD-ROM | disk | FTP | other *** search
- 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
-