PCjs Machines
Home of the original IBM PC emulator for browsers.
PC-SIG Diskette Library (Disk #182)
[PCjs Machine "ibm5160"]
Waiting for machine "ibm5160" to load....
Information about “AUTOFILE, EASYFILE”
The AUTOFILE program is a free-form sort of database. Your data is
stored as an 80-column by 20-line "page", indexed and searchable by up
to 42 keywords. A very useful program for keeping track of information
that might not work as well under a "conventional" database program.
EASYFILE is another simple file manager with a host of support
routines.
System Requirements: BASIC
How to Start: For instructions on running BASIC programs, please refer
to the GETTING STARTED section in this catalog. To read DOC files
simply enter TYPE filename.ext and press <ENTER>.
File Descriptions:
-------- --- AUTOFILE
SPEC-OCC DOC Documentation
TIME BAS Displays time
TCLOCK BAS Displays large date & time, has alarm (William Vath)
SPEC-OCC BAS Keeps track of special occasions by month (Phil Michitsch)
MONOCLKF DOC Documentation
MONOCLKF COM Monochrome clock time display
DDATE COM Last date used routine
CALENDAR BAS Displays calendar for any month & year (Irvan Krantzler)
DCATFILE BAS Part of EASYFILE - displays file categories
AUTOFILE BAT AUTOFILE batch start up file
AUTOFILE BAS AUTOFILE small indexed file system
COPFILE BAS Part of EASYFILE - copies file
COLRFILE BAS Part of EASYFILE - switches to color monitor
BUILFILE BAS Part of EASYFILE - builds initial file
ADDFILE BAS Part of EASYFILE - add to a file
EASYFILE BAS EASYFILE main program - small simple file manager
AUTOFILE DOC AUTOFILE documentation
-------- --- EASYFILE
AUTOFILE FIX Part of AUTOFILE
DTEXFILE BAS Part of EASYFILE - displays text
DISPFILE BAS Part of EASYFILE - displays files
EZFDOCM BAS Part of EASYFILE - doc - use BASICA LIST to view
FILEFILE BAS Part of EASYFILE - file selection
FILEMENU BAS Part of EASYFILE - EASYFILE menu
LISTFILE BAS Part of EASYFILE - list file
STATFILE BAS Part of EASYFILE - status report
MONOFILE BAS Part of EASYFILE - switch to monochrome
-------- --- Date and Time Utilities
AREACODE BAS Displays major cities within an area code
ADDFILE.BAS
2 COMMON DRIVEID$,FILEID$
10 SCREEN 0,1
20 KEY OFF
30 COLOR 15,9,4
33 GOTO 300
40 CLS
50 PRINT " "
60 PRINT " EASY-FILE ADD TO FILE"
70 PRINT " "
80 PRINT " "
85 LOCATE 25,1
86 PRINT " space bar=CONT Esc=EXIT T=RESTART"
90 LOCATE 5,1
95 RETURN
300 OPEN DRIVEID$+FILEID$+".EZF" AS #1 LEN=128
310 FIELD #1, 2 AS BUCKET1$, 2 AS BUCKET2$, 2 AS BUCKET3$, 2 AS BUCKET4$, 40 AS LINE1$, 40 AS LINE2$, 40 AS LINE3$
320 GET #1,1
330 NEXTREC = CVI(BUCKET3$) + 1
340 MAXREC = CVI(BUCKET3$)
350 CATREC = CVI(BUCKET1$)
360 LCATREC = CVI(BUCKET2$)
370 NCATREC = CVI(BUCKET4$)
375 GOSUB 40
380 INPUT " Category ==>";CATG$
390 INPUT " Subject ==>";SUBJ$
395 PRINT " "
396 LCATG=LEN(CATG$)
400 GET #1,CATREC
405 TOSUB=CVI(BUCKET3$)
410 IF CATG$ = LEFT$(LINE1$,LCATG) THEN 600
420 IF CVI(BUCKET2$) = 0 THEN GOTO 500
430 CATREC = CVI(BUCKET2$)
440 GOTO 400
500 PRINT " Matching category not found"
510 IF NEXTREC > 1000 THEN GOTO 800
520 NCATREC = NCATREC + 1
530 MAXREC = MAXREC + 1
540 LCATREC = NEXTREC
550 OLDCATREC=CATREC
555 CATSWITCH=1
560 LSET BUCKET1$ = MKI$(CATREC)
561 LSET BUCKET2$ = MKI$(0)
562 LSET BUCKET3$ = MKI$(0)
563 LSET BUCKET4$ = MKI$(2)
564 LSET LINE1$ = CATG$
565 LSET LINE2$ = SUBJ$
566 LSET LINE3$ = " "
567 CATREC = NEXTREC
568 NEXTREC = NEXTREC + 1
569 PUT #1,CATREC
570 TOSUB = CVI(BUCKET3$)
575 GET #1,OLDCATREC
578 LSET BUCKET2$=MKI$(CATREC)
580 PUT #1,OLDCATREC
599 PRINT " Category/Subject added"
600 GOSUB 900
602 LSET LINE1$=SPACE$(40):LSET LINE2$=SPACE$(40):LSET LINE3$=SPACE$(40)
605 GOSUB 650
608 LSET LINE1$=LIN$
609 IF SWITCH = 0 THEN GOTO 1000
610 GOSUB 650
611 LSET LINE2$=LIN$
612 IF SWITCH =0 THEN GOTO 640
613 GOSUB 650
614 LSET LINE3$=LIN$
615 IF SWITCH = 0 THEN GOTO 640
616 GOTO 640
640 LSET BUCKET4$=MKI$(3)
641 LSET BUCKET1$=MKI$(CATREC)
642 LSET BUCKET2$=MKI$(0)
643 LSET BUCKET3$=MKI$(FROMSUB)
644 PUT #1,NEXTREC
645 IF FROMSUB <> 0 THEN GOSUB 1500
646 GOSUB 1600
647 IF SWITCH=0 THEN 1000
648 NEXTREC = NEXTREC+1
649 GOTO 602
650 INPUT "ENTER LINE==>";LIN$
651 IF LEN(LIN$) > 40 THEN PRINT " TOO LONG -- REENTER"
652 IF LEN(LIN$) > 40 THEN 650
653 IF LEN(LIN$) = 0 THEN SWITCH = 0 ELSE SWITCH=1
654 RETURN
800 PRINT " FILE FULL"
810 GOTO 1040
900 FROMSUB=0
905 IF TOSUB = 0 THEN 980
908 SUBREC = TOSUB
910 GET #1,SUBREC
915 STOSUB=CVI(BUCKET2$)
920 IF STOSUB=0 THEN FROMSUB=SUBREC
925 IF STOSUB=0 THEN GOTO 980
930 SUBREC=STOSUB
940 GOTO 910
980 RETURN
1000 GET#1,1
1010 LSET BUCKET2$=MKI$(LCATREC)
1020 LSET BUCKET3$=MKI$(MAXREC)
1025 LSET BUCKET4$=MKI$(NCATREC)
1030 PUT#1,1
1040 PRINT " PROCESSING COMPLETE"
1050 K$=INKEY$:IF K$="" THEN 1050
1060 IF K$="T" THEN 320
1065 IF K$="t" THEN 320
1070 IF K$=CHR$(27) THEN 1100
1075 IF K$=" " THEN 320
1080 GOTO 1050
1100 PRINT " ADDS COMPLETE"
1105 CLOSE #1
1110 CHAIN DRIVEID$+"FILEMENU"
1500 GET #1,FROMSUB
1505 LSET BUCKET2$=MKI$(NEXTREC)
1510 PUT #1,FROMSUB
1520 RETURN
1600 IF TOSUB <> 0 THEN 1650
1605 GET #1,CATREC
1610 LSET BUCKET3$=MKI$(NEXTREC)
1612 TOSUB = NEXTREC
1615 PUT#1,CATREC
1650 FROMSUB=NEXTREC
1655 MAXREC=NEXTREC
1660 RETURN
AREACODE.BAS
10 REM AREA CODE LOCATER
15 ? "ENTER ZERO TO END PROGRAM"
20 ? :? "INPUT AREA CODE"
30 INPUT N:? :IF N=0 THEN END
40 ON INT(N/100) GOTO 210,60,80,100,120,140,160,180,200
50 GOTO 210
60 ON N-200 GOTO 840,380,360,1470,220,1340,630,450,260,210,210,870,270,1130,1040,970,460,710,510
70 GOTO 210
80 ON N-300 GOTO 640,370,350,1360,390,1460,1400,810,470,210,210,480,670,750,880,570,520,610,540
90 GOTO 210
100 ON N-400 GOTO 1080,800,1450,420,1010,790,210,280,1150,210,210,1050,650,1370,290,1510,770,1540,980
110 GOTO 210
120 ON N-500 GOTO 250,590,1030,620,860,1570,720,210,1350,210,210,1170,990,1530,550,890,680,900,1500
130 GOTO 210
140 ON N-600 GOTO 740,240,830,1440,1100,600,910,1380,850,210,210,730,1520,1000,1110,690,660,490,300
150 GOTO 210
160 ON N-700 GOTO 960,820,1320,940,1490,1600,310,210,1560,210,210,560,1240,320,1390,920,1060
170 GOTO 210
180 ON N-800 GOTO 1300,1310,1090,1330,330,1250,1480,440,1410,210,210,530,400,1070,500,780,1260,210,1550
190 GOTO 210
200 ON N-900 GOTO 1120,1580,210,410,1590,700,230,210,210,210,210,430,580,930,1280,340,210,1020,950
210 ? "NOT A VALID AREA CODE":GOTO 20
220 ? "ALABAMA":? :? "ALL LOCATIONS":GOTO 20
230 ? "ALASKA":? :? "ALL LOCATIONS":GOTO 20
240 ? "ARIZONA":? :? "ALL LOCATIONS":GOTO 20
250 ? "ARKANSAS":? :? "ALL LOCATIONS":GOTO 20
260 ? "CALIFORNIA":? :? "FRESNO":GOTO 20
270 ? "CALIFORNIA":? :? "LOS ANGELES":GOTO 20
280 ? "CALIFORNIA":? :? "SAN JOSE":GOTO 20
290 ? "CALIFORNIA":? :? "SAN FRANCISCO":GOTO 20
300 ? "CALIFORNIA":? :? "SAN DIEGO":GOTO 20
310 ? "CALIFORNIA":? :? "SANTA ROSA":GOTO 20
320 ? "CALIFORNIA":? :? "ORANGE":GOTO 20
330 ? "CALIFORNIA":? :? "BAKERSFIELD":GOTO 20
340 ? "CALIFORNIA":? :? "SACRAMENTO":GOTO 20
350 ? "COLORADO":? :? "ALL LOCATIONS":GOTO 20
360 ? "CONNECTICUT":? :? "ALL LOCATIONS":GOTO 20
370 ? "DELAWARE":? :? "ALL LOCATIONS":GOTO 20
380 ? "WASHINGTON, D.C.":GOTO 20
390 ? "FLORIDA":? :? "FT. LAUDERDALE","KEY WEST":? "MIAMI":GOTO 20
400 ? "FLORIDA":? :? "FT. MYERS","WINTER HAVEN":GOTO 20
410 ? "FLORIDA":? :? "JACKSONVILLE","TALLAHASSEE":GOTO 20
420 ? "GEORGIA":? :? "ATLANTA","ROME":GOTO 20
430 ? "GEORGIA":? :? "SAVANNAH","WAYCROSS":GOTO 20
440 ? "HAWAII":? :? "ALL LOCATIONS":GOTO 20
450 ? "IDAHO":? :? "ALL LOCATIONS":GOTO 20
460 ? "ILLINOIS":? :? "SPRINGFIELD":GOTO 20
470 ? "ILLINOIS":? :? "PEORIA":GOTO 20
480 ? "ILLINOIS":? :? "AURORA","CHICAGO":? "WAUKEGAN":GOTO 20
490 ? "ILLINOIS":? :? "ALTON","CENTRALIA":? "MT. VERNON":GOTO 20
500 ? "ILLINOIS":? :? "ROCKFORD":GOTO 20
510 ? "INDIANA":? :? "GARY","SOUTH BEND":? "WARSAW":GOTO 20
520 ? "INDIANA":? :? "INDIANAPOLIS","KOKOMO":GOTO 20
530 ? "INDIANA":? :? "EVANSVILLE":GOTO 20
540 ? "IOWA":? :? "DUBUQUE":GOTO 20
550 ? "IOWA":? :? "DES MOINES":GOTO 20
560 ? "IOWA":? :? "COUNCIL BLUFFS":GOTO 20
570 ? "KANSAS":? :? "DODGE CITY","WICHITA":GOTO 20
580 ? "KANSAS":? :? "LAWRENCE","MANHATTAN":? "SALINA","TOPEKA":GOTO 20
590 ? "KENTUCKY":? :? "FRANKFORT","LOUISVILLE":? "PADUCAH",,"SHELBYVILLE":GOTO 20
600 ? "KENTUCKY":? :? "COVINGTON","WINCHESTER":GOTO 20
610 ? "LOUISIANA":? :? "LAKE CHARLES","SHREVEPORT":GOTO 20
620 ? "LOUISIANA":? :? "BATON ROUGE","NEW ORLEANS":GOTO 20
630 ? "MAINE":? :? "ALL LOCATIONS":GOTO 20
640 ? "MARYLAND":? :? "ALL LOCATIONS":GOTO 20
650 ? "MASSACHUSETTS":? :? "SPRINGFIELD":GOTO 20
660 ? "MASSACHUSETTS":? :? "BOSTON","NEW BEDFORD":? "PLYMOUTH","WORCESTER":GOTO 20
670 ? "MICHIGAN":? :? "ANN ARBOR","DETROIT":? "FLINT":GOTO 20
680 ? "MICHIGAN":? :? "LANSING":GOTO 20
690 ? "MICHIGAN":? :? "BATTLE CREEK","GRAND RAPIDS":? "KALAMAZOO":GOTO 20
700 ? "MICHIGAN":? :? "ESCANABA":GOTO 20
710 ? "MINNESOTA":? :? "DULUTH":GOTO 20
720 ? "MINNESOTA":? :? "ROCHESTER":GOTO 20
730 ? "MINNESOTA":? :? "MINNEAPOLIS","ST PAUL":GOTO 20
740 ? "MISSISSIPPI":? :? "ALL LOCATIONS":GOTO 20
750 ? "MISSOURI":? :? "CAPE GIRARDEAU","COLUMBIA":? "FULTON",,"HANNIBAL":? "JEFFERSON CITY","MEXICO"
760 ? "POPLAR BLUFF","ROLLA":? "ST LOUIS":GOTO 20
770 ? "MISSOURI":? :? "JOPLIN","SPRINGFIELD":GOTO 20
780 ? "MISSOURI":? :? "BELTON",,"INDEPENDENCE":? "KANSAS CITY","MARSHALL":? "ST JOSEPH","SEDALIA":GOTO 20
790 ? "MONTANA":? :? "ALL LOCATIONS":GOTO 20
800 ? "NEBRASKA":? :? "LINCOLN","OMAHA":GOTO 20
810 ? "NEBRASKA":? :? "NORTH PLATTE":GOTO 20
820 ? "NEVADA":? :? "ALL LOCATIONS":GOTO 20
830 ? "NEW HAMPSHIRE":? :? "ALL LOCATIONS":GOTO 20
840 ? "NEW JERSEY":? :? "HACKENSACK","NEWARK":? "NEW BRUNSWICK","PATERSON":GOTO 20
850 ? "NEW JERSEY":? :? "ATLANTIC CITY","CAMDEN":? "TRENTON":GOTO 20
860 ? "NEW MEXICO":? :? "ALL LOCATIONS":GOTO 20
870 ? "NEW YORK":? :? "NEW YORK CITY":GOTO 20
880 ? "NEW YORK":? :? "SYRACUSE":GOTO 20
890 ? "NEW YORK":? :? "HEMPSTEAD":GOTO 20
900 ? "NEW YORK":? :? "ALBANY","SCHENECTADY":GOTO 20
910 ? "NEW YORK":? :? "BINGHAMTON":GOTO 20
920 ? "NEW YORK":? :? "BUFFALO","NIAGARA FALLS":? "ROCHESTER":GOTO 20
930 ? "NEW YORK":? :? "WHITE PLAINS":GOTO 20
940 ? "NORTH CAROLINA":? :? "CHARLOTTE","SALISBURY":GOTO 20
950 ? "NORTH CAROLINA":? :? "GREENVILLE","RALEIGH":? "WINSTON-SALEM":GOTO 20
960 ? "NORTH DAKOTA":? :? "ALL LOCATIONS":GOTO 20
970 ? "OHIO":? :? "AKRON","CLEVELAND":? "YOUNGSTOWN":GOTO 20
980 ? "OHIO":? :? "TOLEDO":GOTO 20
990 ? "OHIO":? :? "CINCINNATI","DAYTON":GOTO 20
1000 ? "OHIO":? :? "COLUMBUS":GOTO 20
1010 ? "OKLAHOMA":? :? "ENID",,"NORMAN":? "OKLAHOMA CITY","PONCA CITY":? "STILLWATER":GOTO 20
1020 ? "OKLAHOMA":? :? "BARTLESVILLE","MCALESTER":? "MUSKOGEE",,"TULSA":GOTO 20
1030 ? "OREGON":? :? "ALL LOCATIONS":GOTO 20
1040 ? "PENNSYLVANIA":? :? "ALLENTOWN (LEHIGH CO.)":? "PHILADELPHIA":GOTO 20
1050 ? "PENNSYLVANIA":? :? "PITTSBURGH":GOTO 20
1060 ? "PENNSYLVANIA":? :? "HARRISBURG","SCRANTON":GOTO 20
1070 ? "PENNSYLVANIA":? :? "ALTOONA","ERIE":GOTO 20
1080 ? "RHODE ISLAND":? :? "ALL LOCATIONS":GOTO 20
1090 ? "SOUTH CAROLINA":? :? "ALL LOCATIONS":GOTO 20
1100 ? "SOUTH DAKOTA":? :? "ALL LOCATIONS":GOTO 20
1110 ? "TENNESSEE":? :? "CHATTANOOGA","NASHVILLE":GOTO 20
1120 ? "TENNESSEE":? :? "MEMPHIS":GOTO 20
1130 ? "TEXAS":? :? "DALLAS","DENISON":? "ENNIS","GREENVILLE"
1140 ? "JEFFERSON";" LONGVIEW":? "PARIS","SHERMAN":? "TYLER":GOTO 20
1150 ? "TEXAS":? :? "BAY CITY",,"BEAUMONT":? "BRYAN",,"COLLEGE STATION"
1160 ? "FREEPORT",,"GALVESTON":? "HUNTSVILLE","ORANGE":? "TEXAS CITY":GOTO 20
1170 ? "TEXAS":? :? "ALICE",,"AUSTIN":? "BANDERA",,"BEEVILLE"
1180 ? "BROWNSVILLE","CARRIZO SPRINGS":? "CORPUS CHRISTI","CRYSTAL CITY"
1190 ? "DEL RIO",,"EAGLE PASS":? "FLATONIA",,"FREDERICKSBURG"
1200 ? "FREER",,"GEORGETOWN":? "GOLIAD",,"HALLETTSVILLE"
1210 ? "HONDO",,"KERRVILLE":? "LAMPASAS",,"LAREDO"
1220 ? "MARBLE FALLS","MCALLEN":? "ROCKPORT",,"SAN ANTONIO"
1230 ? "UVALDE",,"VICTORIA":GOTO 20
1240 ? "TEXAS":? :? "BAYTOWN","HOUSTON":GOTO 20
1250 ? "TEXAS":? :? "AMARILLO","BORGER":? "DALHART","LUBBOCK":GOTO 20
1260 ? "TEXAS":? :? "DENTON",,"FORT WORTH":? "TEMPLE",,"WACO"
1270 ? "WICHITA FALLS":GOTO 20
1280 ? "TEXAS":? :? "ABILENE",,"ALPINE":? "BIG SPRING","EL PASO"
1290 ? "MIDLAND",,"ODESSA":? "SAN ANGELO":GOTO 20
1300 ? "UTAH":? :? "ALL LOCATIONS":GOTO 20
1310 ? "VERMONT":? :? "ALL LOCATIONS":GOTO 20
1320 ? "VIRGINIA":? :? "ARLINGTON","ROANOKE":? "WINCHESTER":GOTO 20
1330 ? "VIRGINIA":? :? "CHARLOTTESVILLE","NEWPORT NEWS":? "NORFOLK",,"RICHMOND":GOTO 20
1340 ? "WASHINGTON":? :? "OLYMPIA","SEATTLE":? "VANCOUVER":GOTO 20
1350 ? "WASHINGTON":? :? "SPOKANE","WALLA WALLA":GOTO 20
1360 ? "WEST VIRGINIA":? :? "ALL LOCATIONS":GOTO 20
1370 ? "WISCONSIN":? :? "GREEN BAY","MILWAUKEE":? "RACINE":GOTO 20
1380 ? "WISCONSIN":? :? "MADISON":GOTO 20
1390 ? "WISCONSIN":? :? "EAU CLAIRE","WAUSAU":GOTO 20
1400 ? "WYOMING":? :? "ALL LOCATIONS":GOTO 20
1410 ? "ANGUILLA",,"ANTIGUA":? "BAHAMAS",,"BARBADOS":? "BEQUIA",,"BERMUDA":? "CAYMAN ISLANDS","DOMINICA"
1420 ? "DOMINICAN REP","JAMAICA":? "MONTSERRAT","MUSTIQUE":? "NEVIS",,"PALM ISLAND":? "PUERTO RICO","ST KITTS"
1430 ? "ST LUCIA",,"ST VINCENT":? "TRINIDAD",,"TOBAGO":? "UNION ISLAND","VIRGIN ISLANDS":GOTO 20
1440 ? "CANADA":? :? "BRITISH COLUMBIA":GOTO 20
1450 ? "CANADA":? :? "ALBERTA":? " CALGARY":GOTO 20
1460 ? "CANADA":? :? "SASKATCHEWAN":GOTO 20
1470 ? "CANADA":? :? "MANITOBA":GOTO 20
1480 ? "CANADA":? :? "ONTARIO":? " THUNDER BAY":GOTO 20
1490 ? "CANADA":? :? "ONTARIO":? " NORTH BAY":GOTO 20
1500 ? "CANADA":? :? "ONTARIO":? " LONDON":GOTO 20
1510 ? "CANADA":? :? "ONTARIO":? " TORONTO":GOTO 20
1520 ? "CANADA":? :? "ONTARIO":? " OTTAWA":GOTO 20
1530 ? "CANADA":? :? "QUEBEC":? " MONTREAL":GOTO 20
1540 ? "CANADA":? :? "QUEBEC":? " QUEBEC":GOTO 20
1550 ? "CANADA":? :? "QUEBEC":GOTO 20
1560 ? "CANADA":? :? "NEW FOUNDLAND":GOTO 20
1570 ? "CANADA":? :? "NEW BRUNSWICK":GOTO 20
1580 ? "CANADA":? :? "PRINCE EDWARD ISLAND":? "NOVA SCOTIA":GOTO 20
1590 ? "MEXICO":? :? "MEXICO CITY":GOTO 20
1600 ? "MEXICO":? :? "NORTHWEST MEXICO":GOTO 20
AUTOFILE.BAS
1 '*************************************
2 '* A U T O F I L E - T D KOLOUCH *
3 '* *
4 '* CUSTOM DATA SERVICES, INC. *
5 '* PO BOX 13 *
6 '* CROMWELL, CT 06416 *
7 '* TEL# 203-635-1589 *
8 '*************************************
9 GOTO 100
10 '
11 ' *** Input routine ***
12 '
13 IN$ = STRING$(ABS(FL)," "):WD%=0:WS%=0:WL%=0:RC%=0:W$=" "
14 PRINT STRING$(ABS(FL),".");:LOCATE ,POS(0)-ABS(FL)
15 LOCATE ,,1:W$ = INKEY$:IF W$ = "" THEN 15 ELSE IF LEN(W$) = 2 THEN 22
16 IF ABS(FL) = WL% THEN 19 ELSE IF FL>0 AND W$>=" " AND W$<=CHR$(126) THEN 29 ELSE IF FL<0 AND W$>"/" AND W$<":" THEN 29
17 IF W$="." AND WD%=0 THEN WD%=1:GOTO 29
18 IF (W$="-" OR W$="+") AND WS%=0 AND WL%=0 THEN WS%=1:GOTO 29
19 IF W$ = CHR$(8) AND WL%>0 THEN GOSUB 30:MID$(IN$,WL%,1)=" ":WL%=WL%-1:PRINT CHR$(29);:PRINT ".";:PRINT CHR$(29);:GOTO 15
20 IF W$ = CHR$(27) THEN LOCATE ,POS(0)-WL%:GOTO 13
21 IF W$ = CHR$(13) THEN GOTO 28 ELSE GOTO 15
22 W$ = RIGHT$(W$,1)
23 IF W$ = CHR$(75) AND WL%>0 THEN GOSUB 30:MID$(IN$,WL%,1)=" ":WL%=WL%-1:PRINT CHR$(29);:PRINT ".";:PRINT CHR$(29);:GOTO 15
24 IF W$ >= CHR$(59) AND W$ <= CHR$(68) AND WL%=0 THEN RC% = ASC(W$)-58:GOTO 28
25 IF W$=CHR$(72) AND WL%=0 THEN RC%=11:GOTO 28
26 IF W$=CHR$(80) AND WL%=0 THEN RC%=12:GOTO 28
27 GOTO 15
28 PRINT STRING$(ABS(FL)-WL%," ");:IN$ = LEFT$(IN$,WL%):LOCATE ,,0:RETURN
29 PRINT W$;:WL%=WL%+1:MID$(IN$,WL%,1)=W$:IF ABS(FL) = 1 THEN 31 ELSE GOTO 15
30 IF MID$(IN$,WL%,1)="." THEN WD%=0 ELSE IF (MID$(IN$,WL%,1)="+" OR MID$(IN$,WL%,1)="-") THEN WS%=0
31 LOCATE ,,0:RETURN
35 ' ** End of input routine **
100 KEY OFF:FOR X=1 TO 10:KEY X,"":NEXT:WIDTH "LPT1:",255:LOCATE ,,0,2,10
105 DEFINT A-Z:B$=SPACE$(80):B1$=SPACE$(40):ZZ=0:DF$="N"
110 DIM M$(20),KW$(42),NT$(42),KP(42),DL(100),JP$(127)
130 DATA 01,02,03,04,05,06,07,08,09,10,11,12,13,14,15,16,17,18,19,20,21
131 DATA 22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42
140 FOR X = 1 TO 42:READ NT$(X):NEXT
300 CLS:COLOR 15,0:LOCATE 4,25:PRINT STRING$(31,"*"):PRINT TAB(25)"*" TAB(55)"*":PRINT TAB(25)"*" TAB(55)"*":PRINT TAB(25)"*" TAB(55)"*":PRINT TAB(25)"*" TAB(55)"*"
305 PRINT TAB(25)"*" TAB(55)"*":PRINT TAB(25)"*" TAB(55)"*":PRINT TAB(25)"*" TAB(55)"*"
306 PRINT TAB(25)"*" TAB(55)"*":PRINT TAB(25)"*" TAB(55)"*":PRINT TAB(25)STRING$(31,"*")
310 LOCATE 6,31:PRINT "Welcome to AUTOFILE":LOCATE 8,38:PRINT "from":LOCATE 10,28:PRINT "CUSTOM DATA SERVICES, INC":LOCATE 12,37:PRINT "Ver 1.0":COLOR 7,0
320 GOSUB 6000
500 ON ERROR GOTO 6100
510 LOCATE 17,25:PRINT "> Enter filespec: ";:FL=8:GOSUB 10:IF IN$ = "" THEN CLS:SYSTEM
520 P=INSTR(IN$,".")
530 IF P>0 THEN E$="INVALID -- NO EXTENSION ALLOWED":GOSUB 6010:GOTO 510
540 FS$=IN$
550 OPEN"I",1,FS$+".KEY":ON ERROR GOTO 9000
560 FOR X=1 TO 42:INPUT#1,KW$(X),KP(X):NEXT
570 INPUT #1,KI,KD:CLOSE 1
580 OPEN"R",2,FS$+".IND",256
590 FOR X=1 TO 127:FIELD#2,(X-1)*2ASDU$,2ASJP$(X):NEXT
600 FIELD#2,254ASDU$,2ASJX$
610 OPEN"R",3,FS$+".DAT",256
620 FOR X=1 TO 3:FIELD#3,(X-1)*82ASDU$,80ASHD$(X),2ASHB$(X):NEXT
630 FIELD#3,246ASDU$,2ASHF$,2ASHN$
1000 'Menu
1010 CLS:F$="N"
1020 GOSUB 6070:LOCATE 24,1:PRINT "MAINTENANCE MENU: " TAB(26)"- Keywords" TAB(42)"- Data" TAB(55)"- End program";:COLOR 0,7:LOCATE 24,24:PRINT "K";:LOCATE 24,40:PRINT "D";:LOCATE 24,53:PRINT "E";:COLOR 7,0
1030 GOSUB 6200
1040 IF IN$="K" OR IN$="k" THEN 2000 ELSE IF IN$="D" OR IN$="d" THEN 3000 ELSE IF IN$="E" OR IN$="e" THEN 4000
1050 GOTO 1030
2000 'Index
2010 CLS
2020 GOSUB 6070:GOSUB 6220
2030 LOCATE 24,1:PRINT "KEYWORD MAINTENANCE: - Add - Delete - Return to menu";:COLOR 0,7:LOCATE 24,26:PRINT "A";:LOCATE 24,37:PRINT "D";:LOCATE 24,51:PRINT "R";:COLOR 7,0
2040 GOSUB 6200:IF IN$="R" OR IN$="r" THEN 1000
2050 IF IN$="D" OR IN$="d" THEN 2300
2055 GOSUB 6080
2060 IF IN$<>"A" AND IN$<>"a" THEN 2030
2070 'Add keys
2080 LOCATE 24,1:PRINT "- ADD - Enter keyword: ";:FL=12:GOSUB 10:GOSUB 6080:IF IN$="" THEN 2030
2090 IF LEN(IN$)<2 THEN E$="KEYWORDS CANNOT BE ONE CHARACTER LONG":GOSUB 6010:GOTO 2080
2095 IF LEN(IN$)=2 THEN IF IN$>"00" AND IN$<"43" THEN E$="KEYWORD OF 01 TO 42 NOT ALLOWED":GOSUB 6010:GOTO 2080
2100 FOR X=1 TO 42
2110 IF KW$(X)=IN$ THEN E$="DUPLICATE KEYWORD":GOSUB 6010:GOTO 2080
2120 NEXT
2122 FOR X=1 TO 42:IF KP(X)=0 THEN 2130 ELSE NEXT
2125 E$="KEYWORD FILE FULL":GOSUB 6010:GOTO 2030
2130 KW$(X)=IN$:SK$="Y"
2140 IF X>28 THEN DX=X-25:DY=54 ELSE IF X>14 THEN DX=X-11:DY=30 ELSE DX=X+3:DY=6
2150 LOCATE DX,DY:PRINT KW$(X);:LOCATE 24,1:PRINT "Initializing index record";:GOSUB 6300:KP(X)=XI:GOSUB 7150:GOSUB 7160
2155 GOSUB 6080
2160 LOCATE 24,1:PRINT "Reindexing with new keyword";
2170 XD=1:SV$=KW$(X):C=0
2180 GOSUB 6350
2190 IF RK$="Y" THEN GOSUB 6400:C=C+1:LOCATE 24,75:PRINT C;:XD=XD+1:GOTO 2180
2200 GOSUB 6080:GOTO 2030
2300 'Del keys
2310 GOSUB 6080
2320 LOCATE 24,1:PRINT "- DELETE - Enter keyword #: ";:FL=-2:GOSUB 10:GOSUB 6080:IF IN$="" THEN 2030
2340 N=VAL(IN$):IF N<1 OR N>42 THEN E$="NUMBER MUST BE FROM 1 TO 42":GOSUB 6010:GOTO 2320
2350 IF KP(N)=0 THEN E$="KEYWORD NUMBER NOT IN USE":GOSUB 6010:GOTO 2320
2360 XI=KP(N):LOCATE 24,1:PRINT "Deleting keyword chain";
2370 GOSUB 7100:IS=CVI(JX$):IX=KI:GOSUB 7150:GOSUB 7160
2380 KI=XI:SK$="Y"
2390 IF IS>0 THEN XI=IS:GOTO 2370
2400 KP(N)=0:KW$(N)="":IF N>28 THEN DX=N-25:DY=54 ELSE IF N>14 THEN DX=N-11:DY=30 ELSE DX=N+3:DY=6
2410 LOCATE DX,DY:PRINT SPC(12);
2420 GOSUB 6080:GOTO 2030
3000 'Data
3010 CLS:GOSUB 6070:F$="N"
3020 LOCATE 24,1:PRINT "DATA MAINT: dd dit elete rint ext ind eturn";:COLOR 0,7:LOCATE 24,16:PRINT "A";:LOCATE 24,22:PRINT "E";:LOCATE 24,29:PRINT "D";:LOCATE 24,38:PRINT "P";
3025 LOCATE 24,46:PRINT "N";:LOCATE 24,53:PRINT "F";:LOCATE 24,60:PRINT "R";:COLOR 7,0
3030 GOSUB 6200:PP=INSTR("AaEeDdPpNnFfRr",IN$):GOSUB 6080
3040 ON PP GOTO 3060,3060,3200,3200,3300,3300,3400,3400,3700,3700,3500,3500,3760,3760
3050 GOTO 3020
3060 'Add
3065 IF DF$="Y" THEN GOSUB 8200
3070 CLS:GOSUB 6070:F$="N":LOCATE 24,1:PRINT "- ADD -";:GOSUB 6075
3080 GOSUB 6000:GOSUB 5000:GOSUB 6080
3090 FOR X=1 TO 20:IF M$(X)<>B$ THEN 3100 ELSE NEXT :GOTO 3000
3100 GOSUB 6780:FR=XD:GF=FR:GOSUB 6600:GOSUB 6880
3110 F$="Y":GOTO 3020
3200 'Edit
3205 IF DF$="Y" THEN GOSUB 8200
3210 IF F$<>"Y" THEN E$="EDIT WHAT? -- DO <F>IND FIRST":GOSUB 6010:GOTO 3020
3220 LOCATE 24,1:PRINT "- EDIT -";:GOSUB 6075
3230 GOSUB 5000:GOSUB 6080
3240 FOR X=1 TO 20:IF M$(X)<>B$ THEN 3255 ELSE NEXT
3245 IF XD<>GF THEN XD=GF:GOSUB 7200
3250 GOSUB 6840:GOSUB 8000:GOTO 3000
3255 IF XD<>GF THEN XD=GF:GOSUB 7200
3260 GOSUB 6600:GOSUB 6880
3270 GOTO 3020
3300 'Del
3310 IF F$<>"Y" THEN E$="DELETE WHAT? -- DO <F>IND FIRST":GOSUB 6010:GOTO 3020
3320 LOCATE 24,1:PRINT "- DELETE - Confirm delete (Y or N) ";:GOSUB 6200:IF IN$="N" OR IN$="n" THEN 3000
3330 IF IN$<>"Y" AND IN$<>"y" THEN 3320
3335 IF XD<>FR THEN XD=FR:GOSUB 7200
3340 GOSUB 6080:GOSUB 6840:GOSUB 8000:F$="D":CLS:GOSUB 6070:GOTO 3020
3400 'Print
3410 IF F$<>"Y" THEN E$="PRINT WHAT? -- DO <F>IND FIRST":GOSUB 6010:GOTO 3020
3420 LOCATE 24,1:PRINT "- PRINT - Press 'P' to print or 'C' to cancel";:GOSUB 6200:IF IN$="C" OR IN$="c" THEN 3020 ELSE IF IN$<>"P" AND IN$<>"p" THEN 3420
3430 FOR X=1 TO 20:LPRINT M$(X):NEXT
3440 GOSUB 6080:GOTO 3020
3500 'Find
3510 CLS:GOSUB 6070:GOSUB 6220
3520 XD=1:XE=0:LOCATE 24,1:PRINT "- FIND - Enter number of keyword or string to search for: ";:FL=15:GOSUB 10:IF IN$="" OR IN$=STRING$(LEN(IN$)," ") THEN 3000 ELSE GOSUB 6080
3530 IN=VAL(IN$)
3540 IF LEN(IN$)<3 AND IN<43 AND IN>0 AND KP(IN)<>0 THEN 3600
3545 'Find string
3550 SV$=IN$:F$="N"
3560 LOCATE 24,1:PRINT "Search on string = ";SV$;
3570 GOSUB 6350:GOSUB 6080:IF RK$="E" THEN E$="END OF FILE":GOSUB 6010:IF F$="N" THEN 3520 ELSE GOTO 3020
3590 XE=XD:XD=GF:GOSUB 7200:GOSUB 8050:GOTO 3020
3600 'Find key
3610 SV$="":XI=KP(IN):GOSUB 7100:GOSUB 7130:LP=0:F$="N"
3620 IF LP=127 THEN 3670
3630 FOR LX=LP+1 TO 127
3640 IP=CVI(JP$(LX)):IF IP=0 THEN 3670
3650 XD=IP:GOSUB 7200:IF GF<>0 THEN GOSUB 8050:LP=LX:GOTO 3020
3660 NEXT LX
3670 IF IX>0 THEN XI=IX:GOSUB 7100:GOSUB 7130:LP=0:GOTO 3630
3675 E$="END OF INDEX":GOSUB 6010:IF F$="N" THEN 3520 ELSE 3020
3700 'Next
3710 IF F$<>"Y" AND F$<>"D" THEN E$="NEXT WHAT? -- DO <F>IND FIRST":GOSUB 6010:GOTO 3020
3720 IF SV$="" THEN 3620 ELSE XD=XE+1:GOTO 3560
3750 'Return
3760 GOTO 1000
4000 'End
4005 IF DF$="Y" THEN GOSUB 8200
4010 CLS
4020 IF SK$="Y" THEN GOSUB 7000
4030 CLOSE : SYSTEM
5000 ' ** Full screen editor **
5010 LOCATE 3,1,1
5020 WC%=1:WR%=1
5030 W$=INKEY$:IF W$="" THEN 5030
5040 IF W$>= CHR$(32) AND W$<= CHR$(126) THEN 5230 ELSE IF LEN(W$) = 2 THEN 5090
5050 IF W$=CHR$(8) THEN IF WC%>1 THEN WC%=WC%-1:PRINT CHR$(29);:GOTO 5030 ELSE IF WR%>0 THEN WR%=WR%-1:LOCATE WR%+2,80:WC%=80:GOTO 5030
5060 IF W$=CHR$(9) THEN LOCATE WR%+2,80:WC%=80:GOTO 5030
5070 IF W$=CHR$(13) THEN IF WR%<20 THEN WR%=WR%+1:LOCATE WR%+2,1:WC%=1:GOTO 5030
5080 GOTO 5030
5090 W$=RIGHT$(W$,1)
5100 IF W$=CHR$(75) THEN IF WC%>1 THEN WC%=WC%-1:PRINT CHR$(29);:GOTO 5030 ELSE IF WR%>1 THEN WR%=WR%-1:LOCATE WR%+2,80:WC%=80:GOTO 5030
5110 IF W$=CHR$(15) THEN LOCATE WR%+2,1:WC%=1:GOTO 5030
5120 IF W$=CHR$(77) THEN IF WC%<80 THEN PRINT CHR$(28);:WC%=WC%+1:GOTO 5030 ELSE IF WR%<20 THEN WR%=WR%+1:LOCATE WR%+2,1:WC%=1:GOTO 5030
5130 IF W$=CHR$(72) THEN IF WR%>1 THEN WR%=WR%-1:LOCATE WR%+2,WC%:GOTO 5030
5140 IF W$=CHR$(80) THEN IF WR%<20 THEN WR%=WR%+1:LOCATE WR%+2,WC%:GOTO 5030
5150 IF W$=CHR$(73) OR W$=CHR$(71) THEN 5010
5160 IF W$=CHR$(81) THEN LOCATE 22,1:WR%=20:WC%=1:GOTO 5030
5170 IF W$=CHR$(82) THEN IF WC%<80 THEN LOCATE,,0:W1$=" "+MID$(M$(WR%),WC%,80-WC%):MID$(M$(WR%),WC%,LEN(W1$))=W1$:PRINT W1$;:PRINT STRING$(LEN(W1$),29);:LOCATE,,1:GOTO 5030
5180 IF W$=CHR$(83) THEN IF WC%<80 THEN LOCATE,,0:W1$=+MID$(M$(WR%),WC%+1,81-WC%)+" ":MID$(M$(WR%),WC%,LEN(W1$))=W1$:PRINT W1$;:PRINT STRING$(LEN(W1$),29);:LOCATE,,1:GOTO 5030
5190 IF W$=CHR$(59) OR W$=CHR$(61) THEN GOSUB 5270:GOTO 5030
5200 IF W$=CHR$(60) THEN GOSUB 5350:GOTO 5030
5210 IF W$=CHR$(62) THEN 5260
5220 GOTO 5030
5230 PRINT W$;:MID$(M$(WR%),WC%,1)=W$:WC%=WC%+1
5240 IF WC%>80 THEN IF WR%<20 THEN WR%=WR%+1:WC%=1:LOCATE WR%+2,1 ELSE WC%=80:PRINT CHR$(29);
5250 GOTO 5030
5260 LOCATE ,,0:RETURN
5270 'OPEN/RPT RTN
5280 LOCATE,,0
5290 IF WR%=20 THEN 5330
5300 FOR W% = 20 TO WR%+1 STEP -1
5310 M$(W%)=M$(W%-1):LOCATE W%+2,1:PRINT M$(W%);
5320 NEXT
5330 IF W$=CHR$(59) THEN M$(WR%)=SPACE$(80)
5340 LOCATE WR%+2,1:PRINT M$(WR%);:PRINT STRING$(81-WC%,29);:LOCATE,,1:RETURN
5350 'CLOSE RTN
5360 LOCATE,,0
5370 IF WR%=20 THEN 5410
5380 FOR W% = WR% TO 19
5390 M$(W%)=M$(W%+1):LOCATE W%+2,1:PRINT M$(W%);
5400 NEXT
5410 M$(20)=SPACE$(80):LOCATE 22,1:PRINT M$(20);
5420 LOCATE WR%+2,WC%,1:RETURN
5430 ' ** End of full screen routine **
6000 FOR X=1 TO 20 :M$(X)=B$:NEXT :RETURN
6010 'Error
6015 BEEP
6020 COLOR 31:LOCATE 25,40-(LEN(E$)/2),0:PRINT E$;
6030 EKEY$=INKEY$:IF EKEY$<>CHR$(27) THEN 6030 ELSE COLOR 7:LOCATE 25,1:PRINT SPC(79);:LOCATE ,,1:RETURN
6070 PRINT FS$ " " STRING$(29-LEN(FS$),"-") " ";:COLOR 0,7:PRINT " A U T O F I L E ";:COLOR 7,0:PRINT " " STRING$(20,"-") " " DATE$;:LOCATE 23,1:PRINT STRING$(80,223);:RETURN
6075 LOCATE 24,22:PRINT "- Open - Close - Repeat - End";:COLOR O,7:LOCATE 24,19:PRINT "F1";:LOCATE 24,32:PRINT "F2";:LOCATE 24,46:PRINT "F3";:LOCATE 24,61:PRINT "F4";:COLOR 7,0:RETURN
6080 LOCATE 24,1:PRINT SPC(79);:RETURN
6100 LOCATE 19,25:PRINT "> File not found. Create? (Y or N) ";:FL=1:GOSUB 10:IF IN$="" THEN 6100
6110 IF IN$<>"N" AND IN$<>"n" AND IN$<>"Y" AND IN$<>"y" THEN 6100
6120 LOCATE 19,25:PRINT B1$;:IF IN$= "N" OR IN$ ="n" THEN RESUME 510
6160 D=0
6170 OPEN "O",1,FS$+".KEY":GOSUB 7020
6180 OPEN "R",2,FS$+".IND":OPEN "R",3,FS$+".DAT"
6190 CLOSE:ON ERROR GOTO 9000:RESUME 580
6200 LOCATE 24,75:PRINT "==> ";:FL=1:GOSUB 10:IF IN$="" THEN 6200
6210 LOCATE 24,75:PRINT SPC(5);:RETURN
6220 'Paint keys
6230 D=0:DX=4:DY=2:FOR X = 1 TO 42:LOCATE DX,DY+D:PRINT NT$(X)+")" " " KW$(X);:DX=DX+1
6240 IF DX>17 THEN DX=4:D=D+24
6250 NEXT :RETURN
6300 'Next avail indx
6310 IF KI=0 THEN XI=(LOF(2)/256)+1:GOTO 6330
6320 XI=KI:GOSUB 7110:KI=CVI(JX$):SK$="Y"
6330 FOR Z=1 TO 127:LSET JP$(Z)=MKI$(ZZ):NEXT :IX=0
6340 RETURN
6350 'String search
6360 IF XD>LOF(3)/256 THEN RK$="E":GOTO 6395
6370 GOSUB 7210
6380 FOR Z=1 TO 4:P=INSTR(HD$(Z),SV$):IF P>0 THEN RK$="Y":GOTO 6395 ELSE NEXT
6390 XD=XD+1:GOTO 6360
6395 RETURN
6400 'Add to indx
6410 IF KP(X)=XI THEN 6440
6420 XI=KP(X)
6430 GOSUB 7100:GOSUB 7130
6440 FOR Z=1 TO 127
6445 IP=CVI(JP$(Z))
6450 IF IP=GF THEN 6560
6455 IF IP=0 THEN 6470
6460 NEXT Z
6470 IF IX>0 THEN XI=IX:GOTO 6430
6480 IF KP(X)=XI THEN 6510
6490 XI=KP(X)
6500 GOSUB 7100:GOSUB 7130
6510 FOR Z=1 TO 127
6515 IP=CVI(JP$(Z))
6520 IF IP=0 THEN LSET JP$(Z)=MKI$(GF):GOSUB 7150:GOSUB 7160:GOTO 6560
6530 NEXT Z
6540 IF IX>0 THEN XI=IX:GOTO 6500
6550 GOSUB 6300:GOTO 6500
6560 RETURN
6600 'Add/rew
6610 LOCATE 24,1:PRINT "Adding/rewriting page";
6620 Y=1:Z=0
6630 FOR X=1 TO 20
6640 IF X+Z+1=21 THEN 6670
6650 IF M$(X+Z+1)<>B$ THEN 6670
6660 Z=Z+1:GOTO 6640
6670 GOSUB 6730:X=X+Z:Z=0
6680 NEXT X
6690 X1=GN:GN=0:GOSUB 7220
6700 IF X1=0 THEN 6720
6710 XD=X1:GOSUB 7200:GOSUB 6840
6720 GOSUB 6080:RETURN
6730 'Load buf
6740 IF Y<>4 THEN 6770
6760 IF GN>0 THEN GOSUB 7220:XD=GN:GOSUB 7200:GOSUB 6810:GOTO 6765
6762 IF KD>0 THEN GN=KD ELSE GN=(LOF(3)/256)+1:IF GN=XD THEN GN=GN+1
6764 GOSUB 7220:GOSUB 6780
6765 Y=1
6770 LSET HD$(Y)=M$(X):LSET HB$(Y)=MKI$(Z):Y=Y+1:RETURN
6780 'Get next
6790 IF KD>0 THEN XD=KD:GOSUB 7200:KD=GN:SK$="Y" ELSE XD=(LOF(3)/256)+1
6800 GOSUB 6810:GF=FR:GN=0:RETURN
6810 'Init
6820 FOR X7=1 TO 3:LSET HD$(X7)=B1$:LSET HB$(X7)=MKI$(ZZ):NEXT
6830 RETURN
6840 'Del page
6850 X1=GN:GN=KD:KD=XD:GOSUB 6810:GF=0:GOSUB 7220:SK$="Y"
6860 IF X1>0 THEN XD=X1:GOSUB 7200:GOTO 6850
6870 RETURN
6880 'Indx page
6885 LOCATE 24,1:PRINT "Indexing file";
6890 FOR X = 1 TO 42
6900 IF KP(X)=0 THEN 6930
6905 FOR Y = 1 TO 20
6910 IF M$(Y)=B$ THEN 6925
6915 P=INSTR(M$(Y),KW$(X))
6920 IF P>0 THEN GOSUB 6400:GOTO 6930
6925 NEXT Y
6930 NEXT X
6935 GOSUB 6080:RETURN
7000 'Write keys
7010 OPEN "O",1,FS$+".KEY"
7020 FOR Z=1 TO 42:WRITE#1,KW$(Z),KP(Z):NEXT
7030 WRITE#1,KI,KD
7040 CLOSE 1:RETURN
7100 'Indx I/O
7110 GET 2,XI:RETURN
7130 IX=CVI(JX$):RETURN
7150 LSET JX$=MKI$(IX):RETURN
7160 PUT 2,XI:RETURN
7200 'Data I/O
7210 GET 3,XD:GF=CVI(HF$):GN=CVI(HN$):RETURN
7220 LSET HF$=MKI$(GF):LSET HN$=MKI$(GN):PUT 3,XD:RETURN
8000 'Add del list
8010 FOR Z=1 TO 100
8020 IF DL(Z)=0 THEN DL(Z)=FR:GOTO 8040
8030 NEXT
8040 DF$="Y":RETURN
8050 'Paint page
8060 FR=GF:CLS:GOSUB 6070:GOSUB 6000
8070 LY=1
8080 FOR LZ=1 TO 3
8085 IF LY>20 THEN 8130
8090 LOCATE LY+2,1:PRINT HD$(LZ);:M$(LY)=HD$(LZ)
8100 LY=LY+CVI(HB$(LZ))+1
8110 NEXT
8120 IF GN>0 THEN XD=GN:GOSUB 7200:GOTO 8080
8130 F$="Y":RETURN
8200 'Indx del maint
8205 GOSUB 6080:LOCATE 24,1:PRINT "Performing index file maintenance";
8210 FOR L=1 TO 42
8220 IF KP(L)=0 THEN 8340
8230 XI=KP(L)
8240 GOSUB 7100:GOSUB 7130
8250 FOR M=1 TO 127
8260 IP=CVI(JP$(M))
8270 IF IP=0 THEN 8320
8280 FOR N=1 TO 100
8290 IF DL(N)=0 THEN 8310
8300 IF IP=DL(N) THEN LSET JP$(M)=MKI$(ZZ):A$="Y" ELSE NEXT N
8310 NEXT M
8320 IF A$="Y" THEN GOSUB 8400:A$="N"
8330 IF IX>0 THEN XI=IX:GOTO 8240
8340 NEXT L
8350 DF$="N"
8360 FOR L=1 TO 100
8365 IF DL(L)=0 THEN 8390
8370 DL(L)=0
8380 NEXT
8390 RETURN
8400 'Shrink
8410 FOR M1=1 TO 126
8420 IP=CVI(JP$(M1))
8430 IF IP>0 THEN 8480
8440 FOR N1=M1+1 TO 127
8450 IQ=CVI(JP$(N1))
8460 IF IQ>0 THEN LSET JP$(M1)=MKI$(IQ):LSET JP$(N1)=MKI$(ZZ):GOTO 8480
8470 NEXT N1:GOTO 8490
8480 NEXT M1
8490 GOSUB 7160:RETURN
9000 RESUME
65399 '** DONE - PRESS ENTER TO RETURN TO MENU **
BUILFILE.BAS
20 COMMON DRIVEID$,FILEID$
30 SCREEN 0,1
40 GOTO 110
50 FOR I = 3 TO 1003
60 PUT #1,I
70 NEXT
80 CLOSE #1
90 PRINT "EASYFILE FILE HAS BEEN BUILT"
100 CHAIN DRIVEID$+"FILEMENU"
110 KEY OFF
120 COLOR 15,9,4
130 CLS
140 PRINT " "
150 PRINT " "
160 PRINT " EASY-FILE BUILD FILE"
170 PRINT " "
180 PRINT " "
190 PRINT " Are you sure that you want"
200 PRINT " to erase the diskette in "+DRIVEID$+" drive?"
210 PRINT " "
220 INPUT " ENTER Y OR N";ANS$
230 IF ANS$ = "N" THEN 260
240 IF ANS$ = "Y" THEN 290
250 GOTO 210
260 PRINT " "
270 PRINT " BUILD BYPASSED"
280 CHAIN DRIVEID$+"FILEMENU"
290 OPEN DRIVEID$+FILEID$+".EZF" AS #1 LEN=128
300 FIELD #1, 2 AS BUCKET1$, 2 AS BUCKET2$, 2 AS BUCKET3$, 2 AS BUCKET4$, 40 AS LINE1$, 40 AS LINE2$, 40 AS LINE3$
310 LSET BUCKET1$=MKI$(2)
320 LSET BUCKET2$=MKI$(2)
330 LSET BUCKET3$=MKI$(2)
340 LSET BUCKET4$=MKI$(1)
350 PRINT " "
360 INPUT " COMPANY NAME==>";NAM$
370 INPUT " PURPOSE ==>";PURP$
380 INPUT " FIRST CATEGORY=>";CATG$
390 INPUT " FIRST SUBJECT==>";SUBJ$
400 LSET LINE1$=NAM$
410 LSET LINE2$=PURP$
420 LSET LINE3$=" "
430 LOCATE 23,5
440 COLOR 31,0,14
450 PRINT "FILE BEING BUILT"
460 COLOR 15,9,4
470 LOCATE 23,5
480 PUT #1,1
490 LSET BUCKET1$=MKI$(0)
500 LSET BUCKET2$=MKI$(0)
510 LSET BUCKET3$=MKI$(0)
520 LSET BUCKET4$=MKI$(2)
530 LSET LINE1$=CATG$
540 LSET LINE2$=SUBJ$
550 LSET LINE3$=DATE$+" "+TIME$
560 PUT #1,2
570 LSET BUCKET4$=MKI$(3)
580 LSET LINE1$=" "
590 LSET LINE2$=" "
600 LSET LINE3$=" "
610 GOTO 50
CALENDAR.BAS
5 DEFINT A-Z
10 'Program Name: CALENDAR.BAS - Last Updated: 01/07/82 IJK for IBN-PC
12 '
14 'Downloaded from MBBS Atlanta, Georgia - 404-872-3430
16 '
17 'Download time: 5 Minutes and 2 seconds.
18 '
20 CLEAR 4000:RESTORE
22 KEY OFF
25 '
30 DEF FNP%(X%,Y%)=X%*64+Y%
33 DEF FNROW%(PRINT.POS%) = (PRINT.POS% \ 64) + 1
36 DEF FNCOLUMN%(PRINT.POS%) = (PRINT.POS% - (PRINT.POS% \ 64) * 64) + 1 + 8
38 DEF FNCLEARLINE$ = STRING$(79-POS(0),32) + STRING$(79-POS(0),29)
40 DIM N$(31),N%(37),A%(37),ND%(12),MN$(12)
45 '
50 'N$ = STR$(1..31), N% = INT((DAY-1)/7)+1 (LINE # ON SCREEN)
60 'A% = PRINT @ FOR DAY #'S, ND%(1..12) = # DAYS IN MONTH
70 'MN$= Month Name
75 '
100 FOR I%=1 TO 10 : KEY I%,"" : NEXT I%
110 'FUNCTION TO COMPUTE DAY OF WEEK
115 '
120 DEF FND%(X)=X+(FIX(-X/7)*7)
125 '
130 ' 0-6 = SAT-FRI
135 '
140 DEF FNE%(X%)=VAL(MID$("6012345",X%+1,1))
145 '
150 'FUNCTION TO GET NAME OF DAY OF WEEK
160 '
170 DEF FNN$(DW%)=MID$("SATSUNMONTUEWEDTHUFRI",(DW%+1)*3-2,3)
180 '
182 '* Initialize Special Ascii Codes *
184 COMMAND$="Press "+CHR$(24)+", "+CHR$(25)+", "+CHR$(26)+", "+CHR$(27)+", "
185 COMMAND$=COMMAND$+"<ENTER>, ? for help, or <ESC> to Quit" : GOSUB 5000
188 '
195 LEFT.ARROW% = 75 : RIGHT.ARROW% = 77 : UP.ARROW% = 72 : DOWN.ARROW% = 80
200 '
205 DEF SEG=0 : POKE 1047, (PEEK(1047) OR 32) - 32 ' NUM LOCK off
210 GOSUB 2000 ' Instructions!
215 '
220 'SET UP ARRAY (# Days in Month)
230 '
240 FOR I%=1 TO 12 : READ ND%(I%) : NEXT I%
250 FOR I%=1 TO 12 : READ MN$(I%) : NEXT I%
260 '
270 '
280 '* Initialize Arrays with Print @ positions, etc. *
290 '
300 FOR I%=1 TO 37
310 IF I%<=31 THEN N$(I%)=STR$(I%)
320 N%(I%)=INT((I%-1)/7)
330 A%(I%)=(N%(I%)+2)*128+(I%-N%(I%)*7)*7+4
340 NEXT I%
350 '
420 'Clear Screen...
430 '
440 CLS : LOCATE ,,0
450 '
460 M%=1 ' January
470 Y%=1983 ' Starting Year
480 GOSUB 1060 ' Month Name at top of Screen
490 '
500 GOSUB 840 ' Calculate Month Data
510 '
520 GOSUB 920 ' Display Month on Screen
530 '
540 MC%=0:YC%=0
545 IN$=INKEY$ : IF LEN(IN$)<1 THEN POKE 1047, (PEEK(1047) OR 32) - 32:GOTO 545
550 IF LEN(IN$)>1 THEN 570
555 IF IN$=CHR$(27) THEN CLS : GOSUB 12000 : END ' End stuff
560 IF IN$=CHR$(13) THEN GOSUB 970 : GOTO 640 '* Specify Month/Year *
562 IF IN$="/" OR IN$="?" THEN IN%=(0=0) : RESTORE : GOSUB 2003 : GOSUB 1050 : GOSUB 1060 : GOTO 520
565 BEEP : GOTO 545
570 CODE.ENTERED%=ASC(RIGHT$(IN$,1))
580 IF CODE.ENTERED%=UP.ARROW% THEN MC%=-1
585 IF CODE.ENTERED%=DOWN.ARROW% THEN MC%=+1
590 IF CODE.ENTERED%=LEFT.ARROW% THEN YC%=-1
600 IF CODE.ENTERED%=RIGHT.ARROW% THEN YC%=+1
610 IF YC%=0 AND MC%=0 THEN BEEP : GOTO 545
620 M%=M%+MC%:Y%=Y%+YC%+(M%<1)-(M%>12)
630 M%=-(M%<1)*12-(M%>12)-M%*(M%>0 AND M%<13)
640 IN$=INKEY$ : IF IN$="" THEN CLS : GOTO 480 ELSE 550
650 IF M%<3 THEN 680
660 F=365*Y%+31*(M%-1)+D%-FIX(.4*M%+2.3)+FIX(Y%/4)-FIX(.75*(INT(Y%/100)+1))
670 GOTO 690
680 F=365*Y%+(M%-1)*31+D%+FIX((Y%-1)/4)-FIX((3/4)*(FIX(((Y%-1)/100)+1)))
690 RETURN
700 '
710 '* Calculate Date of First Day of Month # M% *
720 '* (Year # Y%, Day # D% - Value returned is *
730 '* 0-6 (Sat.-Fri.).......................... *
740 '
750 D%=1:GOSUB 650
760 FD%=FND%(F)
770 RETURN
780 '
790 '* Routine to Calculate Next Month Number *
800 '
810 M%=M%+1
820 Y%=-(M%>12)+Y%
830 M%=-(M%>12)-(M%<=12)*M%
840 MD%=ND%(M%)-(M%=2 AND Y%=FIX(Y%/100)*100 AND Y%=FIX(Y%/400)*400)-(M%=2 AND Y%<>FIX(Y%/100)*100 AND Y%=FIX(Y%/4)*4)
850 D%=1:GOSUB 650:GOSUB 760
860 RETURN
870 '
880 '* Routine to Display Current Month *
890 '* FD% = Day of Week of Day #1 in Month! *
900 '* M% = Month Number, Y% = Year *
910 '
920 ST%=FNE%(FD%)+1 ' Starting Subscript in Array A%
930 FOR I%=ST% TO ST%+MD%-1 ' MD% days on screen
935 PRINT.POSITION%=A%(I%)-LEN(N$(I%-ST%+1))
940 LOCATE FNROW%(PRINT.POSITION%),FNCOLUMN%(PRINT.POSITION%)
945 PRINT N$(I%-ST%+1);
950 NEXT I%
955 M$=COMMAND$
957 GOSUB 5000
960 RETURN
970 LOCATE 22,1 : PRINT FNCLEARLINE$;"Enter Desired Month (1-12) : ";:V$="01234567890":GOSUB 15120: M$=FL$
980 IF M$="" THEN 1030
990 IF VAL(M$)<1 OR VAL(M$)>12 THEN M$="Enter 1-12 ONLY!":GOSUB 1040:GOTO 970
1000 M%=VAL(M$)
1010 LOCATE 23,1 : PRINT "Enter Desired Year (4 char.) : "; : V$="0123456789" : GOSUB 15120
1015 IF FL$="" THEN RETURN ELSE Y$=FL$
1020 Y%=VAL(Y$):IF Y%<999 THEN Y%=Y%+1900
1030 LOCATE 22,1 : FOR I%=1 TO 2 : PRINT FNCLEARLINE$ : NEXT I% : RETURN
1040 GOSUB 5000
1045 BEEP
1050 FOR K%=1 TO 2000:NEXT K%:RETURN
1060 ST$="* "+MN$(M%)+","+STR$(Y%)+" *"
1070 LOCATE 1,1 : PRINT FNCLEARLINE$;TAB(40-LEN(ST$)/2);ST$;
1080 LOCATE 3,18 : PRINT "SUN MON TUES WED THURS FRI SAT";
1090 LOCATE 4,18 : PRINT "---------------------------------------------";FNCLEARLINE$;
1140 RETURN
2000 GOSUB 6000:IN%=(IN$="Y"):
2003 CLS
2005 DATA "CALENDAR.BAS - IBM-PC Version"
2010 DATA "-----------------------------"
2013 '
2016 'Now, if y'all don't want to see my name on this program,
2017 'feel free to substitute whatever you deem appropriate...
2018 '
2020 DATA "Written by Irvan J. Krantzler"
2025 DATA $2
2030 DATA " This program will display the calendar of virtually any"
2040 DATA "month that you desire. It will start up with the default"
2050 DATA "month and year already set. "
2070 DATA "$2"
2080 DATA " In order to use this program, all you need to do is press"
2090 DATA "one of the arrow keys which will move the month number"
2100 DATA "forwards and backwards (up and down arrows) or change the"
2110 DATA "year in the same manner (left arrow is one year ago, right"
2120 DATA "arrow is one year later). In order to specify a date, press"
2130 DATA "<ENTER> and you will be prompted to enter a month and a"
2140 DATA "year (4 digits). To quit, press the <ESC> key and you will"
2150 DATA "exit to BASIC.....Have fun, y'all! "
2160 DATA "$END"
2170 '
2172 MAX%=20 'Maximum number of lines per screen!
2175 LC%=0 'Line Counter for multiple-screens
2180 READ A$
2185 IF A$="$END" THEN IF NOT IN% THEN RETURN ELSE M$="Press any key to begin.":GOSUB 5000:GOSUB 3100:GOSUB 3040:RETURN ELSE IF NOT IN% THEN 2180
2190 IF LEFT$(A$,1)="$" THEN GOSUB 2500:GOTO 2180
2195 LC%=LC%+1:IF LC%>MAX% THEN GOSUB 3000'Another screen!
2200 PRINT STRING$(40-FIX(LEN(A$)/2),32);A$
2210 GOTO 2180
2470 '
2480 'Print ML% blank lines.
2490 '
2500 ML%=VAL(RIGHT$(A$,LEN(A$)-1))
2510 IF ML%=0 THEN RETURN
2520 FOR IL%=1 TO ML%
2530 PRINT:LC%=LC%+1:IF LC%>MAX% THEN GOSUB 3000' Another Screen
2540 NEXT IL%
2550 RETURN
3000 M$="Press any key to continue instructions....."
3010 GOSUB 5000
3020 GOSUB 3100 'Wait for keypress
3030 LC%=0 'Zero Line Counter
3040 CLS
3050 RETURN
3100 IF INKEY$="" THEN 3100 ELSE RETURN '* Wait for a key *
5000 LOCATE 22,1 : PRINT FNCLEARLINE$;TAB(40-LEN(M$)/2);M$;:RETURN
6000 CLS : LOCATE ,,1 : PRINT "Do you need instructions (Y/N) ? ";
6020 IN$=INKEY$:IF IN$="" THEN 6020
6040 IN$=CHR$( (ASC(IN$) OR 32)-32)
6050 IF INSTR("YN",IN$) THEN LOCATE ,,0
6060 IF IN$="N" THEN PRINT "No":RETURN
6080 IF IN$="Y" THEN PRINT "Yes":RETURN
6090 M$="Press 'Y' or 'N' ONLY!":GOSUB 1040:GOTO 6000
8000 DATA 31,28,31,30,31,30,31,31,30,31,30,31
8010 DATA "January","February","March","April","May","June"
8020 DATA "July","August","September","October","November"
8030 DATA "December"
9000 '
9010 'Note: PLEASE pardon the sloppy condition of this pgm.
9020 ' If it looks like it was thrown together in short
9030 ' order, that's because it was!!! Thanks, IJK
9040 '
10000 '
10010 'End stuff - Set up <F2> for 'RUN'
10020 '
12000 LOCATE 1,22 : COLOR 7,0 : PRINT "Press ";
12010 COLOR 8,7 : PRINT " F2 ";
12020 COLOR 7,0 : PRINT " to use this program again."
12030 PRINT
12040 KEY 2, "RUN" + CHR$(13)
12050 RETURN
15120 FL$="":LOCATE ,,1
15140 A$=INKEY$ : IF A$="" THEN GOSUB 15500:GOTO 15140 ELSE A$=CHR$(((ASC(A$)>96) AND (ASC(A$)<123))* 32+ASC(A$))
15160 IF ASC(A$)<32 THEN 15260
15180 IF INSTR(V$,A$)=0 THEN BEEP:GOTO 15140
15200 IF LEN(FL$)>20 THEN BEEP:GOTO 15140
15220 PRINT A$;
15240 FL$=FL$+A$ : GOTO 15140
15260 A%=ASC(A$)
15280 IF A%=13 THEN LOCATE ,,0:RETURN
15300 IF A%=27 THEN IF LEN(FL$)>0 THEN PRINT STRING$(LEN(FL$),29);STRING$(LEN(FL$),32);STRING$(LEN(FL$),29);:GOTO 15120
15320 IF A%<>8 THEN BEEP:GOTO 15140
15340 IF LEN(FL$)<1 THEN BEEP:GOTO 15140
15360 PRINT CHR$(29);" ";CHR$(29);:FL$=LEFT$(FL$,LEN(FL$)-1):GOTO 15140
15500 POKE 1047, (PEEK(1047) OR 32) : RETURN 'NUM LOCK on
50000 '****** End of program listing ******
COLRFILE.BAS
5 COMMON DRIVEID$,FILEID$
8 CLS
10 WIDTH 80:DEF SEG=0:A=PEEK(&H410):POKE &H410,(A AND &HCF)OR &H20:WIDTH 40:SCREEN 1:SCREEN 0:LOCATE ,,1,6,7:COLOR 15,9,4:CLS:KEY OFF
20 CHAIN DRIVEID$+"FILEMENU"
COPFILE.BAS
10 COMMON DRIVEID$,FILEID$
15 DIM CATARRY$(100)
20 CLS
30 PRINT " "
40 PRINT " EASY-File Copy Files"
50 PRINT " "
60 PRINT " "
70 INPUT " File to be copied"; FROMFILE$
80 PRINT " "
90 INPUT " File to be created"; TOFILE$
100 I=0
110 PRINT " Enter up to 100 categories to be"
120 PRINT " copied."
130 FOR I= 1 TO 100
135 IF ENDSW <=> 0 THEN 190
140 INPUT " Category ==>";CATARRY$(I)
150 IF LEN(CATARRY$(I)) > 40 THEN PRINT " Too Long -- Reenter" ELSE 180
160 GOTO 140
180 IF LEN(CATARRY$(I))= 0 THEN ENDSW=I-1
190 NEXT
200 CLS
210 PRINT " "
220 PRINT " EASY-File Copy Files "
230 PRINT " "
240 PRINT " Place "+FROMFILE$+" in appropriate drive"
250 PRINT " "
260 PRINT " Place "+TOFILE$+" in appropriate drive"
270 PRINT " "
280 INPUT " Do you want to COPY or CREATE file?
290 INPUT " Enter option";OPTION$
291 IF OPTION$="Copy" THEN 300
292 IF OPTION$="Create" THEN 300
293 GOTO 290
300 GOSUB 330
305 IF OPTION$= "COPY" THEN 600
310 IF OPTION$="CREATE" THEN 400
320 PRINT " Invalid Response"
330 OPEN FROMFILE$ AS #1 LEN = 128
331 FIELD #1, 2 AS FBUCKET1$, 2 AS FBUCKET2$, 2 AS FBUCKET3$, 2 AS FBUCKET4$, 40 AS FLINE1$, 40 AS FLINE2$, 40 AS FLINE3$
340 OPEN TOFILE$ AS #2 LEN = 128
341 FIELD #2, 2 AS TBUCKET1$, 2 AS TBUCKET2$, 2 AS TBUCKET3$, 2 AS TBUCKET4$, 40 AS TLINE1$, 40 AS TLINE2$, 40 AS TLINE3$
350 RETURN
400 LSET TBUCKET1$ = MKI$(2)
410 LSET TBUCKET2$ = MKI$(2)
420 LSET TBUCKET3$ = MKI$(2)
430 LSET TBUCKET4$ = MKI$(1)
440 PRINT " "
450 INPUT " Company Name==>";NAM$
460 INPUT " Purpose ==>";PURP$
470 LSET TLINE1$ = NAM$
480 LSET TLINE2$ = PURP$
490 LSET TLINE3$ = " "
495 LOCATE 23,$
500 COLOR 31, 0, 14
510 PRINT "File Being Built"
520 COLOR 15,9,4
530 LOCATE 23,8
540 PUT #2,1
550 TFIRSTCAT=2
555 TLASTCAT=2
560 TLASTREC=2
565 TNUMCAT = 1
570 FIRSTSW = 1
571 LSET BUCKET1$=MKI$(0)
572 LSET BUCKET2$=MKI$(0)
573 LSET BUCKET3$=MKI$(0)
574 LSET BUCKET4$=MKI$(3)
575 LSET LINE1$=" "
577 LSET LINE3$=" "
578 FOR I=2 TO 1003
579 PUT #2,I
580 NEXT
585 PRINT " File has been Built"
600 GET #1,1
620 FLASTCAT=CVI(FBUCKET2$)
630 FRECNUM=CVI(FBUCKET1$)
640 IF FIRSTSW=1
650 GET #2,1
655 TFIRSTCAT=CVI(TBUCKET1$)
660 TLASTCAT=CVI(TBUCKET2$)
665 TLASTREC=CVI(TBUCKET3$)
670 TNUMCAT=CVI(TBUCKET4$)
675 LSET LINE2$=" "
680 FIRSTSW=0
700 IF FRECNUM = 0 THEN GOTO 1500
710 GET #1,FRECNUM
720 GOSUB 900
725 FRECNUM=CVI(BUCKET2$)
730 IF FOUND=1 THEN GOSUB 1000
735 GOTO 700
900 FOUND=0
910 FOR I=1 TO ENDSW
915 IF FOUND=1 THEN 950
920 LFLINE1 = LEN(CATARRY$(I)
925 IF CATARRY$(I) = LEFT$ (FLINE1$, LFLINE1) THEN FOUND =1
950 NEXT
960 RETURN
1000 IF FIRSTSW = 1 THEN 1050
1005 TLASTSAVE = TLASTCAT
1008 GOSUB 1300
1010 TLASTCAT = TLASTREC+1
1020 TLASTREC = TLASTREC +1
1030 TNUMCAT=TNUMCAT+1
1050 FIRSTSW=0
1060 TRECNUM=TLASTREC
1070 IF TRECNUM > 1000 THEN GOTO 1400
1080 LSET TBUCKET1$= MKI$(TLASTSAVE)
1090 LSET TBUCKET2$=MKI$(0)
1100 LSET TBUCKET4$=MKI$(2)
1110 LSET TLINE1$=FLINE1$
1120 LSET TLINE2$=FLINE2$
1130 LSET TLINE3$=FLINE3$
1135 PRINT " "+CATARRY#I(I)" being copied"
1140 LSET TBUCKET3$=MKI$(0)
1150 IF CVI(FBUCKET3$) <> 0 THEN LSET TBUCKET3$= MKI$(TRECNUM+1)
1160 PUT #2,TRECNUM
1170 FRECNUM2=CVI(FBUCKET3$)
1180 TFROMSUB=0
1200 IF FRECNUM2=0 THEN 1290
1205 GET #1,FRECNUM2
1210 TLASTREC=TLASTREC+1
1211 LSET TBUCKET1$=MKI$(TLASTCAT)
1212 LSET TBUCKET2$=MKI$(0)
1213 IF CVI(FBUCKET2$) <> 0 THEN LSET TBUCKET2$=MKI$(TLASTREC+1)
1214 LSET TBUCKET3$=MKI$(TFROMSUB)
1215 LSET TBUCKET4$=MKI$(3)
1216 LSET TLINE1$=FLINE1$
1217 LSET TLINE2$=FLINE2$
1218 LSET TLINE3$=FLINE3$
1219 TRECNUM=TLASTREC
1220 IF TRECNUM > 1000 THEN GOTO 1400
1225 PUT #2,TRECNUM
1230 FRECNUM2=CVI(FBUCKET2$)
1240 TFROMSUB=TRECNUM
1250 GOTO 1200
1290 RETURN
1300 GET #2,TLASTCAT
1310 LSET TBUCKET2$=MKI$(TLASTREC+1)
1320 PUT #2,TLASTCAT
1330 RETURN
1400 REM File Overflow Routine
1410 PRINT "File "+TOFILE$+" if Full"
1420 PRINT "Category Copy Aborted"
1430 GOTO 1510
1500 PRINT "Copy is Complete"
1510 GET #2,1
1520 LSET TBUCKET1$=MKI$(TFIRSTCAT)
1525 LSET TBUCKET2$=MKI$(TLASTCAT)
1530 LSET TBUCKET3$=MKI$(LASTREC)
1540 LSET TBUCKET4$=MKI$(TNUMCAT)
1545 PUT #2,1
1550 CLOSE #1
1560 CLOSE #2
1570 CHAIN DRIVEID$+"FileMenu"
CRC.TXT
PC-SIG Disk No. #182, version v1
The following is a list of the file checksums which should be produced by
the CRCK4 program on disk #9 (and others). If the CRC numbers do not match
you may have a bad file. To use type: CRCK4 <filespec>
CRCK4 output for this disk:
CRCK ver 4.2B (MS DOS VERSION )
CTL-S pauses, CTL-C aborts
--> FILE: AREACODE.BAS CRC = B0 62
--> FILE: CALENDAR.BAS CRC = 6C AC
--> FILE: DDATE .COM CRC = EB B1
--> FILE: MONOCLKF.COM CRC = 33 E6
--> FILE: MONOCLKF.DOC CRC = 0A 98
--> FILE: SPEC-OCC.BAS CRC = 10 3A
--> FILE: SPEC-OCC.DOC CRC = 68 2C
--> FILE: TCLOCK .BAS CRC = 4E 21
--> FILE: TIME .BAS CRC = 1C 03
--> FILE: ADDFILE .BAS CRC = C2 C2
--> FILE: AUTOFILE.BAS CRC = 3D 9B
--> FILE: AUTOFILE.BAT CRC = 00 00
--> FILE: AUTOFILE.DOC CRC = 8B DA
--> FILE: AUTOFILE.FIX CRC = E6 E9
--> FILE: BUILFILE.BAS CRC = 05 3C
--> FILE: COLRFILE.BAS CRC = 45 9D
--> FILE: COPFILE .BAS CRC = D2 49
--> FILE: DCATFILE.BAS CRC = 1C 28
--> FILE: DISPFILE.BAS CRC = BD 52
--> FILE: DTEXFILE.BAS CRC = 81 90
--> FILE: EASYFILE.BAS CRC = 4C 8B
--> FILE: EZFDOCM .BAS CRC = 0E 9A
--> FILE: FILEFILE.BAS CRC = AD 68
--> FILE: FILEMENU.BAS CRC = DC F2
--> FILE: LISTFILE.BAS CRC = 83 CA
--> FILE: MONOFILE.BAS CRC = D5 41
--> FILE: STATFILE.BAS CRC = 1D C6
--> FILE: XXX . CRC = 37 AC
---------------------> SUM OF CRCS = A9 0F
DONE
These and other Public Domain and user-supported programs from:
PC Software Interest Group
1125 Stewart Ct Suite G
Sunnyvale, CA 94086
(408) 730-9291
DCATFILE.BAS
5 COMMON DRIVEID$,FILEID$
10 SCREEN 0,1
20 COLOR 15,9,4
30 RECNUM = 1
40 OPEN DRIVEID$+FILEID$+".EZF" AS #1 LEN=128
50 FIELD #1,2 AS BUCKET1$, 2 AS BUCKET2$,2 AS BUCKET3$,2 AS BUCKET4$,40 AS LINE1$,40 AS LINE2$,40 AS LINE3$
70 CLS
75 RECNUM = 1
80 PRINT " "
90 PRINT " DISPLAY CATEGORIES"
100 PRINT " "
110 PRINT " "
115 LINECT=1
120 INPUT " SEARCH FOR ==>";SEARCH$
121 GET #1,1
122 MAXNUM = CVI(BUCKET3$)
125 GOSUB 700
126 RECNUM = CVI(BUCKET1$)
127 GOTO 135
130 RECNUM = CVI(BUCKET2$)
135 IF RECNUM > MAXNUM THEN 1000
140 IF RECNUM = 0 THEN 500
150 GET #1, RECNUM
160 X=INSTR(LINE1$,SEARCH$)
170 IF X = 0 THEN 180 ELSE 300
180 X=INSTR(LINE2$,SEARCH$)
190 IF X = 0 THEN 200 ELSE 300
200 X=INSTR(LINE3$,SEARCH$)
210 IF X = 0 THEN 130
300 CATG$=LINE1$
310 SUBJ$=LINE2$
320 TIMESTAMP$=LINE3$
325 SCREENFUL = 0
330 GOSUB 400
335 IF SCREENFUL = 1 THEN GOTO 500
345 GOTO 130
400 LINECT = LINECT + 1
410 IF LINECT > 16 THEN LET SCREENFUL=1
420 LOCATE LINECT+4,1
430 PRINT CATG$
450 IF LINECT > 16 THEN LET LINECT=0
460 RETURN
500 PRINT STRING$(40,220)
505 K$=INKEY$:IF K$="" THEN 505
510 IF K$=" " THEN GOTO 125
520 IF K$=CHR$(27) THEN GOTO 1000
530 IF K$="t" THEN GOTO 70
540 IF K$="T" THEN GOTO 70
550 GOTO 505
600 CATGREC = CVI(BUCKET1$)
610 GET #1,CATGREC
620 RETURN
700 CLS
701 LINECT = 0
702 COLOR 15,0
705 LOCATE 25,4
706 PRINT "spacebar=CONT Esc=EXIT T=RESTART"
707 COLOR 15,9,4
708 LOCATE 1,1
710 PRINT " EASY-FILE CATEGORY LIST"
711 LOCATE 2,1
713 LOCATE 3,1
714 PRINT STRING$(80,220)
715 LOCATE 4,1
720 RETURN
1000 CLS
1005 LOCATE 18,8
1010 PRINT "DISPLAY COMPLETE"
1015 CLOSE #1
1020 CHAIN DRIVEID$+"DISPFILE"
DISPFILE.BAS
2 COMMON DRIVEID$,FILEID$
10 SCREEN 0,1
20 KEY OFF
30 COLOR 15,9,4
40 CLS
50 PRINT " "
55 PRINT " "
60 PRINT " EASY-FILE DISPLAY MENU"
70 PRINT " "
80 PRINT " "
90 PRINT " A - DISPLAY CATEGORIES"
100 PRINT " B - DISPLAY TEXT"
105 PRINT " Esc - EXIT"
110 PRINT " "
120 PRINT " SELECT FUNCTION BY LETTER"
130 IF ANS$ = "N" THEN 200
140 K$ = INKEY$: IF K$="" THEN 140
150 IF K$ = "A" THEN CHAIN DRIVEID$+"DCATFILE"
160 IF K$ = "a" THEN CHAIN DRIVEID$+"DCATFILE"
170 IF K$ = "B" THEN CHAIN DRIVEID$+"DTEXFILE"
180 IF K$ = "b" THEN CHAIN DRIVEID$+"DTEXFILE"
185 IF K$ = CHR$(27) THEN CHAIN DRIVEID$+"FILEMENU"
190 GOTO 140
DTEXFILE.BAS
10 DIM LARRAY$(18),RECARRY(6)
20 COMMON DRIVEID$,FILEID$
30 SCREEN 0,1
40 COLOR 15,9,4
50 RECNUM = 1
60 OPEN DRIVEID$+FILEID$+".EZF" AS #1 LEN=128
70 FIELD #1,2 AS BUCKET1$, 2 AS BUCKET2$,2 AS BUCKET3$,2 AS BUCKET4$,39 AS LINE1$,1 AS F1$,39 AS LINE2$,1 AS F2$,39 AS LINE3$,1 AS F3$
80 CLS
90 RECNUM = 1
100 PRINT " "
110 PRINT " DISPLAY TEXT"
120 PRINT " "
130 PRINT " "
140 INPUT " SEARCH FOR ==>";SEARCH$
150 GET #1,1
160 MAXNUM = CVI(BUCKET3$)
170 RECNUM = RECNUM
180 IF RECNUM = 0 THEN 920
190 IF RECNUM > MAXNUM THEN 920
200 IF RECNUM < 2 THEN RECNUM = 2
210 GET #1, RECNUM
220 X=INSTR(LINE1$,SEARCH$)
230 IF X = 0 THEN 240 ELSE 280
240 X=INSTR(LINE2$,SEARCH$)
250 IF X = 0 THEN 260 ELSE 280
260 X=INSTR(LINE3$,SEARCH$)
270 IF X = 0 THEN RECNUM = RECNUM + 1:GOTO 170
280 IF CVI(BUCKET4$) = 3 THEN GOSUB 760
290 TOSUB = CVI(BUCKET3$)
300 CATG$=LINE1$
310 SUBJ$=LINE2$
320 TIMESTAMP$=LINE3$
330 RECNUM = CVI(BUCKET2$)
340 GOSUB 790
350 IF TOSUB = 0 THEN GOTO 650
360 X=0
370 FOR I= 1 TO 13 STEP 3
380 IF TOSUB = 0 THEN 470
390 GET #1,TOSUB
400 X = X+1
410 RECARRY(X) = TOSUB
420 LARRAY$(I) = LINE1$
430 LARRAY$(I+1) = LINE2$
440 LARRAY$(I+2) = LINE3$
450 TOSUB = CVI(BUCKET2$)
460 IF TOSUB = 0 THEN GOSUB 600:ISAVE = I
470 NEXT
480 IF TOSUB = 0 THEN GOTO 650
490 GOSUB 600
500 LOCATE 23,8
510 PRINT "C=CHANGE"
520 K$=INKEY$: IF K$="" THEN 520
530 IF K$=" " THEN GOTO 340
540 IF K$=CHR$(27) THEN GOTO 920
550 IF K$="t" THEN GOTO 80
560 IF K$="T" THEN GOTO 80
570 IF K$="C" THEN GOSUB 970
580 IF K$="c" THEN GOSUB 970
590 GOTO 520
600 FOR I2=1 TO I+2
610 PRINT LARRAY$(I2)
620 LNO=CSRLIN-1
630 NEXT
640 RETURN
650 PRINT STRING$(39,220)
660 LOCATE 23,8
670 PRINT "C=CHANGE"
680 K$=INKEY$:IF K$="" THEN 680
690 IF K$=" " THEN GOTO 170
700 IF K$=CHR$(27) THEN GOTO 920
710 IF K$="t" THEN GOTO 80
720 IF K$="T" THEN GOTO 80
730 IF K$="C" THEN GOSUB 970
740 IF K$="c" THEN GOSUB 970
750 GOTO 680
760 CATGREC = CVI(BUCKET1$)
770 GET #1,CATGREC
780 RETURN
790 CLS
800 COLOR 15,0
810 LOCATE 25,4
820 PRINT "spacebar=CONT Esc=EXIT T=RESTART"
830 COLOR 15,9,4
840 LOCATE 1,1
850 PRINT CATG$
860 LOCATE 2,1
870 PRINT SUBJ$
880 LOCATE 3,1
890 PRINT STRING$(80,220)
900 LOCATE 4,1
910 RETURN
920 CLS
930 LOCATE 18,8
940 PRINT "DISPLAY COMPLETE"
950 CLOSE #1
960 CHAIN DRIVEID$+"DISPFILE"
970 LOCATE 23,8
980 COLOR 31,4,3
990 PRINT " UPDATE MODE "
1000 LOCATE 4,1
1010 COLOR 0,7,3
1020 REM change routine
1030 LINE INPUT ABC$
1040 IF LEN(ABC$) > 39 THEN 1000
1050 CLINE=CSRLIN-1
1060 IF CLINE < 4 THEN 1000
1070 IF CLINE > LNO THEN 1150
1080 IF LEN(ABC$) = 0 THEN 1020
1090 NSPC=39-LEN(ABC$)
1100 LOCATE CLINE,1
1110 PRINT ABC$+SPACE$(NSPC)
1120 I2=CLINE-3
1130 LARRAY$(I2)=ABC$
1140 GOTO 1030
1150 LOCATE 23,8
1160 PRINT " "
1170 X=0
1180 FOR I2=1 TO LNO-3 STEP 3
1190 X=X+1
1200 GET #1,RECARRY(X)
1210 LSET LINE1$=LARRAY$(I2)
1220 LSET LINE2$=LARRAY$(I2+1)
1230 LSET LINE3$=LARRAY$(I2+2)
1240 PUT #1,RECARRY(X)
1250 NEXT
1260 COLOR 15,9,4
1270 LOCATE 23,8
1280 PRINT " CHANGES SAVED "
1290 LOCATE 4,1
1295 I = ISAVE
1300 GOSUB 600
1310 RETURN
EASYFILE.BAS
1 DRIVEID$="a:"
2 FILEID$="EZFILE"
3 COMMON DRIVEID$,FILEID$
10 SCREEN 0,1
20 KEY OFF
30 COLOR 15,9,4
40 CLS
50 PRINT " "
55 PRINT " "
60 PRINT " EASY-FILE AVAILABLE FUNCTIONS"
70 PRINT " "
80 PRINT " "
90 PRINT " A - DISPLAY FILES "
100 PRINT " B - ADD TO FILES"
110 PRINT " C - COPY FILES"
120 PRINT " D - PRINT FILES "
130 PRINT " E - ERASE/BUILD FILE"
140 PRINT " F - STATUS REPORT"
150 PRINT " G - SELECT NEW FILE"
160 PRINT " H - CHANGE TO COLOR DISPLAY"
170 PRINT " I - CHANGE TO MONO. DISPLAY"
180 PRINT " Esc - EXIT"
190 PRINT " "
200 PRINT " "
210 PRINT " SELECT FUNCTION BY LETTER"
220 K$ = INKEY$: IF K$ = "" THEN 220
230 IF K$ = "A" THEN 440
240 IF K$ = "a" THEN 440
250 IF K$ = "B" THEN 450
260 IF K$ = "b" THEN 450
270 IF K$ = "C" THEN 460
280 IF K$ = "c" THEN 460
290 IF K$ = "D" THEN 490
300 IF K$ = "d" THEN 490
310 IF K$ = "E" THEN 510
320 IF K$ = "e" THEN 510
330 IF K$ = "F" THEN 520
340 IF K$ = "f" THEN 520
350 IF K$ = "G" THEN 600
360 IF K$ = "g" THEN 600
370 IF K$= "H" OR K$="h" THEN CHAIN DRIVEID$+"COLRFILE"
380 IF K$= "I" OR K$="i" THEN CHAIN DRIVEID$+"MONOFILE"
410 IF K$ = CHR$(27) THEN 530
430 GOTO 220
440 CHAIN DRIVEID$+"DISPFILE"
450 CHAIN DRIVEID$+"ADDFILE"
460 CHAIN DRIVEID$+"COPFILE"
470 CHAIN DRIVEID$+"CHGFILE"
480 CHAIN DRIVEID$+"PRTFILE"
490 CHAIN DRIVEID$+"LISTFILE"
500 CHAIN DRIVEID$+"REORFILE"
510 CHAIN DRIVEID$+"BUILFILE"
520 CHAIN DRIVEID$+"STATFILE"
530 CLS
531 KEY ON
532 END
534 REM FOLLOWING CODE NOT NOW USED
540 PRINT " "
550 PRINT " PLACE DOS DISKETTE IN DRIVE A"
551 PRINT " PRESS ANY KEY TO PROCEED
552 K$ = INKEY$: IF K$ = "" THEN 552
553 CLS
554 CHAIN "IBMPMENU"
600 CHAIN DRIVEID$+"FILEFILE"
EZFDOCM.BAS
10 REM EASYFILE System Documentation
20 REM -----------------------------
30 REM
40 REM
50 REM Operation
60 REM ---------
70 REM
80 REM EASYFILE is a menu-based system that enables it's users to record
90 REM text in classifications known as categories. This concept is much the
100 REM same as that used in a regular paper-file file cabinet. The categories
110 REM may be thought of as "file-folders", containing information.
120 REM
130 REM Once information is stored in the file, it may be retrieved a number
140 REM of different ways. The entire file may be searched for a matching word
150 REM or phrase and then displayed or printed. Or individual categories may
160 REM be listed entirely. A list of all available categories may be produced,
170 REM or a list of categories that match a given word or phrase may be
180 REM listed.
190 REM
200 REM Additionally, multiple EASYFILE diskettes may be set-up. Once built,
210 REM portions of other files may be copied into the new file. This allows
220 REM special combinations of information to be set-up for individual needs.
230 REM
240 REM To start-up EASYFILE, use the following procedure
250 REM
260 REM 1. Insert the EASYFILE diskette in drive A.
270 REM 2. Type RUN "EASYFILE"
280 REM 3. Select the appropriate function by letter.
290 REM
300 REM The very first time you run EASYFILE, you must select the "BUILD/
310 REM ERASE FILE" function. This will set up the file where the data is
320 REM stored. DO NOT RUN this function again unless you plan on wiping out
330 REM your file.
340 REM
350 REM The rest of the functions used in EASYFILE are self-explanatory. You
360 REM may add, change, and display your files in a variety of ways. Just
370 REM follow the system prompts and you can't go wrong.
380 REM
390 REM
400 REM
410 REM Database Layout
420 REM ---------------
430 REM
440 REM There are three basic record types that are used in the EASY-FILE
450 REM system. These will be called record types 1, 2, and 3. There is a
460 REM maximum of 1000 records that may exist on each file. However multiple
470 REM files may exist on one diskette. The file is a random file. The record
480 REM length is 128 bytes.
490 REM
500 REM The following contains detail descriptions of each record type.
510 REM
520 REM Record Type 1
530 REM -------------
540 REM
550 REM There is only one record type 1 in any given EASY-FILE database. It
560 REM is identified by it's location in the file. It is always record 0. It
570 REM contains database pointers that are used to describe the overall
580 REM database condition. The following is an outline of the content of
590 REM the record type 1 record:
600 REM
610 REM ----dataname---- --position-- ------------description------------
620 REM BUCKET1$ 1 - 2 Pointer to first category (type 2)
630 REM BUCKET2$ 3 - 4 Pointer to last category (type 2)
640 REM BUCKET3$ 5 - 6 Pointer to last record in file.
650 REM BUCKET4$ 7 - 8 Number of categories in file
660 REM LINE1$ 9 - 48 Company name (owner of file)
670 REM LINE2$ 49 - 88 Purpose of file (general comment)
680 REM LINE3$ 89 - 128 not used
690 REM
700 REM
710 REM
720 REM Record Type 2
730 REM -------------
740 REM
750 REM There is one record type 2 for each category that is added to the
760 REM file. Each type 2 record contains information describing the category.
770 REM The following is an outline of the content of record type 2 records:
780 REM
790 REM ----dataname---- --position-- ------------description------------
800 REM BUCKET1$ 1 - 2 Pointer to the previous category
810 REM (type 2) record. If this field
820 REM contains 0, then it is the first
830 REM type 2 record on file.
840 REM BUCKET2$ 3 - 4 Pointer to next category (type 2)
850 REM (type 2) record. If this field
860 REM contains 0, then it is the last
870 REM type 2 record on file.
880 REM BUCKET3$ 5 - 6 Pointer to first text (type 3) record
890 REM for this category. If this field
900 REM contains 0, then there is no
910 REM type 2 record on file.
920 REM BUCKET4$ 7 - 8 Record identifier (02)
930 REM LINE1$ 9 - 48 Category name
940 REM LINE2$ 49 - 88 Subject heading (general comment)
950 REM LINE3$ 89 - 128 Date and Time added
960 REM
970 REM
980 REM
990 REM
1000 REM Record Type 3
1010 REM -------------
1020 REM
1030 REM There is a type 3 record for every 3 lines of text under a category
1040 REM classification. Each contains pointers to other text records and to
1050 REM the category record. Also the actual lines of text are recorded there.
1060 REM The following is an outline of the content of the record type 3
1070 REM record:
1080 REM
1090 REM ----dataname---- --position-- ------------description------------
1100 REM BUCKET1$ 1 - 2 Backward pointer to the category
1110 REM (type 2) record.
1120 REM BUCKET2$ 3 - 4 Pointer to next text (type 2) record
1130 REM If this field contains 0, then this
1140 REM is the last text record for this
1150 REM category.
1160 REM BUCKET3$ 5 - 6 Backward pointer to previous text
1170 REM (type 3) record. If this field is 0,
1180 REM then this is the 1st text record for
1190 REM this category.
1200 REM BUCKET4$ 7 - 8 Record identifier (03)
1210 REM LINE1$ 9 - 48 Text line 1
1220 REM LINE2$ 49 - 88 Text line 2
1230 REM LINE3$ 89 - 128 Text line 3
1240 REM
1250 REM
1260 REM
1270 REM Program Structure/Interfacing
1280 REM -----------------------------
1290 REM
1300 REM EASYFILE
1310 REM |
1320 REM FILEMENU
1330 REM ____________________________|_________________________________. . .
1340 REM | | | | | | | |
1350 REM DISPFILE ADDFILE COPFILE LISTFILE BUILFILE STATFILE COLRFILE MONOFILE
1360 REM | |
1370 REM DCATFILE
1380 REM |
1390 REM DTEXFILE
1400 REM . . . _____________________________
1410 REM |
1420 REM FILEFILE
1430 REM
1440 REM
1450 REM
1460 REM All ends of program chains terminate with "FILEMENU" as
1470 REM the returning program. System termination occurs only in
1480 REM in "FILEMENU" and in "EASYFILE".
1490 REM
1500 REM
1510 REM NOTE: Programs "FILEMENU" and "EASYFILE" are practically
1520 REM duplicates. EASYFILE contains some extra initialization
1530 REM coding that sets up system defaults such as driveid and
1540 REM filename. If desired, these defaults may be changed to
1550 REM suit your particular needs.
1560 REM
1570 REM
1580 REM
FILEFILE.BAS
10 COMMON DRIVEID$,FILEID$
20 SCREEN 0,1
30 KEY OFF
40 COLOR 15,9,4
50 CLS
60 PRINT " "
70 PRINT " "
80 PRINT " EASY-FILE SELECT FILE"
90 PRINT " "
100 PRINT " "
110 PRINT " Are you sure that you want"
120 PRINT " to change your fileid from"+DRIVEID$+FILEID$+".EZF ?"
130 PRINT " "
140 INPUT " ENTER Y OR N";ANS$
150 IF ANS$ = "N" THEN 180
160 IF ANS$ = "Y" THEN 210
170 GOTO 130
180 PRINT " "
190 PRINT " CHANGE BYPASSED"
200 CHAIN DRIVEID$+"FILEMENU"
210 PRINT " "
220 INPUT " NEW DRIVEID==>";DRIVEID$
230 PRINT " "
240 INPUT " NEW FILEID ==>";FILEID$
250 PRINT " "
260 PRINT " The new fileid is "+DRIVEID$+FILEID$+".EFZ"
270 PRINT " "
280 PRINT " Is this correct?"
290 INPUT " ENTER Y OR N";ANS$
300 IF ANS$ = "N" THEN 210
310 IF ANS$ = "Y" THEN 330
320 GOTO 290
330 CHAIN DRIVEID$+"FILEMENU"
FILEMENU.BAS
3 COMMON DRIVEID$,FILEID$
10 SCREEN 0,1
20 KEY OFF
30 COLOR 15,9,4
40 CLS
50 PRINT " "
55 PRINT " "
60 PRINT " EASY-FILE AVAILABLE FUNCTIONS"
70 PRINT " "
80 PRINT " "
90 PRINT " A - DISPLAY FILES "
100 PRINT " B - ADD TO FILES"
110 PRINT " C - COPY FILES"
120 PRINT " D - PRINT FILES "
130 PRINT " E - ERASE/BUILD FILE"
140 PRINT " F - STATUS REPORT"
150 PRINT " G - SELECT NEW FILE"
160 PRINT " H - CHANGE TO COLOR DISPLAY"
170 PRINT " I - CHANGE TO MONO. DISPLAY"
180 PRINT " Esc - EXIT"
190 PRINT " "
200 PRINT " "
210 PRINT " SELECT FUNCTION BY LETTER"
220 K$ = INKEY$: IF K$ = "" THEN 220
230 IF K$ = "A" THEN 440
240 IF K$ = "a" THEN 440
250 IF K$ = "B" THEN 450
260 IF K$ = "b" THEN 450
270 IF K$ = "C" THEN 460
280 IF K$ = "c" THEN 460
290 IF K$ = "D" THEN 490
300 IF K$ = "d" THEN 490
310 IF K$ = "E" THEN 510
320 IF K$ = "e" THEN 510
330 IF K$ = "F" THEN 520
340 IF K$ = "f" THEN 520
350 IF K$ = "G" THEN 600
360 IF K$ = "g" THEN 600
370 IF K$= "H" OR K$="h" THEN CHAIN DRIVEID$+"COLRFILE"
380 IF K$= "I" OR K$="i" THEN CHAIN DRIVEID$+"MONOFILE"
410 IF K$ = CHR$(27) THEN 530
430 GOTO 220
440 CHAIN DRIVEID$+"DISPFILE"
450 CHAIN DRIVEID$+"ADDFILE"
460 CHAIN DRIVEID$+"COPFILE"
470 CHAIN DRIVEID$+"CHGFILE"
480 CHAIN DRIVEID$+"PRTFILE"
490 CHAIN DRIVEID$+"LISTFILE"
500 CHAIN DRIVEID$+"REORFILE"
510 CHAIN DRIVEID$+"BUILFILE"
520 CHAIN DRIVEID$+"STATFILE"
530 CLS
531 KEY ON
532 END
534 REM FOLLOWING CODE NOT NOW USED
540 PRINT " "
550 PRINT " PLACE DOS DISKETTE IN DRIVE A"
551 PRINT " PRESS ANY KEY TO PROCEED
552 K$ = INKEY$: IF K$ = "" THEN 552
553 CLS
554 CHAIN "IBMPMENU"
600 CHAIN DRIVEID$+"FILEFILE"
LISTFILE.BAS
1 DIM LARRAY$(56),RECARRY(19)
5 COMMON DRIVEID$,FILEID$
10 SCREEN 0,1
20 COLOR 15,9,4
30 RECNUM = 1
40 OPEN DRIVEID$+FILEID$+".EZF" AS #1 LEN=128
50 FIELD #1,2 AS BUCKET1$, 2 AS BUCKET2$,2 AS BUCKET3$,2 AS BUCKET4$,39 AS LINE1$,1 AS F1$,39 AS LINE2$,1 AS F2$,39 AS LINE3$,1 AS F3$
70 CLS
71 ON ERROR GOTO 1200
75 RECNUM = 1
80 PRINT " "
90 PRINT " PRINT LIST "
100 PRINT " "
110 PRINT " "
120 INPUT " SEARCH FOR ==>";SEARCH$
121 GET #1,1
122 MAXNUM = CVI(BUCKET3$)
123 COMPNAM$ = LINE1$
124 PURP$ = LINE2$
130 RECNUM = RECNUM
132 IF RECNUM = 0 THEN 1000
135 IF RECNUM > MAXNUM THEN 1000
140 IF RECNUM < 2 THEN RECNUM = 2
150 GET #1, RECNUM
160 X=INSTR(LINE1$,SEARCH$)
170 IF X = 0 THEN 180 ELSE 290
180 X=INSTR(LINE2$,SEARCH$)
190 IF X = 0 THEN 200 ELSE 290
200 X=INSTR(LINE3$,SEARCH$)
210 IF X = 0 THEN RECNUM = RECNUM + 1:GOTO 130
290 IF CVI(BUCKET4$) = 3 THEN GOSUB 600
291 TOSUB = CVI(BUCKET3$)
300 CATG$=LINE1$
310 SUBJ$=LINE2$
320 TIMESTAMP$=LINE3$
325 RECNUM = CVI(BUCKET2$)
330 GOSUB 700
335 IF TOSUB = 0 THEN GOTO 500
338 X=0
340 FOR I= 1 TO 48 STEP 3
345 IF TOSUB = 0 THEN 370
350 GET #1,TOSUB
353 X = X+1
355 RECARRY(X) = TOSUB
360 LARRAY$(I) = LINE1$
362 LARRAY$(I+1) = LINE2$
364 LARRAY$(I+2) = LINE3$
366 TOSUB = CVI(BUCKET2$)
368 IF TOSUB = 0 THEN GOSUB 400
370 NEXT
380 IF TOSUB = 0 THEN GOTO 500
385 GOSUB 400
386 GOTO 330
387 LOCATE 23,8
390 K$=INKEY$: IF K$="" THEN 390
391 IF K$=" " THEN GOTO 330
392 IF K$=CHR$(27) THEN GOTO 1000
393 IF K$="t" THEN GOTO 70
394 IF K$="T" THEN GOTO 70
397 GOTO 390
400 FOR I2=1 TO I+2
405 K$=INKEY$
406 IF K$=CHR$(27) THEN PRINT " Display aborted":GOTO 1015
410 LPRINT SPACE$(20);LARRAY$(I2)
414 LNO=CSRLIN-1
420 NEXT
430 RETURN
500 LOCATE 23,8
502 PRINT " SELECTION COMPLETE"
503 GOTO 130
505 K$=INKEY$:IF K$="" THEN 505
510 IF K$=" " THEN GOTO 130
520 IF K$=CHR$(27) THEN GOTO 1000
530 IF K$="t" THEN GOTO 70
540 IF K$="T" THEN GOTO 70
550 GOTO 505
600 CATGREC = CVI(BUCKET1$)
610 GET #1,CATGREC
620 RETURN
700 CLS
701 K$=INKEY$
702 COLOR 15,0
705 LOCATE 25,4
706 PRINT "spacebar=CONT Esc=EXIT T=RESTART"
707 COLOR 15,9,4
708 IF K$=CHR$(27) THEN PRINT " Display aborted":GOTO 1015
709 LPRINT CHR$(12)
710 LPRINT STRING$(1,188);STRING$(77,172);STRING$(1,204)
711 LPRINT STRING$(1,181);COMPNAM$;SPACE$(38);STRING$(1,202)
712 LPRINT STRING$(1,181);PURP$;SPACE$(38);STRING$(1,202)
713 LPRINT STRING$(1,181);"CATEGORY - ";CATG$;SPACE$(27);STRING$(1,202)
714 LPRINT STRING$(1,181);"PURPOSE - ";SUBJ$;SPACE$(27);STRING$(1,202)
715 LPRINT STRING$(1,173);STRING$(77,172);STRING$(1,174)
716 LPRINT " "
720 RETURN
1000 CLS
1005 LOCATE 18,8
1010 PRINT "DISPLAY COMPLETE"
1015 CLOSE #1
1020 CHAIN DRIVEID$+"FILEMENU"
1200 IF ERR=24 THEN RESUME
1201 IF ERR = 27 THE PRINT " Turn printer on": RESUME
1202 PRINT " Error encountered"
1203 PRINT " Code = ";ERR
1204 RESUME
MONOCLKF.DOC
THIS IS FOR REAL THE FINAL, COMPLETE, DEBUGGED VERSION
OF MY CLOCK DISPLAY PROGRAM. USE THE BIN2HEX PROGRAM TO
CONVERT MONOCLKF.HEX TO COM FORMAT. THE PROGRAM
WILL PUT THE CURRENT TIME OF DAY IN THE UPPER RIGHT
CORNER OF A MONOCHROME DISPLAY. THE TIME DISPLAY
MAY BE TOGGLED ON AND OFF BY RUNNING MONOCLKF OR BY
EXECUTING AN 'INT 44' INSTRUCTION FROM WITHIN A
PROGRAM.
MONOFILE.BAS
5 COMMON DRIVEID$,FILEID$
8 CLS
10 DEF SEG=0:A=PEEK(&H410):POKE &H410,A OR &H30:WIDTH 80:LOCATE ,,1,12,13:COLOR 15,9,4:CLS:KEY OFF
20 CHAIN DRIVEID$+"FILEMENU"
SPEC-OCC.BAS
10 KEY OFF:CLS
20 SCREEN 0
30 WIDTH 40
40 PRINT"░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░"
50 PRINT"░┌───────────────────────────────────┐░"
60 PRINT"░│ │░"
70 PRINT"░│ 6017-A.BAS │░"
80 PRINT"░│ SPECIAL OCCASIONS │░"
90 PRINT"░│ │░"
100 PRINT"░│ │░"
110 PRINT"░│ BROUGHT TO YOU BY THE MEMBERS OF │░"
120 PRINT"░│ ▄▄▄▄▄ ▄▄▄▄▄ ▄▄▄▄▄ ▄▄▄▄▄ │░"
130 PRINT"░│ █ █ █ █ █ █ │░"
140 PRINT"░│ █ █▄▄▄█ █ █ █ │░"
150 PRINT"░│ █ █ █ █ █ │░"
160 PRINT"░│ ▄▄█▄▄ █ █▄▄▄▄ █▄▄▄█ │░"
170 PRINT"░│ │░"
180 PRINT"░│ International PC Owners │░"
190 PRINT"░│ │░"
200 PRINT"░│P.O. Box 10426, Pittsburgh PA 15234│░"
210 PRINT"░│ │░"
220 PRINT"░└───────────────────────────────────┘░"
230 PRINT"░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░"
240 PRINT
250 PRINT " PRESS ANY KEY TO CONTINUE
260 A$=INKEY$: IF A$="" THEN 260
270 WIDTH 80
280 CLS
1000 '**********************************
1010 '** **
1020 '** SPECIAL OCCASIONS **
1030 '** by PHIL MICHITSCH **
1040 '** **
1050 '** IBM 64K, 1 DISK DRIVE **
1060 '** PRINTER OPTIONAL **
1070 '** 40 COLUMN SCREEN **
1080 '** MONO OR COLOR **
1090 '** (USE MODE COMMAND **
1100 '** TO SWITCH BEFORE **
1110 '** RUNNING PROGRAM) **
1120 '** **
1130 '**********************************
1140 GOSUB 3740
1150 CLS:KEY OFF:S=0
1160 COLOR 7,0:WIDTH 40
1170 FOR J= 10 TO 32
1180 LOCATE 5,J,0:PRINT CHR$ (220)
1190 NEXT J
1200 FOR J= 10 TO 32
1210 LOCATE 9,J:PRINT CHR$ (223)
1220 NEXT J
1230 FOR J= 6 TO 8
1240 LOCATE J,10:PRINT CHR$ (219)
1250 NEXT J
1260 FOR J= 6 TO 8
1270 LOCATE J,32:PRINT CHR$ (219)
1280 NEXT J
1290 COLOR 0,7
1300 LOCATE 7,13
1310 PRINT "SPECIAL OCCASIONS"
1320 COLOR 7,0
1330 FOR J= 8 TO 34
1340 LOCATE 4,J:PRINT CHR$ (176)
1350 NEXT J
1360 FOR J= 8 TO 34
1370 LOCATE 10,J:PRINT CHR$ (176)
1380 NEXT J
1390 FOR J= 5 TO 9
1400 LOCATE J,8:PRINT CHR$ (176)
1410 NEXT J
1420 FOR J= 5 TO 9
1430 LOCATE J,34:PRINT CHR$ (176)
1440 NEXT J
1450 COLOR 9,0
1460 LOCATE 12,19:PRINT "MENU"
1470 COLOR 7,0
1480 LOCATE 14,13:PRINT "1) ADD OCCASION"
1490 LOCATE 16,13:PRINT "2) DELETE OCCASION"
1500 LOCATE 18,13:PRINT "3) DISPLAY LISTING
1510 BEEP
1520 LOCATE 21,7:PRINT "PLEASE CHOOSE ENTRY 1,2 OR 3"
1530 LET X$="0"
1540 X$=INKEY$
1550 IF X$>"0" THEN 1560 ELSE 1540
1560 IF X$="1" THEN 1680
1570 IF X$="2" THEN 2080
1580 IF X$="3" THEN 2550
1590 IF X$="0" THEN 1540
1600 COLOR 25,0
1610 LOCATE 23,12:PRINT "WRONG ENTRY - RETRY"
1620 COLOR 7,0
1630 FOR X= 1 TO 1700
1640 NEXT X
1650 LOCATE 23,12 :PRINT " "
1660 BEEP
1670 GOTO 1530
1680 GOSUB 3670
1690 REM ROUTINE TO ADD AND SORT NEW OCCASION
1700 COLOR 9,0: LOCATE 12,15
1710 PRINT "ADD OCCASION"
1720 COLOR 7,0:LOCATE 14,1
1730 BEEP
1740 INPUT "ENTER NAME OF CELEBRANT ",A$
1750 BEEP
1760 LOCATE 16,1,0:INPUT "ENTER MONTH OF OCCASION ",B$
1770 FOR Y=1 TO 12
1780 IF B$=Z$(Y) THEN 1900
1790 NEXT Y
1800 FOR X=1 TO 30
1810 LOCATE 18,14,0:PRINT "THE MONTH INPUT"
1820 LOCATE 19,9 :PRINT "IS INCORRECT,PLEASE RETRY
1830 LOCATE 20,11 :PRINT "(USE CAPITAL LETTERS)"
1840 NEXT X
1850 LOCATE 18,1:PRINT" "
1860 PRINT" "
1870 PRINT" "
1880 LOCATE 16,1,0:PRINT" "
1890 GOTO 1750
1900 LOCATE 18,1,0:INPUT "ENTER DAY OF MONTH (1-31) ",C
1910 IF C >31 OR C=0 GOTO 1930
1920 GOTO 1990
1930 FOR X= 1 TO 40:LOCATE 20,1
1940 PRINT "PLEASE USE A NUMBER BETWEEN 01-31"
1950 NEXT X
1960 LOCATE 20,1:PRINT" "
1970 LOCATE 18,1:PRINT" "
1980 GOTO 1900
1990 LOCATE 20,1,0:INPUT "PLEASE INPUT TYPE OF OCCASION ",D$
2000 LOCATE 22,1,0:PRINT "A FILE WITH THIS INFO IS NOW BEING CREATED"
2010 OPEN B$ FOR APPEND AS #1
2020 WRITE#1,A$,B$,C,D$
2030 FOR X=1 TO 1000
2040 NEXT X
2050 CLOSE 1
2060 GOSUB 3670
2070 GOTO 1150
2080 GOSUB 3670
2090 LOCATE 12,12:PRINT "PLEASE ENTER BELOW"
2100 LOCATE 14,10:PRINT "THE MONTH IN WHICH THE"
2110 LOCATE 16,11:PRINT "PERSON TO BE DELETED"
2120 LOCATE 18,16:PRINT "APPEARS IN"
2130 COLOR 0,7:BEEP
2140 LOCATE 20,13,1:PRINT " MONTH ";:COLOR 7,0
2150 INPUT " ",MONTH$
2160 FOR Y=1 TO 12
2170 IF MONTH$=Z$(Y) THEN 2240
2180 NEXT Y
2190 FOR X= 1 TO 60
2200 LOCATE 22,13,0:PRINT "WRONG INPUT,RETRY"
2210 NEXT X
2220 LOCATE 22,1,0:PRINT SPC(40)
2230 GOTO 2080
2240 OPEN MONTH$ FOR INPUT AS #1
2250 DIM F$(40),G$(40),H$(40),I$(40)
2260 FOR J=1 TO 40
2270 IF EOF(1) THEN 2300
2280 INPUT #1,F$(J),G$(J),H$(J),I$(J)
2290 NEXT J
2300 GOSUB 3670
2310 LOCATE 12,6,0:PRINT "THE FOLLOWING NAMES ARE LISTED"
2320 LOCATE 13,9,0:PRINT "UNDER THE MONTH ";MONTH$
2330 IF EOF(1) AND J=1 THEN 4070
2340 CLOSE 1:L=J-1:T=15
2350 FOR K=1 TO L
2360 LOCATE (T),12,0
2370 PRINT F$(K)
2380 T=T+1
2390 NEXT K
2400 LOCATE 22,3,0:PRINT "ENTER EXACTLY AS ABOVE,THE NAME OF"
2410 LOCATE 23,8,0:PRINT "THE PERSON TO BE DELETED"
2420 LOCATE 24,10,1
2430 INPUT;N$
2440 OPEN MONTH$ FOR INPUT AS #1
2450 OPEN "TEMPOCCA" FOR OUTPUT AS #2
2460 IF EOF (1) THEN 2510
2470 INPUT#1,FF$,GG$,HH$,II$
2480 IF FF$=N$ THEN 2460
2490 WRITE#2,FF$,GG$,HH$,II$
2500 GOTO 2460
2510 CLOSE
2520 KILL MONTH$
2530 NAME "TEMPOCCA" AS MONTH$
2540 GOTO 1150
2550 REM ROUTINE TO DISPLAY/PRINT ANY MONTH/MONTHS OCCASIONS
2560 GOSUB 3670
2570 ON ERROR GOTO 3810
2580 LOCATE 12,7,0 :PRINT "PLEASE ENTER BELOW, THE MONTH "
2590 LOCATE 14,7 :PRINT "YOU WOULD LIKE TO BE DISPLAYED"
2600 LOCATE 16,14,1 :BEEP :COLOR 0,7 :PRINT " MONTH ";:COLOR 7,0:
2610 INPUT " ",E$
2620 FOR Y=1 TO 12
2630 IF E$=Z$(Y) THEN 2760
2640 NEXT Y
2650 FOR X=1 TO 30
2660 LOCATE 18,14,0 :PRINT "THE MONTH INPUT"
2670 LOCATE 19,9 :PRINT "IS INCORRECT ,PLEASE RETRY"
2680 LOCATE 20,11 :PRINT "(USE CAPITAL LETTERS)
2690 NEXT X
2700 LOCATE 18,1 :PRINT " "
2710 PRINT " "
2720 PRINT " "
2730 LOCATE 16,1,0:PRINT" "
2740 GOTO 2600
2750 N=10
2760 LOCATE 19,7 :PRINT "A FILE CONTAINING ALL THE INFO"
2770 IF LEN (E$)=3 THEN N=12
2780 IF LEN (E$)=4 THEN N=12
2790 IF LEN (E$)=5 THEN N=12
2800 IF LEN (E$)=6 THEN N=11
2810 IF LEN (E$)=7 THEN N=10
2820 IF LEN (E$)=8 THEN N=10
2830 IF LEN (E$)=9 THEN N=10
2840 LOCATE 21,N :PRINT "FOR THE MONTH "; E$
2850 LOCATE 23,10 :PRINT "IS NOW BEING PROCESSED"
2860 FOR X= 1 TO 1500
2870 NEXT X
2880 OPEN E$ FOR INPUT AS #1
2890 DIM F$(40),G$(40),H$(40),I$(40)
2900 FOR J=1 TO 40
2910 IF EOF(1) THEN 2990
2920 INPUT #1,F$(J),G$(J),H$(J),I$(J)
2930 NEXT J
2940 LOCATE 25,17,0:COLOR 26,0:PRINT "YOU HAVE EXCEEDED THE LIMITATIONS OF THIS PROGRAM"
2950 COLOR 7,0 :
2960 FOR X= 1 TO 6000
2970 NEXT X
2980 GOTO 1150
2990 IF EOF(1) AND J=1 THEN 4070
3000 CLOSE 1
3010 GOSUB 3670
3020 L=J-1
3030 M=12
3040 IF LEN (E$)=3 THEN M=19
3050 IF LEN (E$)=4 THEN M=18
3060 IF LEN (E$)=5 THEN M=17
3070 IF LEN (E$)=6 THEN M=17
3080 IF LEN (E$)=7 THEN M=17
3090 IF LEN (E$)=8 THEN M=16
3100 IF LEN (E$)=9 THEN M=16
3110 LOCATE 12,M
3120 COLOR 0,7:PRINT " ";E$;" "
3130 LOCATE 14,6 : COLOR 9,0:PRINT "NAME";
3140 LOCATE 14,21:PRINT "DATE";
3150 LOCATE 14,30:PRINT "OCCASION"
3160 COLOR 7,0
3170 LOCATE 16,1
3180 IF L > 4 THEN S=1
3190 FOR K=1 TO L
3200 PRINT F$(K);
3210 PRINT TAB(22) H$(K);
3220 PRINT TAB(30) I$(K)
3230 IF S=0 THEN PRINT
3240 NEXT K
3250 LOCATE 25,1:COLOR 15,0
3260 PRINT "F1-PRINT REPORT F2-RETURN TO MENU";
3270 KEY(1)ON:KEY(2)ON
3280 T$=INKEY$
3290 ON KEY (1) GOSUB 3340
3300 ON KEY (2) GOSUB 3320
3310 GOTO 3280
3320 KEY (1) OFF:KEY (2) OFF
3330 GOTO 1150
3340 REM PRINT ROUTINE
3350 KEY (1) OFF:KEY (2) OFF
3360 ESC$=CHR$(27)
3370 FOR X=1 TO 10
3380 LPRINT
3390 NEXT X
3400 LPRINT ESC$"B"
3410 LPRINT ESC$"!"
3420 LPRINT ESC$"E":LPRINT ESC$"Y"
3430 LPRINT TAB(8) "***************************"
3440 LPRINT TAB(8) "* +++++++++++++++++++++++ *"
3450 LPRINT TAB(8) "* + + *"
3460 LPRINT TAB(8) "* + SPECIAL OCCASIONS + *"
3470 LPRINT TAB(8) "* + + *"
3480 LPRINT TAB(8) "* +++++++++++++++++++++++ *"
3490 LPRINT TAB(8) "***************************"
3500 LPRINT :LPRINT
3510 LPRINT TAB(18)ESC$"X";E$;ESC$"Y"
3520 LPRINT
3530 LPRINT SPC(4)ESC$"X";" NAME ";ESC$"Y";SPC(10)ESC$"X";" DATE ";ESC$"Y";" ";ESC$"X";" OCCASION ";ESC$"Y"
3540 LPRINT
3550 P=J-1
3560 LPRINT
3570 FOR X= 1 TO P
3580 Z=LEN(F$(X))
3590 Y=(22 - Z)
3600 LPRINT F$(X);SPC(Y)H$(X);SPC(6)I$(X)
3610 LPRINT
3620 NEXT X
3630 FOR X= 1 TO 10
3640 LPRINT
3650 NEXT X
3660 GOTO 3270
3670 REM SUBROUTINE TO CLEAR THE SCREEN BELOW PICTURE
3680 Y$=" "
3690 FOR N=12 TO 23
3700 LOCATE N,1,0:PRINT Y$
3710 NEXT N
3720 RETURN
3730 PRINT"ALRIGHT"
3740 REM ROUTINE TO ASSIGN ALL THE MONTHS A STRING VAR
3750 DIM Z$(12)
3760 FOR Y=1 TO 12
3770 READ Z$(Y)
3780 NEXT Y
3790 DATA JANUARY,FEBRUARY,MARCH,APRIL,MAY,JUNE,JULY,AUGUST,SEPTEMBER,OCTOBER,NOVEMBER,DECEMBER
3800 RETURN
3810 REM ERROR ROUTINE -TRIED TO OPEN FILE THAT WAS NON-EXISTANT
3820 IF ERR=27 THEN GOTO 3970
3830 IF ERR=53 THEN GOTO 3850
3840 RESUME NEXT
3850 GOSUB 3670
3860 LOCATE 13,5,0 :PRINT "THERE IS CURRENTLY NO INFORMATION "
3870 LOCATE 15,5,0 :PRINT "IN THE FILE FOR THE MONTH ";E$
3880 LOCATE 17,5,0 :PRINT "YOU CAN MAKE AN ADDITION TO THIS"
3890 LOCATE 19,7,0 :PRINT "FILE IF YOU LIKE BY ENTERING"
3900 LOCATE 21,8,0 :PRINT "THE #1 ON THE MENU SCREEN"
3910 OPEN E$ FOR APPEND AS #1
3920 CLOSE
3930 FOR X=1 TO 80
3940 NEXT X
3950 GOSUB 3670
3960 GOTO 1450
3970 GOSUB 3670
3980 LOCATE 13,5,0 :PRINT "THE CURRENT OPERATION CANNOT BE "
3990 LOCATE 15,5,0 :PRINT "COMPLETED BECAUSE THE PRINTER IS"
4000 LOCATE 17,13,0 :PRINT "NOT OPERATIONAL"
4010 LOCATE 19,5,0 :PRINT "PLEASE RETURN PRINTER TO ON-LINE"
4020 LOCATE 21,9,0 :PRINT "BEFORE HITTING F1 AGAIN"
4030 FOR X=1 TO 3000
4040 NEXT X
4050 CLOSE 1
4060 RESUME 3010
4070 GOSUB 3670
4080 LOCATE 17,8,0 :COLOR 15,0
4090 PRINT "THIS FILE IS CURRENTLY EMPTY "
4100 FOR X=1 TO 2000
4110 NEXT X
4120 GOSUB 3670
4130 CLOSE 1
4140 GOTO 1150
4150 END
SPEC-OCC.DOC
10 PRINT "SPECIAL OCCASIONS by Phil Michitsch "
20 PRINT "Run name OCCASION under BASICA"
30 PRINT "( 9614 Bytes )"
40 PRINT "Requirements: IBM 64K,DOS 2.0,40-character screen"
50 PRINT "either monochrome or color (switched via mode command"
60 PRINT "before running program). Printer optional for hard copy report"
70 PRINT "Note: a C-ITOH (PROFEEL) printer was used creating this program"
80 PRINT " but any IBM compatible printer will work."
90 PRINT
100 PRINT "A handy program,menu driven with error checking and very user-friendly"
110 PRINT "to add,delete and generate a hard copy report of all birthdays,"
120 PRINT "anniversarys,holidays etc. with name,dates and type of occasion input"
130 PRINT "into a file. To get a report via screen or printer;just type in"
140 PRINT "the month you want a listing for. Very handy for remembering to"
150 PRINT "send out birthday cards."
160 END
STATFILE.BAS
20 COMMON DRIVEID$,FILEID$
30 SCREEN 0,1
110 KEY OFF
120 COLOR 15,9,4
130 CLS
140 PRINT " "
150 PRINT " "
160 PRINT " EASY-FILE STATUS REPORT"
170 PRINT " "
180 PRINT " "
200 PRINT " FILEID -- "+DRIVEID$+FILEID$+".EZF"
210 PRINT " "
290 OPEN DRIVEID$+FILEID$+".EZF" AS #1 LEN=128
300 FIELD #1, 2 AS BUCKET1$, 2 AS BUCKET2$, 2 AS BUCKET3$, 2 AS BUCKET4$, 40 AS LINE1$, 40 AS LINE2$, 40 AS LINE3$
305 GET #1,1
310 PRINT " NUMBER CATEGORIES --";CVI(BUCKET4$)
320 LSET BUCKET2$=MKI$(2)
330 PRINT " "
340 PRINT " NUMBER RECORDS --";CVI(BUCKET3$)
380 PRINT " "
383 PRINT " "
384 PRINT " "
385 PRINT " "
388 PRINT " "
390 PRINT " Press space bar to return to menu"
400 K$=INKEY$:IF K$="" THEN 400
410 IF K$=" " THEN 500
420 GOTO 400
500 CLOSE #1
510 CHAIN DRIVEID$+"FILEMENU"
TCLOCK.BAS
1000 ' -----------------------------------------------------------------------
1010 ' PROGRAM NAME = TCLOCK
1020 ' FUNCTION = DATE AND TIME DISPLAY ON MONOCHROME
1030 ' -----------------------------------------------------------------------
1040 ' AUTHOR = WILLIAM T. VATH
1050 ' -----------------------------------------------------------------------
1060 '
1070 ' To See Instruction Menu, Type Character ?.(INSTRUCTIONS)
1080 '
1090 ' To Set Alarm Type Character A.(ALARM)
1100 '
1110 ' To Switch From 12 Hour To 24 Hour Display, Type Character M.(MODE)
1120 '
1130 ' To Turn Time Change Beep On Or Off, Type Character B.(BEEP)
1140 '
1150 ' To Turn Chimes On Or Off, Type Character C.(CHIME)
1160 '
1170 ' To Set Date & Time, Type Character S.(SET)
1180 '
1190 ' To Cancel The Program And Return To Caller, Hit The ESC Key.
1200 '
1210 ' -----------------------------------------------------------------------
1220 '
1230 DEFINT A-Z:DIM ALARM$(6),ALDESC$(6):AL$=" : ":DES$=STRING$(50,32)
1240 DEF SEG=&H40:POKE &H17,64
1250 FOR I=1 TO 6:ALARM$(I)=AL$:ALDESC$(I)=DES$:NEXT
1260 KEY OFF:WIDTH 80:COLOR 7,0:CLS
1270 D1SAVE=99:D2SAVE=99:D3SAVE=99:D4SAVE=99:TLSAVE=99:TR1SAVE=99:TR2SAVE=99
1280 SW1$="1":SW2$="0":BP1$="1":BP2$="0":CH1$="0":CH2$="1":AL1$="0"
1290 ET1$="0":ET2$="1"
1300 ' -----------------------------------------------------------------------
1310 ' PRINT BIG BOX
1320 ' -----------------------------------------------------------------------
1330 '
1340 CLS:LOCATE 1,1,0:COLOR 7,0:PRINT CHR$(201)+STRING$(77,205)+CHR$(187);
1350 FOR I=2 TO 24
1360 LOCATE I,1:PRINT CHR$(186);:LOCATE I,79:PRINT CHR$(186);
1370 NEXT
1380 LOCATE 25,1:PRINT CHR$(200)+STRING$(77,205)+CHR$(188);
1390 ' -----------------------------------------------------------------------
1400 ' PRINT CENTER LINE
1410 ' -----------------------------------------------------------------------
1420 '
1430 LOCATE 13,1:COLOR 7,0:PRINT CHR$(204)+STRING$(77,205)+CHR$(185);
1440 ' -----------------------------------------------------------------------
1450 ' PRINT DATE BOX
1460 ' -----------------------------------------------------------------------
1470 '
1480 LOCATE 6,2:COLOR 7,0:PRINT CHR$(201)+STRING$(4,205)+CHR$(187);
1490 LOCATE 7,2:PRINT CHR$(186)+STRING$(4,32)+CHR$(186);
1500 LOCATE 8,2:PRINT CHR$(200)+STRING$(4,205)+CHR$(188);
1510 LOCATE 7,3:PRINT "DATE";
1520 ' -----------------------------------------------------------------------
1530 ' PRINT DATE DASH
1540 ' -----------------------------------------------------------------------
1550 '
1560 LOCATE 7,36:COLOR 0,7:PRINT STRING$(4,32)
1570 ' -----------------------------------------------------------------------
1580 ' PRINT YEAR BOX
1590 ' -----------------------------------------------------------------------
1600 '
1610 LOCATE 9,72:COLOR 7,0:PRINT CHR$(201)+CHR$(205)+CHR$(205)+CHR$(187);
1620 LOCATE 10,72:PRINT CHR$(186)+CHR$(32)+CHR$(32)+CHR$(186);
1630 LOCATE 11,72:PRINT CHR$(200)+CHR$(205)+CHR$(205)+CHR$(188);
1640 ' -----------------------------------------------------------------------
1650 ' PRINT TIME BOX
1660 ' -----------------------------------------------------------------------
1670 '
1680 LOCATE 18,2:COLOR 7,0:PRINT CHR$(201)+STRING$(4,205)+CHR$(187);
1690 LOCATE 19,2:PRINT CHR$(186)+STRING$(4,32)+CHR$(186);
1700 LOCATE 20,2:PRINT CHR$(200)+STRING$(4,205)+CHR$(188);
1710 LOCATE 19,3:PRINT "TIME";
1720 ' -----------------------------------------------------------------------
1730 ' PRINT TIME COLON
1740 ' -----------------------------------------------------------------------
1750 '
1760 LOCATE 17,37:COLOR 0,7:PRINT SPACE$(2):LOCATE 21,37:PRINT SPACE$(2)
1770 ' -----------------------------------------------------------------------
1780 ' PRINT SECONDS BOX
1790 ' -----------------------------------------------------------------------
1800 '
1810 LOCATE 21,72:COLOR 7,0:PRINT CHR$(201)+CHR$(205)+CHR$(205)+CHR$(187);
1820 LOCATE 22,72:PRINT CHR$(186)+CHR$(32)+CHR$(32)+CHR$(186);
1830 LOCATE 23,72:PRINT CHR$(200)+CHR$(205)+CHR$(205)+CHR$(188);
1840 ' -----------------------------------------------------------------------
1850 ' GET DATE
1860 ' -----------------------------------------------------------------------
1870 '
1880 D$=DATE$
1890 D1$=LEFT$(D$,1):D2$=MID$(D$,2,1):D3$=MID$(D$,4,1):D4$=MID$(D$,5,1)
1900 D1=VAL(D1$):D2=VAL(D2$):D3=VAL(D3$):D4=VAL(D4$):YR$=RIGHT$(D$,2)
1910 LOCATE 10,73:COLOR 7,0:PRINT YR$;
1920 ' -----------------------------------------------------------------------
1930 ' GET TIME
1940 ' -----------------------------------------------------------------------
1950 '
1960 T$=TIME$:TL$=LEFT$(T$,2)
1970 TR$=MID$(T$,4,2):TR1$=MID$(T$,4,1):TR2$=MID$(T$,5,1)
1980 TL=VAL(TL$):TR=VAL(TR$):TR1=VAL(TR1$):TR2=VAL(TR2$)
1990 IF SW1$="1" THEN 2000 ELSE 2050
2000 IF TL>11 AND TR>0 THEN LOCATE 15,72:COLOR 1,0:PRINT"P M":GOTO 2020
2010 LOCATE 15,72:COLOR 1,0:PRINT "A M";
2020 '
2030 IF TL>12 THEN TL=TL-12
2050 '
2060 IF SW1$="0" THEN LOCATE 15,72:COLOR 1,0:PRINT "MIL";
2070 SEC$=RIGHT$(T$,2):LOCATE 22,73:COLOR 7,0:PRINT SEC$;:COLOR 0,7
2080 LOCATE 24,2:COLOR 7,0:IF CH1$="1" THEN PRINT CHR$(14); ELSE PRINT" ";
2090 LOCATE 24,78:COLOR 7,0:IF BP1$="1" THEN PRINT CHR$(46); ELSE PRINT" ";
2100 ' -----------------------------------------------------------------------
2110 ' CHECK ALARM TIMES
2120 ' -----------------------------------------------------------------------
2130 '
2140 AL1$="0"
2150 TALARM$=LEFT$(T$,5)
2160 FOR I=1 TO 6
2170 IF ALARM$(I)=" : " OR ALARM$(I)=" :" THEN 2180 ELSE AL1$="1"
2180 IF TALARM$=ALARM$(I) THEN GOTO 5610
2190 NEXT
2200 IF AL1$="1" THEN LOCATE 2,2:PRINT CHR$(64);
2210 ' -----------------------------------------------------------------------
2220 ' CHECK RESPONSE IF ANY
2230 ' -----------------------------------------------------------------------
2240 '
2250 RESP$=INKEY$
2260 IF RESP$=CHR$(27) THEN 6000
2270 IF RESP$="M" THEN SWAP SW1$,SW2$
2280 IF SW1$="0" THEN CH1$="0":CH2$="1"
2290 IF RESP$="B" THEN SWAP BP1$,BP2$
2300 IF RESP$="E" THEN SWAP ET1$,ET2$
2310 IF ET1$="1" THEN CH1$="0":CH2$="1":BP1$="0":BP2$="1"
2320 IF RESP$="C" THEN SWAP CH1$,CH2$
2330 IF CH1$="1" THEN BP1$="0":BP2$="1":SW1$="1":SW2$="0":ET1$="0":ET2$="1"
2340 IF RESP$="R" THEN CNT1=0:CNT2=0:CNT3=0
2350 IF RESP$="S" THEN GOTO 4620
2360 IF RESP$="A" THEN GOTO 4810
2370 IF RESP$="?" THEN GOTO 5750
2380 ' -----------------------------------------------------------------------
2390 ' DISPLAY DATE DIGIT 1
2400 ' -----------------------------------------------------------------------
2410 '
2420 A=3
2430 IF D1=D1SAVE THEN 2520
2440 B=10
2450 IF D1=0 THEN 2480
2460 GOSUB 4180
2470 ON D1 GOSUB 3460,3520,3590,3650,3730,3790,3860,3920,4010
2480 D1SAVE=D1
2490 ' -----------------------------------------------------------------------
2500 ' DISPLAY DATE DIGIT 2
2510 ' -----------------------------------------------------------------------
2520 '
2530 IF D2=D2SAVE THEN 2620
2540 B=25
2550 GOSUB 4180
2560 IF D2=0 THEN GOSUB 4080
2570 ON D2 GOSUB 3460,3520,3590,3650,3730,3790,3860,3920,4010
2580 D2SAVE=D2
2590 ' -----------------------------------------------------------------------
2600 ' DISPLAY DATE DIGIT 3
2610 ' -----------------------------------------------------------------------
2620 '
2630 IF D3=D3SAVE THEN 2720
2640 B=42
2650 GOSUB 4180
2660 IF D3=0 THEN GOSUB 4080
2670 ON D3 GOSUB 3460,3520,3590,3650,3730,3790,3860,3920,4010
2680 D3SAVE=D3
2690 ' -----------------------------------------------------------------------
2700 ' DISPLAY DATE DIGIT 4
2710 ' -----------------------------------------------------------------------
2720 '
2730 IF D4=D4SAVE THEN 2820
2740 B=57
2750 GOSUB 4180
2760 IF D4=0 THEN GOSUB 4080
2770 ON D4 GOSUB 3460,3520,3590,3650,3730,3790,3860,3920,4010
2780 D4SAVE=D4
2790 ' -----------------------------------------------------------------------
2800 ' DISPLAY TIME DIGIT 1
2810 ' -----------------------------------------------------------------------
2820 '
2830 A=15
2840 IF TL=TLSAVE THEN 3030
2850 IF BP1$="1" THEN 2860 ELSE 2870
2860 SOUND 3000,2
2870 B=10
2880 GOSUB 4180
2890 IF TL=0 THEN GOTO 2940
2900 ON TL GOSUB 2940,2940,2940,2940,2940,2940,2940,2940,2940,3460,3460,3460,3460,3460,3460,3460,3460,3460,3460,3520,3520,3520,3520,3520
2910 ' -----------------------------------------------------------------------
2920 ' DISPLAY TIME DIGIT 2
2930 ' -----------------------------------------------------------------------
2940 '
2950 B=25
2960 GOSUB 4180
2970 IF TL=0 THEN GOSUB 4080
2980 ON TL GOSUB 3460,3520,3590,3650,3730,3790,3860,3920,4010,4080,3460,3520,3590,3650,3730,3790,3860,3920,4010,4080,3460,3520,3590,3650
2990 TLSAVE=TL
3000 ' -----------------------------------------------------------------------
3010 ' DISPLAY TIME DIGIT 3
3020 ' -----------------------------------------------------------------------
3030 '
3040 IF TR1=TR1SAVE THEN 3130
3050 B=42
3060 GOSUB 4180
3070 IF TR1=0 THEN GOSUB 4080
3080 ON TR1 GOSUB 3460,3520,3590,3650,3730,3790,3860,3920,4010
3090 TR1SAVE=TR1
3100 ' -----------------------------------------------------------------------
3110 ' DISPLAY ELAPSED TIME
3120 ' -----------------------------------------------------------------------
3130 '
3140 IF ET1$="0" THEN 3210
3150 '
3160 IF SEC$=SECHOLD$ THEN 3210
3170 CNT3=CNT3+1
3180 IF CNT3>=60 THEN CNT2=CNT2+1:CNT3=0
3190 IF CNT2>=60 THEN CNT1=CNT1+1:CNT2=0
3200 SECHOLD$=SEC$
3210 '
3220 IF CNT1+CNT2+CNT3=0 THEN LOCATE 2,71:COLOR 7,0:PRINT SPACE$(8):GOTO 3270
3230 LOCATE 2,71:COLOR 7,0:PRINT USING"##";CNT1;
3240 LOCATE 2,73:PRINT USING":##";CNT2;
3250 LOCATE 2,76:PRINT USING":##";CNT3;
3260 ' -----------------------------------------------------------------------
3270 ' DISPLAY TIME DIGIT 4
3280 ' -----------------------------------------------------------------------
3290 '
3300 IF TR2=TR2SAVE THEN 1850
3310 IF BP1$="1" THEN 3320 ELSE 3330
3320 SOUND 4000,1
3330 B=57
3340 GOSUB 4180
3350 IF TR2=0 THEN GOSUB 4080
3360 ON TR2 GOSUB 3460,3520,3590,3650,3730,3790,3860,3920,4010
3370 TR2SAVE=TR2
3380 IF CH1$="1" AND TR$="15" THEN GOSUB 4270
3390 IF CH1$="1" AND TR$="30" THEN GOSUB 4330
3400 IF CH1$="1" AND TR$="45" THEN GOSUB 4400
3410 IF CH1$="1" AND TR$="00" THEN GOSUB 4490
3420 GOTO 1850
3430 ' -----------------------------------------------------------------------
3440 ' DIGIT SUBROUTINES
3450 ' -----------------------------------------------------------------------
3460 ' 1
3470 LOCATE A+0,B+4:PRINT SPACE$(2);:LOCATE A+1,B+4:PRINT SPACE$(2);
3480 LOCATE A+2,B+4:PRINT SPACE$(2);:LOCATE A+3,B+4:PRINT SPACE$(2);
3490 LOCATE A+4,B+4:PRINT SPACE$(2);:LOCATE A+5,B+4:PRINT SPACE$(2);
3500 LOCATE A+6,B+4:PRINT SPACE$(2);:LOCATE A+7,B+4:PRINT SPACE$(2);
3510 LOCATE A+8,B+4:PRINT SPACE$(2);:RETURN
3520 ' 2
3530 LOCATE A+0,B+0:PRINT SPACE$(9);:LOCATE A+1,B+7:PRINT SPACE$(2);
3540 LOCATE A+2,B+7:PRINT SPACE$(2);:LOCATE A+3,B+7:PRINT SPACE$(2);
3550 LOCATE A+4,B+0:PRINT SPACE$(9);:LOCATE A+5,B+0:PRINT SPACE$(2);
3560 LOCATE A+6,B+0:PRINT SPACE$(2);:LOCATE A+7,B+0:PRINT SPACE$(2);
3570 LOCATE A+8,B+0:PRINT SPACE$(9);:RETURN
3580 RETURN
3590 ' 3
3600 LOCATE A+0,B+0:PRINT SPACE$(9);:LOCATE A+1,B+7:PRINT SPACE$(2);
3610 LOCATE A+2,B+7:PRINT SPACE$(2);:LOCATE A+3,B+7:PRINT SPACE$(2);
3620 LOCATE A+4,B+0:PRINT SPACE$(9);:LOCATE A+5,B+7:PRINT SPACE$(2);
3630 LOCATE A+6,B+7:PRINT SPACE$(2);:LOCATE A+7,B+7:PRINT SPACE$(2);
3640 LOCATE A+8,B+0:PRINT SPACE$(9);:RETURN
3650 ' 4
3660 LOCATE A+0,B+0:PRINT SPACE$(2);:LOCATE A+0,B+7:PRINT SPACE$(2);
3670 LOCATE A+1,B+0:PRINT SPACE$(2);:LOCATE A+1,B+7:PRINT SPACE$(2);
3680 LOCATE A+2,B+0:PRINT SPACE$(2);:LOCATE A+2,B+7:PRINT SPACE$(2);
3690 LOCATE A+3,B+0:PRINT SPACE$(2);:LOCATE A+3,B+7:PRINT SPACE$(2);
3700 LOCATE A+4,B+0:PRINT SPACE$(9);:LOCATE A+5,B+7:PRINT SPACE$(2);
3710 LOCATE A+6,B+7:PRINT SPACE$(2);:LOCATE A+7,B+7:PRINT SPACE$(2);
3720 LOCATE A+8,B+7:PRINT SPACE$(2);:RETURN
3730 ' 5
3740 LOCATE A+0,B+0:PRINT SPACE$(9);:LOCATE A+1,B+0:PRINT SPACE$(2);
3750 LOCATE A+2,B+0:PRINT SPACE$(2);:LOCATE A+3,B+0:PRINT SPACE$(2);
3760 LOCATE A+4,B+0:PRINT SPACE$(9);:LOCATE A+5,B+7:PRINT SPACE$(2);
3770 LOCATE A+6,B+7:PRINT SPACE$(2);:LOCATE A+7,B+7:PRINT SPACE$(2);
3780 LOCATE A+8,B+0:PRINT SPACE$(9);:RETURN
3790 ' 6
3800 LOCATE A+0,B+0:PRINT SPACE$(9);:LOCATE A+1,B+0:PRINT SPACE$(2);
3810 LOCATE A+2,B+0:PRINT SPACE$(2);:LOCATE A+3,B+0:PRINT SPACE$(2);
3820 LOCATE A+4,B+0:PRINT SPACE$(9);:LOCATE A+5,B+0:PRINT SPACE$(2);
3830 LOCATE A+5,B+7:PRINT SPACE$(2);:LOCATE A+6,B+0:PRINT SPACE$(2);
3840 LOCATE A+6,B+7:PRINT SPACE$(2);:LOCATE A+7,B+0:PRINT SPACE$(2);
3850 LOCATE A+7,B+7:PRINT SPACE$(2);:LOCATE A+8,B+0:PRINT SPACE$(9);:RETURN
3860 ' 7
3870 LOCATE A+0,B+0:PRINT SPACE$(9);:LOCATE A+1,B+7:PRINT SPACE$(2);
3880 LOCATE A+2,B+7:PRINT SPACE$(2);:LOCATE A+3,B+7:PRINT SPACE$(2);
3890 LOCATE A+4,B+7:PRINT SPACE$(2);:LOCATE A+5,B+7:PRINT SPACE$(2);
3900 LOCATE A+6,B+7:PRINT SPACE$(2);:LOCATE A+7,B+7:PRINT SPACE$(2);
3910 LOCATE A+8,B+7:PRINT SPACE$(2);:RETURN
3920 ' 8
3930 LOCATE A+0,B+0:PRINT SPACE$(9);:LOCATE A+1,B+0:PRINT SPACE$(2);
3940 LOCATE A+1,B+7:PRINT SPACE$(2);:LOCATE A+2,B+0:PRINT SPACE$(2);
3950 LOCATE A+2,B+7:PRINT SPACE$(2);:LOCATE A+3,B+0:PRINT SPACE$(2);
3960 LOCATE A+3,B+7:PRINT SPACE$(2);:LOCATE A+4,B+0:PRINT SPACE$(9);
3970 LOCATE A+5,B+0:PRINT SPACE$(2);:LOCATE A+5,B+7:PRINT SPACE$(2);
3980 LOCATE A+6,B+0:PRINT SPACE$(2);:LOCATE A+6,B+7:PRINT SPACE$(2);
3990 LOCATE A+7,B+0:PRINT SPACE$(2);:LOCATE A+7,B+7:PRINT SPACE$(2);
4000 LOCATE A+8,B+0:PRINT SPACE$(9);:RETURN
4010 ' 9
4020 LOCATE A+0,B+0:PRINT SPACE$(9);:LOCATE A+1,B+0:PRINT SPACE$(2);
4030 LOCATE A+1,B+7:PRINT SPACE$(2);:LOCATE A+2,B+0:PRINT SPACE$(2);
4040 LOCATE A+2,B+7:PRINT SPACE$(2);:LOCATE A+3,B+0:PRINT SPACE$(2);
4050 LOCATE A+3,B+7:PRINT SPACE$(2);:LOCATE A+4,B+0:PRINT SPACE$(9);
4060 LOCATE A+5,B+7:PRINT SPACE$(2);:LOCATE A+6,B+7:PRINT SPACE$(2);
4070 LOCATE A+7,B+7:PRINT SPACE$(2);:LOCATE A+8,B+0:PRINT SPACE$(9);:RETURN
4080 ' 0
4090 LOCATE A+0,B+0:PRINT SPACE$(9);:LOCATE A+1,B+0:PRINT SPACE$(2);
4100 LOCATE A+1,B+7:PRINT SPACE$(2);:LOCATE A+2,B+0:PRINT SPACE$(2);
4110 LOCATE A+2,B+7:PRINT SPACE$(2);:LOCATE A+3,B+0:PRINT SPACE$(2);
4120 LOCATE A+3,B+7:PRINT SPACE$(2);:LOCATE A+4,B+0:PRINT SPACE$(2);
4130 LOCATE A+4,B+7:PRINT SPACE$(2);:LOCATE A+4,B+4:PRINT SPACE$(1);
4140 LOCATE A+5,B+0:PRINT SPACE$(2);:LOCATE A+5,B+7:PRINT SPACE$(2);
4150 LOCATE A+6,B+0:PRINT SPACE$(2);:LOCATE A+6,B+7:PRINT SPACE$(2);
4160 LOCATE A+7,B+0:PRINT SPACE$(2);:LOCATE A+7,B+7:PRINT SPACE$(2);
4170 LOCATE A+8,B+0:PRINT SPACE$(9);:RETURN
4180 ' CLEAR
4190 COLOR 7,0:LOCATE A+8,B+0:PRINT SPACE$(9);:LOCATE A+7,B+0:PRINT SPACE$(9);
4200 LOCATE A+6,B+0:PRINT SPACE$(9);:LOCATE A+5,B+0:PRINT SPACE$(9);
4210 LOCATE A+4,B+0:PRINT SPACE$(9);:LOCATE A+3,B+0:PRINT SPACE$(9);
4220 LOCATE A+2,B+0:PRINT SPACE$(9);:LOCATE A+1,B+0:PRINT SPACE$(9);
4230 LOCATE A+0,B+0:PRINT SPACE$(9);:COLOR 0,7:RETURN
4240 ' -----------------------------------------------------------------------
4250 ' 15 MINUTE CHIME SUBROUTINE
4260 ' -----------------------------------------------------------------------
4270 '
4280 SOUND 1000,15:SOUND 32000,1:SOUND 800,15:SOUND 32000,1
4290 SOUND 900,15:SOUND 32000,1:SOUND 600,15:SOUND 32000,1:RETURN
4300 ' -----------------------------------------------------------------------
4310 ' 30 MINUTE CHIME SUBROUTINE
4320 ' -----------------------------------------------------------------------
4330 '
4340 SOUND 600,15:SOUND 32000,1:SOUND 900,15:SOUND 32000,1:SOUND 1000,15
4350 SOUND 32000,1:SOUND 800,15:SOUND 32000,5:SOUND 1000,15:SOUND 32000,1
4360 SOUND 900,15:SOUND 32000,1:SOUND 800,15:SOUND 32000,1:SOUND 600,15:RETURN
4370 ' -----------------------------------------------------------------------
4380 ' 45 MINUTE CHIME SUBROUTINE
4390 ' -----------------------------------------------------------------------
4400 '
4410 SOUND 600,15:SOUND 32000,1:SOUND 900,15:SOUND 32000,1:SOUND 1000,15
4420 SOUND 32000,1:SOUND 800,15:SOUND 32000,5:SOUND 1000,15:SOUND 32000,1
4430 SOUND 800,15:SOUND 32000,1:SOUND 900,15:SOUND 32000,1:SOUND 600,15
4440 SOUND 32000,5:SOUND 600,15:SOUND 32000,1:SOUND 900,15:SOUND 32000,1
4450 SOUND 1000,15:SOUND 32000,1:SOUND 800,15:RETURN
4460 ' -----------------------------------------------------------------------
4470 ' ON HOUR CHIME SUBROUTINE
4480 ' -----------------------------------------------------------------------
4490 '
4500 SOUND 1000,15:SOUND 32000,1:SOUND 800,15:SOUND 32000,1:SOUND 900,15
4510 SOUND 32000,1:SOUND 600,15:SOUND 32000,5:SOUND 600,15:SOUND 32000,1
4520 SOUND 900,15:SOUND 32000,1:SOUND 1000,15:SOUND 32000,1:SOUND 800,15
4530 SOUND 32000,5:SOUND 1000,15:SOUND 32000,1:SOUND 900,15:SOUND 32000,1
4540 SOUND 800,15:SOUND 32000,1:SOUND 600,15:SOUND 32000,5:SOUND 600,15
4550 SOUND 32000,1:SOUND 900,15:SOUND 32000,1:SOUND 1000,15:SOUND 32000,1
4560 SOUND 800,15:SOUND 32000,20
4570 '
4580 FOR I=1 TO TL:SOUND 400,15:SOUND 32000,15:NEXT:RETURN
4590 ' -----------------------------------------------------------------------
4600 ' SET DATE & TIME SUBROUTINE
4610 ' -----------------------------------------------------------------------
4620 '
4630 COLOR 7,0:CLS
4640 LOCATE 2,20:COLOR 0,7:PRINT" S E T D A T E T I M E "
4650 LOCATE 5,36:COLOR 7,0:PRINT"CURRENT DATE = ";DATE$
4660 LOCATE 7,20:INPUT"ENTER NEW DATE - ELSE ENTER--> ",IN$
4670 IF IN$="" THEN 4680 ELSE DATE$=IN$
4680 LOCATE 5,36:COLOR 0,7:PRINT"CURRENT DATE = ";DATE$
4690 LOCATE 10,36:COLOR 7,0:PRINT"CURRENT TIME = ";TIME$
4700 LOCATE 12,20:INPUT"ENTER NEW TIME - ELSE ENTER--> ",IN$
4710 IF IN$="" THEN 4720 ELSE TIME$=IN$
4720 LOCATE 10,36:COLOR 0,7:PRINT"CURRENT TIME = ";TIME$
4730 LOCATE 15,20:COLOR 7,0:PRINT"IS DATE AND TIME CORRECT ? (Y or N)"
4740 RESP$=INKEY$:IF RESP$="" THEN 4740
4750 IF RESP$="Y" THEN 4760 ELSE 4620
4760 D1SAVE=99:D2SAVE=99:D3SAVE=99:D4SAVE=99:TLSAVE=99:TR1SAVE=99:TR2SAVE=99
4770 GOTO 1330
4780 ' -----------------------------------------------------------------------
4790 ' SET ALARM SUBROUTINE
4800 ' -----------------------------------------------------------------------
4810 '
4820 COLOR 7,0:CLS
4830 LOCATE 2,20:COLOR 0,7:PRINT" S E T A L A R M T I M E S "
4840 LOCATE 4,20:COLOR 7,0:PRINT"CURRENT DATE = ";DATE$
4850 LOCATE 5,20:PRINT"CURRENT TIME = ";TIME$
4860 LOCATE 7,10:PRINT"USE 24 HOUR CLOCK TIMES"
4870 LOCATE 9,15:COLOR 1,0:PRINT"TIMES"
4880 LOCATE 9,28:PRINT"ALARM DESCRIPTIONS"
4890 '
4900 FOR I=11 TO 16:LOCATE I,15:COLOR 7,0:PRINT SPACE$(64);:NEXT
4910 LOCATE 11,15:COLOR 1,0:PRINT ALARM$(1)
4920 LOCATE 11,28:PRINT ALDESC$(1)
4930 LOCATE 12,15:PRINT ALARM$(2)
4940 LOCATE 12,28:PRINT ALDESC$(2)
4950 LOCATE 13,15:PRINT ALARM$(3)
4960 LOCATE 13,28:PRINT ALDESC$(3)
4970 LOCATE 14,15:PRINT ALARM$(4)
4980 LOCATE 14,28:PRINT ALDESC$(4)
4990 LOCATE 15,15:PRINT ALARM$(5)
5000 LOCATE 15,28:PRINT ALDESC$(5)
5010 LOCATE 16,15:PRINT ALARM$(6)
5020 LOCATE 16,28:PRINT ALDESC$(6)
5030 LOCATE 7,40:COLOR 7,0:PRINT"YOU CAN SET UP TO 6 ALARM TIMES"
5040 LOCATE 11,15:LINE INPUT"",IN$
5050 IF IN$="" THEN 5060 ELSE ALARM$(1)=IN$
5060 LOCATE 11,15:PRINT SPACE$(10)
5070 LOCATE 11,15:PRINT ALARM$(1)
5080 LOCATE 11,28:INPUT"",IN$
5090 IF IN$="" THEN 5100 ELSE ALDESC$(1)=IN$
5100 LOCATE 11,28:PRINT SPACE$(50)
5110 LOCATE 11,28:PRINT ALDESC$(1)
5120 LOCATE 12,15:LINE INPUT"",IN$
5130 IF IN$="" THEN 5140 ELSE ALARM$(2)=IN$
5140 LOCATE 12,15:PRINT SPACE$(10)
5150 LOCATE 12,15:PRINT ALARM$(2)
5160 LOCATE 12,28:INPUT"",IN$
5170 IF IN$="" THEN 5180 ELSE ALDESC$(2)=IN$
5180 LOCATE 12,28:PRINT SPACE$(50)
5190 LOCATE 12,28:PRINT ALDESC$(2)
5200 LOCATE 13,15:LINE INPUT"",IN$
5210 IF IN$="" THEN 5220 ELSE ALARM$(3)=IN$
5220 LOCATE 13,15:PRINT SPACE$(10)
5230 LOCATE 13,15:PRINT ALARM$(3)
5240 LOCATE 13,28:INPUT"",IN$
5250 IF IN$="" THEN 5260 ELSE ALDESC$(3)=IN$
5260 LOCATE 13,28:PRINT SPACE$(50)
5270 LOCATE 13,28:PRINT ALDESC$(3)
5280 LOCATE 14,15:LINE INPUT"",IN$
5290 IF IN$="" THEN 5300 ELSE ALARM$(4)=IN$
5300 LOCATE 14,15:PRINT SPACE$(10)
5310 LOCATE 14,15:PRINT ALARM$(4)
5320 LOCATE 14,28:INPUT"",IN$
5330 IF IN$="" THEN 5340 ELSE ALDESC$(4)=IN$
5340 LOCATE 14,28:PRINT SPACE$(50)
5350 LOCATE 14,28:PRINT ALDESC$(4)
5360 LOCATE 15,15:LINE INPUT"",IN$
5370 IF IN$="" THEN 5380 ELSE ALARM$(5)=IN$
5380 LOCATE 15,15:PRINT SPACE$(10)
5390 LOCATE 15,15:PRINT ALARM$(5)
5400 LOCATE 15,28:INPUT"",IN$
5410 IF IN$="" THEN 5420 ELSE ALDESC$(5)=IN$
5420 LOCATE 15,28:PRINT SPACE$(50)
5430 LOCATE 15,28:PRINT ALDESC$(5)
5440 LOCATE 16,15:LINE INPUT"",IN$
5450 IF IN$="" THEN 5460 ELSE ALARM$(6)=IN$
5460 LOCATE 16,15:PRINT SPACE$(10)
5470 LOCATE 16,15:PRINT ALARM$(6)
5480 LOCATE 16,28:INPUT"",IN$
5490 IF IN$="" THEN 5500 ELSE ALDESC$(6)=IN$
5500 LOCATE 16,28:PRINT SPACE$(50)
5510 LOCATE 16,28:PRINT ALDESC$(6)
5520 LOCATE 19,20:PRINT"ARE ALL ENTRIES CORRECT ? (Y or N)"
5530 RESP$=INKEY$:IF RESP$="" THEN 5530
5540 LOCATE 19,20:PRINT SPACE$(40)
5550 IF RESP$="Y" THEN 5560 ELSE 4890
5560 D1SAVE=99:D2SAVE=99:D3SAVE=99:D4SAVE=99:TLSAVE=99:TR1SAVE=99:TR2SAVE=99
5570 GOTO 1330
5580 ' -----------------------------------------------------------------------
5590 ' DISPLAY ALARM ROUTINE
5600 ' -----------------------------------------------------------------------
5610 '
5620 COLOR 7,0:CLS
5630 LOCATE 2,15:COLOR 0,7:PRINT" A L A R M "
5640 LOCATE 10,15:COLOR 7,0:PRINT ALDESC$(I);
5650 LOCATE 15,15:COLOR 23,0:PRINT"Press Any Key To Reset Alarm";
5660 '
5670 SOUND 1000,5:SOUND 32000,5
5680 RESP$=INKEY$:IF RESP$="" THEN 5660
5690 D1SAVE=99:D2SAVE=99:D3SAVE=99:D4SAVE=99:TLSAVE=99:TR1SAVE=99:TR2SAVE=99
5700 ALARM$(I)=" : ":ALDESC$(I)=STRING$(50,32)
5710 GOTO 1330
5720 ' -----------------------------------------------------------------------
5730 ' INSTRUCTIONS ROUTINE
5740 ' -----------------------------------------------------------------------
5750 '
5760 COLOR 7,0:CLS
5770 LOCATE 1,10:COLOR 0,7:PRINT" CLOCK FUNCTION CONTROLS "
5780 LOCATE 4,10:COLOR 7,0:PRINT" B = TIME CHANGE BEEP SET ON/OFF"
5790 LOCATE 6,10:PRINT" C = CHIMES SET ON/OFF"
5800 LOCATE 8,10:PRINT" E = ELAPSED TIME SET ON/OFF"
5810 LOCATE 10,10:PRINT" M = CHANGE FROM 12 TO 24 HOUR MODE"
5820 LOCATE 1,55:COLOR 0,7:PRINT" CURRENT CONDITION ":COLOR 7,0
5830 LOCATE 4,60:IF BP1$="1" THEN PRINT" ON" ELSE PRINT"OFF"
5840 LOCATE 6,60:IF CH1$="1" THEN PRINT" ON" ELSE PRINT"OFF"
5850 LOCATE 8,60:IF ET1$="1" THEN PRINT" ON" ELSE PRINT"OFF"
5860 LOCATE 10,60:IF SW1$="1" THEN PRINT" 12" ELSE PRINT" 24"
5870 LOCATE 12,10:PRINT" A = SET ALARM TIMES AND DESCRIPTIONS"
5880 LOCATE 14,10:PRINT" R = RESET ELAPSED TIME"
5890 LOCATE 16,10:PRINT" S = SET DATE AND TIME"
5900 LOCATE 18,10:PRINT" ? = DISPLAY INSTRUCTIONS"
5910 LOCATE 20,10:PRINT"ESC = EXIT - RETURN TO SYSTEM MODE"
5920 LOCATE 24,20:COLOR 23,0:PRINT"Press Any Key To Continue";
5930 RESP$=INKEY$:IF RESP$="" THEN 5930
5940 COLOR 7,0:CLS
5950 D1SAVE=99:D2SAVE=99:D3SAVE=99:D4SAVE=99:TLSAVE=99:TR1SAVE=99:TR2SAVE=99
5960 GOTO 1330
5970 ' -----------------------------------------------------------------------
5980 ' EXIT ROUTINE
5990 ' -----------------------------------------------------------------------
6000 COLOR 7,0:CLS:END
TIME.BAS
45000 PROG1$="T I M E"' DISPLAYS SYSTEM DATE AND TIME
45010 REV$="Rev: 830120"' By Robert Hamilton
45020 SCREEN 0,0,0:WIDTH 80:COLOR 2,0,0:KEY OFF:CLS:UP$=STRING$(1,30)
45030 LOCATE ,,1,12,13:DEF SEG=0:IF PEEK (&H410)= 109 THEN LOCATE ,,,6,7
45040 DEF SEG=64:POKE 23,128:DEF SEG:CL$=STRING$(79,0):Q$=CHR$(34)
45050 LOCATE 6,34:PRINT PROG1$:PRINT CHR$(10);TAB(32);REV$:COLOR 6,0
45060 GOSUB 45090:CLS:LOCATE 20,1:COLOR 6,0:PRINT "DONE";CHR$(10):KEY ON
45070 LOCATE ,,1:END
45080 REM: »» DATE/TIME
45090 LOCATE 25,1:COLOR 10,0:PRINT "Press SPACE key to abort";:COLOR 6,0
45100 LOCATE 22,1:PRINT"DATE IS: ";DATE$
45110 LOCATE 23,1,0:PRINT"TIME IS: ";
45120 K$=INKEY$:LOCATE 23,10:PRINT TIME$+" ";
45130 IF K$="" THEN 45120
45140 RETURN
Directory of PC-SIG Library Disk #0182
Volume in drive A has no label
Directory of A:\
AREACODE BAS 8960 1-24-84 10:58p
CALENDAR BAS 9216 6-25-83 6:30a
DDATE COM 512 6-03-84 9:06p
MONOCLKF COM 257 1-07-84 4:14p
MONOCLKF DOC 384 1-01-84 10:30p
SPEC-OCC BAS 10881 9-26-83 4:51p
SPEC-OCC DOC 915 8-14-83 7:08p
TCLOCK BAS 25221 2-05-83
TIME BAS 640 1-20-83 9:17p
ADDFILE BAS 2688 2-22-82
AUTOFILE BAS 16384 11-26-83 2:22p
AUTOFILE BAT 24 11-27-83 9:48a
AUTOFILE DOC 9216 11-26-83 2:26p
AUTOFILE FIX 512 11-26-83 2:23p
BUILFILE BAS 1408 2-22-82
COLRFILE BAS 256 3-19-82
COPFILE BAS 3584 3-14-82
DCATFILE BAS 1408 2-22-82
DISPFILE BAS 640 2-20-82
DTEXFILE BAS 2560 3-19-82
EASYFILE BAS 1536 3-19-82
EZFDOCM BAS 7296 3-22-82
FILEFILE BAS 768 2-22-82
FILEMENU BAS 1536 3-19-82
LISTFILE BAS 2304 3-13-82
MONOFILE BAS 256 3-19-82
STATFILE BAS 768 2-22-82
XXX 1664 6-03-84 9:26p
CRC TXT 1875 11-15-84 7:28a
CRCK4 COM 1536 10-21-82 7:54p
30 file(s) 115205 bytes
39424 bytes free