home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / misc3 / easymail.lzh / MAILSORT.BAS < prev    next >
Encoding:
BASIC Source File  |  1983-12-03  |  2.6 KB  |  55 lines
  1. 2000 ' ----------------------- SORT ROUTINE ---------------------------------
  2. 2010 DEFINT A-Z:COMMON N,RAN$,IN$,NBR$,SRT$,S,CR$,ESC$:SRT$=RAN$+".SRT":DIM I1$(1000):DIM I1(1000):ON ERROR GOTO 10000
  3. 2020 I=0:MN=2:KEY 9,"":CLS:LOCATE 1,34:COLOR 0,7:PRINT" MAILIST1 ":COLOR 7,0:LOCATE 5,29:COLOR 15,0:PRINT"DO YOU WANT TO SORT BY":COLOR 7,0
  4. 2060 LOCATE 8,33:PRINT"1 Last name"
  5. 2080 LOCATE 9,33:PRINT"2 Zipcode"
  6. 2100 LOCATE 19,24:PRINT"Type the number of your choice:":GOSUB 11100
  7. 2105 IF I$=CHR$(27) THEN LOCATE 19,24:COLOR 15,0:PRINT"Loading main program.............":COLOR 7,0:CHAIN "MAILIST1.BAS",110
  8. 2120 IF I<1 OR I>2 THEN LOCATE 23,27:BEEP:COLOR 15,0:PRINT"PLEASE TYPE NUMBER 1 OR 2":COLOR 7,0:GOTO 2100
  9. 2130 IF I = 2 GOTO 2460
  10. 2135 LOCATE 25,1:PRINT SPACE$(30);:LOCATE 19,24:COLOR 15,0:PRINT"Sorting........Please wait......":COLOR 7,0:L=1:OPEN "I",1,IN$
  11. 2140 IF EOF(1) THEN CLOSE 1:GOTO 2280
  12. 2145 INPUT#1,I1$(L)
  13. 2160 I=LEN(I1$(L)):I=I-5
  14. 2180 I1$(L)=MID$(I1$(L),6,INSTR(I1$(L),"\")-5):I=I-15:I1$(L)=I1$(L)+STR$(L)
  15. 2200 L=L+1:GOTO 2140
  16. 2280 M=N
  17. 2300 M=INT(M/2):IF M=0 THEN GOTO 2700
  18. 2320 K=N-M:FOR L=1 TO K
  19. 2340 I=L
  20. 2360 J=I+M
  21. 2380 IF I1$(I)<I1$(J) THEN 2420
  22. 2400 SWAP SV$,I1$(I):SWAP I1$(I),I1$(J):SWAP I1$(J),SV$:I=I-M:IF I-1>=0 THEN 2360
  23. 2420 NEXT L:GOTO 2300
  24. 2440 ' ----------------------ZIPCODE SORT -------------------------
  25. 2460 LOCATE 25,1:PRINT SPACE$(30);:LOCATE 19,24:COLOR 15,0:PRINT"Sorting.......Please wait.......":COLOR 7,0:L=1:OPEN "I",1,IN$
  26. 2465 IF EOF(1) THEN CLOSE 1:GOTO 2540
  27. 2470 INPUT#1,I$
  28. 2480 I=LEN(I$):I=I-20
  29. 2485 I1$(L)="     "
  30. 2500 MID$(I1$(L),1,5)=I$:I1$(L)=I1$(L)+RIGHT$(I$,I)
  31. 2520 L=L+1:GOTO 2465
  32. 2540 M=N
  33. 2560 M=INT(M/2):IF M=0 THEN GOTO 2700
  34. 2580 K=N-M:FOR L=1 TO K
  35. 2600 I=L
  36. 2620 J=I+M
  37. 2640 IF I1$(I)<I1$(J) THEN 2680
  38. 2660 SWAP SV$,I1$(I):SWAP I1$(I),I1$(J):SWAP I1$(J),SV$:I=I-M:IF I-1>=0 THEN 2620
  39. 2680 NEXT L:GOTO 2560
  40. 2700 FOR L=1 TO N:I$=RIGHT$(I1$(L),5)
  41. 2702 I=INSTR(I$," "):IF I=1 THEN I=INSTR(2,I$," ")
  42. 2704 I1(L)=VAL(RIGHT$(I$,LEN(I$)-I))
  43. 2706 NEXT L
  44. 2719 S=1:OPEN "o",1,SRT$
  45. 2720 FOR L=1 TO N:PRINT#1,I1(L):NEXT L
  46. 2740 CLOSE 1:BEEP:LOCATE 19,24:COLOR 15,0:PRINT"Loading main program.............":COLOR 7,0:CHAIN "MAILIST1.BAS",110
  47. 10000 IF ERR = 71 THEN CLS ELSE GOTO 10080
  48. 10020 LOCATE 10,20:PRINT"DISK DRIVE NOT READY. PLEASE INSERT DATA DISK"
  49. 10040 LOCATE 11,20:PRINT"OR CLOSE DRIVE DOOR. PRESS ENTER TO RESUME":BEEP
  50. 10060 I$=INKEY$:IF I$=CHR$(13) THEN RESUME ELSE 10060
  51. 10080 ON ERROR GOTO 0
  52. 11100 LOCATE 25,1:COLOR 15,0:PRINT"Esc ";:COLOR 0,7:PRINT" RETURN TO PRIOR MENU ";:COLOR 7,0
  53. 11120 I$=INKEY$:IF I$="" THEN 11120
  54. 11140 IF VAL(I$)=0 THEN RETURN ELSE I=VAL(I$):RETURN
  55.