home *** CD-ROM | disk | FTP | other *** search
AmigaBASIC Source Code | 1986-11-20 | 7.5 KB | 298 lines |
- '*************************************
- 'A Basic Mail-List Manager
- 'By Marc Mandel
- 'Written for Amiga 1000
- 'June 6, 1986
- '*************************************
-
- CLS:CLEAR 32767
- DIM p1$(200,5) :CLS: PRINT"Mailer Program, by M. Mandel"
- PRINT"(c) 1986 by Top Notch Management Group, Ltd."
- PRINT"All Rights Reserved."
- PRINT"Attach an amplifier for speech"
-
- 'ON ERROR GOTO fixerr
- zach:
- a=0:
- Zoho:
- MENU 5,0,1,"Mailer"
- MENU 5,1,1,"About Mailer "
- MENU 5,2,0,"-------------"
- MENU 5,3,1,"Open List "
- MENU 5,4,a,"Add Names "
- MENU 5,5,a,"Delete Names "
- MENU 5,6,a,"Examine Entry"
- MENU 5,7,a,"Update Entry "
- MENU 6,0,a,"Print"
- MENU 6,1,a,"Reports"
- MENU 6,2,a,"Labels "
- MENU 7,0,1,"Quit"
- MENU 7,1,1,"Quit"
- MENU ON
-
- active:
- IF ra=0 THEN SAY TRANSLATE$ ("Please select a menu above with the right mouse button.")
- ra=ra+1
- m = MENU(0) :rum = 1 : ty=1
- IF m < 4 THEN active
-
- choice = MENU(1)
-
- IF (m =5) AND (choice <= 3) OR (yuck=1)THEN ty=0
- IF ty=0 THEN yuckey
- IF m = 7 THEN yuckey
- BEEP:GOTO active
-
-
- yuckey:
- ra=0
- ON m-4 GOTO Main,Printer,Quit
- STOP
- about:
- WINDOW CLOSE 2
- IF yuck <> 1 THEN nr=0 : GOTO gotcha
- CLOSE 3 : OPEN"I",3,fs2$
- INPUT #3,nr : CLOSE 3
-
- gotcha:
- SAY TRANSLATE$("Super Mailing List Program")
-
- WINDOW 4,"About Mailing List",(60,35)-(350,95),0
- PRINT" Mailing List manager, version 1.0"
- PRINT" by Marc C. Mandel"
- PRINT" Written for Top Notch Mgt. Ltd"
- PRINT
- PRINT" Currently there are ";nr;" records"
- PRINT
- PRINT" Hit [Return] to continue w/ prog.";
- LINE INPUT a$
- WINDOW CLOSE 4
- GOTO active
-
- update:
- PRINT"Update an entry in the file" : PRINT
- PRINT"Enter the COMPANY NAME to update"
- LINE INPUT xy$
- CLOSE 3 : OPEN"I",3,fs2$
- INPUT #3, xp
- CLOSE 3
- FOR n = 1 TO xp
- GET 1,n
- IF LEFT$(f1$,LEN(xy$))= xy$ THEN GOTO winner :ELSE NEXT n : GOTO Notthere
- winner:
- CLS:PRINT"Company Name......"; f1$:PRINT"Address..........."; f2$
- PRINT"City,State Zip...."; f3$:PRINT"Phone............."; f4$
- PRINT"Contact..........."; f5$ :
- PRINT :PRINT"Please enter the updated fields now, hit <ret> to preserve"
- PRINT"Company Name......";
- LINE INPUT x1$
- PRINT"Address...........";
- LINE INPUT x2$
- PRINT"City, State, Zip..";
- LINE INPUT x3$
- PRINT"Phone Number......";
- LINE INPUT x4$
- PRINT"Contact...........";
- LINE INPUT x5$
- Heckle:
- PRINT"Okay? (Y/N) ----->";
- LINE INPUT x$
- IF x$ = "N" OR x$="n" THEN CLOSE 3 : WINDOW CLOSE 2 : GOTO active
- IF x$ <>"Y" AND x$ <>"y" THEN Heckle
- IF x1$ <> "" THEN LSET f1$=x1$ :ELSE LSET f1$=f1$
- IF x2$ <> "" THEN LSET f2$=x2$ :ELSE LSET f2$=f2$
- IF x3$ <> "" THEN LSET f3$=x3$ :ELSE LSET f3$=f3$
- IF x4$ <> "" THEN LSET f4$=x4$ :ELSE LSET f4$=f4$
- IF x5$ <> "" THEN LSET f5$=x5$ :ELSE LSET f5$=f5$
- PUT 1,n
- CLOSE 3 : WINDOW CLOSE 2 : GOTO active
- Notthere:
- PRINT"The Record, ";xy$;" was not in the file. Find another (Y/N) ?";
- LINE INPUT xz$
- IF xz$="N" OR xz$="n" THEN WINDOW CLOSE 2 : GOTO active
- IF xz$ ="Y" OR xz$="y" THEN CLS : GOTO update
- GOTO Notthere
-
-
-
-
-
-
- Main:
- IF m=5 AND choice = 1 THEN xp=2 :ELSE xp=1
-
- IF xp = 1 THEN GOSUB makewind
- ON choice GOTO about,,1100,1000,1200,1300,update
- STOP
-
- Quit:
- CLOSE : CLS : PRINT"Exited Application at ";TIME$
- END
-
- maker:
- 1000 CLS: PRINT"Add names to file"
- PRINT
- PRINT"Enter Company Name............";:LINE INPUT x1$
- PRINT"Enter Street Address..........";:LINE INPUT x2$
- PRINT"Enter City, State, Zip........";:LINE INPUT x3$
- PRINT"Enter Phone Number............";:LINE INPUT x4$
- PRINT"Enter Contact's Name..........";:LINE INPUT x5$
- PRINT
-
- geter:
- PRINT"All okay to enter to file? (Y/N) ---> ";
- LINE INPUT a$ : IF a$ <> "Y" AND a$<>"N" AND a$<>"y" AND a$<>"n" THEN BEEP: GOTO geter
- IF a$ <>"Y" AND a$ <>"y" THEN maker
- LSET f1$=x1$ : LSET f2$=x2$ : LSET f3$=x3$ : LSET f4$ = x4$ : LSET f5$=x5$
- CLOSE 3 : OPEN"I",3,fs2$:INPUT#3,lf:lf=lf+1
- PUT 1,lf
- PRINT"File Stored at position #",lf
- CLOSE 3 : OPEN"O",3,fs2$ : PRINT#3,lf : CLOSE 3
-
- maybe:
- PRINT"Add another? (Y/N) ---> ";
- LINE INPUT a$ :IF a$ <> "Y" AND a$<>"N" AND a$<>"y" AND a$<>"n" THEN BEEP:GOTO maybe
- IF a$ = "y" OR a$ = "Y" THEN GOTO maker :ELSE WINDOW CLOSE 2 : GOTO active
-
-
- ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
- 'Open a File
- '''''''''''''''''
-
- 1100 PRINT"Enter the name for the file to be used.":CLOSE :rum=0:yuck=0
-
- 1105 LINE INPUT f$
- 1110 PRINT"Stand by while I set up the file, named ";CHR$(34);f$;CHR$(34)
- 1115 OPEN"R",1,f$
- FIELD 1,25 AS f1$, 25 AS f2$, 25 AS f3$, 25 AS f4$, 25 AS f5$
- rum=-1 :yuck=1
- IF LOF(1) <> 0 THEN bigfile
- fs2$=f$+".NUM" : OPEN"O",3,fs2$
- PRINT#3,0: CLOSE 3
-
- GOTO yahoo
- bigfile:
- fs2$=f$+".NUM"
- OPEN "I",3,fs2$ : INPUT #3, rn : CLOSE 3
- yahoo:
-
-
- 1125 PRINT"I'm Done. Now returning to main command area."
- 1130 FOR W = 1 TO 900: NEXT W:WINDOW CLOSE 2 :a=1: GOTO Zoho
-
-
- 1200 CLS : PRINT"Delete a name"
- OPEN"I",3,fs2$ : INPUT #3,rn : CLOSE 3
- FOR n = 1 TO rn : GET 1,n
- p1$(n,1) = f1$ : p1$(n,2) = f2$ : p1$(n,3)=f3$:p1$(n,4)=f4$ : p1$(n,5) = f5$
- NEXT n
- PRINT"Enter Company Name to remove from data file"
- LINE INPUT x$
- pp=0
-
- FOR n = 1 TO rn
- IF LEFT$(p1$(n,1),LEN(x$)) = x$ THEN rw= 1 :GOTO abby
- PRINT"Moved entry";pp+1
- LSET f1$=p1$(n,1) : pp = pp+1
- LSET f2$=p1$(n,2)
- LSET f3$=p1$(n,3)
- LSET f4$=p1$(n,4)
- LSET f5$=p1$(n,5)
- rq = pp
- PUT 1,rq
- abby:
- NEXT n :CLOSE 3
- OPEN"O",3,fs2$ :PRINT#3,pp: CLOSE 3
- CLOSE 3
- ng:
- IF rw=1 THEN PRINT: PRINT"Record Deleted." :ELSE PRINT"Record not found"
- rw=0
- LINE INPUT"<Enter> to continue.";a$
- WINDOW CLOSE 2 :GOTO active
-
-
-
- Printer:
- GOSUB makewind
- IF choice = 1 THEN CLS : PRINT"Output List to Video Screen" : PRINT
- IF choice = 2 THEN labels
- OPEN"I",3,fs2$ : INPUT#3,xp : CLOSE 3
- FOR n = 1 TO xp: GET 1,n
- PRINT f1$: NEXT n :PRINT: PRINT"....Done...."
- FOR n = 1 TO 1000 : NEXT n :LINE INPUT"<Enter> to continue.";a$
- WINDOW CLOSE 2 : GOTO active
-
- 1300 CLS : PRINT"Find a Name Function" : PRINT
- PRINT"Enter enough characters of company name for identification"
- LINE INPUT a$ : CLOSE 3
- OPEN"I",3,fs2$ : INPUT #3,xn : CLOSE 3
- FOR n = 1 TO xn
- GET 1,n
- IF LEFT$(f1$,LEN(a$)) = a$ THEN 1350 :ELSE NEXT n : PRINT"Name not on file"
- PRINT"Shall I find another name? (Y/N) --> ";
- shit:
- a$ = INKEY$:IF a$ <> "Y" AND a$<>"N" AND a$<>"y" AND a$<>"n" AND a$<>"" THEN BEEP:GOTO shit
- IF a$ = "Y" OR a$ = "y" THEN 1300
- WINDOW CLOSE 2: GOTO active
-
- 1350 PRINT : PRINT"Name On File As Follows"
- PRINT f1$ : PRINT f2$ : PRINT f3$: PRINT f4$ : PRINT f5$
- PRINT: PRINT"Find Another? (Y/N) ---> "
- crummy:
- a$ = INKEY$:IF a$ = "" THEN crummy :ELSE IF a$ <> "Y" AND a$<>"N" AND a$<>"y" AND a$<>"n" THEN BEEP:GOTO crummy
- IF a$ = "Y" OR a$="y" THEN 1300 :ELSE WINDOW CLOSE 2 : GOTO active
-
- labels:
- PRINT"Print Mailing Labels"
- PRINT
- PRINT"<1> Do a label-line test <2> Print Production Labels"
- PRINT"<3> Abort"
- PRINT
- PRINT"Enter your choice (1,2,3) --> ";
- LINE INPUT a$
- IF a$="3" THEN WINDOW CLOSE 2: GOTO active
- IF a$="2" THEN GOTO RunLabels
- FOR n = 1 TO 4 : LPRINT STRING$(25,"X") : NEXT n :LPRINT:LPRINT
-
- CLS : GOTO labels
- RunLabels:
- CLOSE 3 : OPEN"I",3,fs2$
- INPUT #3, rn : CLOSE 3
- FOR n = 1 TO rn
- GET 1,n
- LPRINT TAB(5);f1$ : LPRINT TAB(5);f2$ : LPRINT TAB(5);f3$
- LPRINT TAB(5);"Attn: ";f5$ :LPRINT:LPRINT
- IF INKEY$ <> "" THEN aborter
- gumby:
- NEXT n : WINDOW CLOSE 2 : GOTO active
-
- aborter:
- PRINT : PRINT"Are you sure you want to abort? (Y/N) --> ";
- LINE INPUT a$ : IF a$ ="Y" OR a$="y" THEN WINDOW CLOSE 2 : GOTO active
- IF a$="N" OR a$="n" THEN gumby
- GOTO aborter
-
-
- October:
- xw=INT(LOF(1)/125)
- PRINT"Currently, there are ";xw;"Records according to Fn 1"
- CLOSE 3 : OPEN"I",3,fs2$: INPUT #3,xr : close3
- PRINT"Currently there are";xr;"records according to FN 3"
- rum=1 : RETURN
-
- makewind:
- WINDOW 2,"Function Window",(8,40)-(615,160),4
- COLOR 1,2 :CLS
-
- RETURN
-
-
-
-
- fixerr:
- CLS : PRINT"Error Occurred! Warning!!!"
- PRINT"Error at";ERL;"of the type";ERR
-
- RESUME active
-
-