home *** CD-ROM | disk | FTP | other *** search
/ World of Ham Radio 1997 / WOHR97_AmSoft_(1997-02-01).iso / basic / dxccgen.bas < prev    next >
BASIC Source File  |  1997-02-01  |  2KB  |  67 lines
  1. 10 REM DXCCGEN VER 1.1 COPYRIGHT JOE KASSER G3ZCZ 1982
  2. 20 ON ERROR GOTO 620
  3. 30 INPUT "What is the name of the DXCC record file ";F$
  4. 40 IF LEN(F$) = 0 THEN 30
  5. 50 INPUT "Is this a new file (Y/N) ";N$
  6. 60 IF LEN(N$) = 0 THEN 50
  7. 70 N = 0
  8. 80 IF LEFT$(N$,1) = "Y" THEN N = 1
  9. 90 IF LEFT$(N$,1) = "N" THEN N = 2
  10. 100 IF N = 0 THEN 50
  11. 110 OPEN "O",#2,F$ + ".$$$"
  12. 120 IF N = 1 THEN 180
  13. 130 OPEN "I",#1,F$ + ".DX"
  14. 140 IF EOF(1) THEN 200
  15. 150 LINE INPUT#1,A$
  16. 160 PRINT#2,A$
  17. 170 GOTO 140
  18. 180 OPEN "O",#3,F$ +".BAK" : CLOSE#3
  19. 190 GOTO 210
  20. 200 CLOSE#1
  21. 210 INPUT "Which country prefix (* to terminate program) ";P$
  22. 220 IF LEN(P$) = 0 THEN 210
  23. 230 IF LEFT$(P$,1) = "*" THEN 550 : REM exit
  24. 240 INPUT "Which Band ";B$
  25. 250 IF LEN(B$) = 0 THEN 240
  26. 260 INPUT "Which Mode ";M$
  27. 270 IF LEN(M$) = 0 THEN 260
  28. 280 INPUT "Call Sign ";C$
  29. 290 IF LEN(C$) = 0 THEN 280
  30. 300 INPUT "Date YY/MM/DD ";D$
  31. 310 IF LEN(D$) = 0 THEN 300
  32. 320 INPUT "Time ";T
  33. 330 Q = 0 : INPUT "QSL Status (Q W D B) " ;Q$
  34. 340 IF LEN(Q$) = 0 THEN 330
  35. 350 IF LEFT$(Q$,1) = "Q" THEN Q = 1
  36. 360 IF LEFT$(Q$,1) = "W" THEN Q = 2
  37. 370 IF LEFT$(Q$,1) = "D" THEN Q = 3
  38. 380 IF LEFT$(Q$,1) = "B" THEN Q = 4
  39. 390 IF Q = 0 THEN  330
  40. 400 PRINT P$ TAB(6) B$ TAB(10) M$ TAB(14);
  41. 410 PRINT C$ TAB(25) D$ TAB(34) T ;
  42. 420 PRINT TAB(40) ;
  43. 430 ON Q-1 GOTO 450,460,470
  44. 440 PRINT "QSL'D" : GOTO 480
  45. 450 PRINT "WORKED" : GOTO 480
  46. 460 PRINT "MAILED DIRECT" : GOTO 480
  47. 470 PRINT "SENT VIA BUREAU" : GOTO 480
  48. 480 INPUT "Are the data correct ";A$
  49. 490 IF LEN(A$) = 0 THEN 480
  50. 500 IF LEFT$(A$,1) = "N" THEN 210
  51. 510 IF LEFT$(A$,1) = "Y" THEN 520 ELSE 480
  52. 520 REM NOW WRITE TO DISK
  53. 530 PRINT #2,P$;",";C$;",";B$;",";M$;",";D$;",";T;",";Q
  54. 540 GOTO 210 : REM GET NEXT
  55. 550 REM exit routine
  56. 560 CLOSE#2
  57. 570 IF N = 1 THEN 600
  58. 580 KILL F$ + ".BAK"
  59. 590 NAME F$ + ".DX"  AS F$ + ".BAK"
  60. 600 NAME F$ + ".$$$" AS F$ + ".DX"
  61. 610 GOTO 640
  62. 620 IF ERR = 53 AND ERL = 580 THEN RESUME 590
  63. 630 RESUME 640 : REM ALL OTHER ERRORS ARE YOUR FAULT
  64. 640 END
  65. "
  66. 610 GOTO 640
  67. 620 IF ERR = 53 AND ERL = 580 THE