home *** CD-ROM | disk | FTP | other *** search
/ World of Ham Radio 1997 / WOHR97_AmSoft_(1997-02-01).iso / basic / dxccsort.bas < prev    next >
BASIC Source File  |  1997-02-01  |  2KB  |  55 lines
  1. 10 REM DXCCSORT Version 820909 COPYRIGHT JOE KASSER G3ZCZ 1982
  2. 20 ON ERROR GOTO 440
  3. 30 M = 350
  4. 40 DIM P$(M),C$(M),B$(M),M$(M),T(M),Q(M),D$(M)
  5. 50 INPUT "Which DXCC record file " ; F$
  6. 60 IF LEN(F$) = 0 THEN 50
  7. 70 OPEN"I",#2,F$ + ".DX"
  8. 80 OPEN "O",#1,F$ + ".$$$"
  9. 90 IF EOF(2) THEN 150
  10. 100 INPUT#2,P$,C$,B$,M$,D$,T,Q
  11. 110 I = I + 1
  12. 120 P$(I) = P$ : C$(I) = C$ : B$(I) = B$ : M$(I) = M$
  13. 130 D$(I) = D$ : T(I) = T : Q(I) = Q
  14. 140 GOTO 90
  15. 150 CLOSE #2
  16. 160 PRINT "THERE ARE";I;" ENTRIES IN THE FILE"
  17. 170 PRINT "LIST IS LOADED, SORT BEGINING"
  18. 180 N = 1
  19. 190 B = 0
  20. 200 FOR J = 1 TO I - N
  21. 210 IF P$(J) <= P$(J+1) THEN 320
  22. 220 X$ = P$(J+1) : P$(J+1) = P$(J) : P$(J) = X$
  23. 230 X$ = C$(J+1) : C$(J+1) = C$(J) : C$(J) = X$
  24. 240 X$ = B$(J+1) : B$(J+1) = B$(J) : B$(J) = X$
  25. 250 X$ = M$(J+1) : M$(J+1) = M$(J) : M$(J) = X$
  26. 260 X$ = D$(J+1) : D$(J+1) = D$(J) : D$(J) = X$
  27. 270 X = T(J+1) : T(J+1) = T(J) : T(J) = X
  28. 280 X = Q(J+1) : Q(J+1) = Q(J) : Q(J) = X
  29. 290 B = 1
  30. 300 N = N + 1
  31. 310 PRINT P$(J),P$(J+1)
  32. 320 NEXT J
  33. 330 IF B = 1 THEN 180
  34. 340 PRINT "LIST IS SORTED"
  35. 350 FOR J = 1 TO I
  36. 360 PRINT P$(J),C$(J)
  37. 370 PRINT#1, P$(J);",";C$(J);",";B$(J);",";M$(J);",";D$(J);",";T(J);",";Q(J)
  38. 380 NEXT
  39. 390 CLOSE#1
  40. 400 KILL F$ + ".BAK"
  41. 410 NAME F$ + ".DX"  AS F$ + ".BAK"
  42. 420 NAME F$ + ".$$$" AS F$ + ".DX"
  43. 430 GOTO 490
  44. 440 ON ERROR GOTO 440
  45. 450 IF ERR = 53 AND ERL = 400 THEN RESUME 410
  46. 460 IF ERL = 70 THEN RESUME 500
  47. 470 IF ERL = 390 AND ERR = 61 THEN PRINT "DISK IS FULL"
  48. 480 RESUME 490
  49. 490 END
  50. 500 PRINT "FILE DOES NOT EXIST" : GOTO 50
  51. 
  52. 470 IF ERL = 390 AND ERR = 61 THEN PRINT "DISK IS FULL"
  53. 480 RESUME 490
  54. 490 END
  55. 500 PRINT "FILE DOES NOT