⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 lk607a.bas

📁 写卡用的软件
💻 BAS
📖 第 1 页 / 共 3 页
字号:
        IF KY$ = CHR$(27) THEN RESUME 9500
2400 RESUME
2410 '
2420 '     ***********************
2430 '     **   ENCODE A CARD   **
2440 '     ***********************
2450 'GOSUB 1840
2460 ER% = 0 'IF FF% THEN 3880
2470 GOSUB 2050
2480 PM% = 1: PL% = LU%(PM%): 'GOTO 3880
2490 '
2500 '     *******************
2510 '     **  READ A CARD  **
2520 '     *******************
2530 RETURN.FLAG% = FALSE%: M% = 1: CLS : LOCATE 11, 27, 0: PRINT "***** Read a card *****"
2540 O1$ = "": O2$ = "": O3$ = ""
2550 ON ERROR GOTO 2920
2560 OPEN COMPORT$ FOR RANDOM AS #1
2570 LB$ = INPUT$(LOC(1), 1)
2580 COLOR FG3 + 16, BG3: LOCATE 13, 28, 0: PRINT "Enter card to be read.": COLOR FG1, BG1
2590 '
2591 ' ***** READ INCOMING MESSAGE ******
2592 '       Added WHILE..WEND and GOSUB 60000 on 870623
2593 WHILE EOF(1)
2594    IF INKEY$ = ESCAPE$ THEN ON ERROR GOTO 0: CLOSE 1: GOTO 5590
2595 WEND
2596 GOSUB 60000
2740 ON ERROR GOTO 0
2750 CLOSE 1
2755 GOSUB 70000
2820 A1% = LEN(O1$): A2% = LEN(O2$): A3% = LEN(O3$)
2830 T0% = 0: T4% = 2: GOSUB 3740
2850 KY$ = INKEY$: IF KY$ = "" THEN 2850
2860 IF KY$ = "E" THEN LOCATE 21, 17, 0: PRINT STRING$(50, " "): M% = 1: GOTO 3050
2870 IF KY$ = ESCAPE$ THEN 5590
2890 GOTO 2530
2900 '
2910 '***** ERROR TRAP *****
2920 IF ERR = 5 THEN RESUME NEXT
2930 IF ERR = 57 THEN RESUME
     IF ERR = 64 THEN GOTO 90000         '880125
2940 IF INKEY$ = ESCAPE$ THEN RESUME 2990
2950 LOCATE 21, 20, 0: COLOR FG3 + 16, BG3: PRINT "      ERROR!.......CHECK ENCODER!"; STRING$(20, " "); : COLOR FG1, BG1: BEEP
2960 RESUME
2970 '
2980 '
2990 CLOSE 1: CLS : LOCATE 11, 27, 0: PRINT "READ OPERATION ABORTED!": PRINT : GOSUB 4750: GOTO 5590
3000 '     ****************************
3010 '     **   UNFORMATTED ENCODE   **
3020 '     ****************************
3025 T8% = 0: T7% = 0
3030 O1$ = "": O2$ = "": O3$ = "": A1% = 0: A2% = 0: A3% = 0: M% = 0: EM% = 0: T4% = 5: K% = 0: CLS : GOSUB 3750
3032 IF T8% = 1 THEN LOCATE 1, 20, 0: COLOR 5, 0, 0: PRINT "******  ENCODE CARDS  ******": LOCATE 3, 15, 0: COLOR 15, 0, 0: PRINT "PLEASE INPUT THE CODE OF THE FIRST CARDS !": GOTO 3040
3035 LOCATE 2, 26, 0: PRINT "*** Unformatted Encode ***": ENCODE$ = "UNFORMATTED"  'ADDED 871228
3040 RETURN.FLAG% = FALSE%
3050 IF (ET% AND 1) = 0 THEN 3140
3060 IF O1$ <> "" THEN AB$ = O1$
3065 IF X2% = 1 OR X3% = 1 THEN BEEP: GOTO 3155
3070 LOCATE T1%, 1, 0: FW% = 78: FA% = 1: GOSUB 200: O1$ = LB$: A1% = LEN(O1$)
3090 IF F1% AND (ET% AND 2) = 2 THEN 3150
3100 IF F1% AND (ET% AND 4) = 4 THEN 3250
3110 IF F1% OR F2% THEN BEEP: GOTO 3060
3120 IF F4% THEN 3490
3130 IF F5% THEN 3330
3140 IF (ET% AND 2) = 0 THEN 3240
3150 IF O2$ <> "" THEN AB$ = O2$
     IF X1% = 1 THEN BEEP: GOTO 3330
3155 IF X3% = 1 THEN BEEP: GOTO 3255
3160 LOCATE T2%, 1, 0: FW% = 39: FA% = 0: TK% = 2: GOSUB 200: O2$ = LB$: A2% = LEN(O2$)
3170 'IF F4% = 2 THEN GOSUB 8290: GOTO 3860
3180 IF F1% AND (ET% AND 4) = 4 THEN 3250
3190 IF F1% THEN BEEP: GOTO 3160
3200 IF F2% AND (ET% AND 1) = 1 THEN 3060
3210 IF F2% THEN BEEP: GOTO 3160
3220 IF F4% THEN 3490
3230 IF F5% THEN 3330
3240 IF (ET% AND 4) = 0 THEN 3330
3250 IF O3$ <> "" THEN AB$ = O3$
3255 IF X2% = 1 THEN BEEP: GOTO 3330
3260 LOCATE T3%, 1, 0: FW% = 106: FA% = 0: TK% = 3: GOSUB 200: O3$ = LB$: A3% = LEN(O3$)
3270 'IF F4% = 2 THEN GOSUB 8290: GOTO 3860
3280 IF F1% THEN BEEP: GOTO 3250
3290 IF F2% AND (ET% AND 2) = 2 THEN 3150
3300 IF F2% AND (ET% AND 1) = 2 THEN 3060
3310 IF F2% THEN BEEP: GOTO 3260
3320 IF F4% THEN 3490
3330 IF LEFT$(O1$, 1) <> B1$ THEN O1$ = B1$ + O1$: A1% = A1% + 1
3340 IF RIGHT$(O1$, 1) <> B4$ THEN O1$ = O1$ + B4$: A1% = A1% + 1
3350 IF LEN(O1$) > 78 THEN O1$ = MID$(O1$, 2, LEN(O1$) - 2): BEEP: GOTO 3050
3360 IF LEFT$(O2$, 1) <> B2$ THEN O2$ = B2$ + O2$: A2% = A2% + 1
3370 IF RIGHT$(O2$, 1) <> B4$ THEN O2$ = O2$ + B4$: A2% = A2% + 1
3380 IF LEN(O2$) > 39 THEN O2$ = MID$(O2$, 2, LEN(O2$) - 2): BEEP: GOTO 3140
3390 IF LEFT$(O3$, 1) <> B3$ THEN O3$ = B3$ + O3$: A3% = A3% + 1
3400 IF RIGHT$(O3$, 1) <> B4$ THEN O3$ = O3$ + B4$: A3% = A3% + 1
3410 IF LEN(O3$) > 106 THEN O3$ = MID$(O3$, 2, LEN(O3$) - 2): BEEP: GOTO 3240
3420 IF LEN(O1$) = 2 THEN O1$ = ""
3430 IF LEN(O2$) = 2 THEN O2$ = ""
3440 IF LEN(O3$) = 2 THEN O3$ = ""
3450 IF O1$ = "" AND O2$ = "" AND O3$ = "" THEN BEEP: GOTO 3050
3455 IF T8% = 1 THEN RETURN
3460 OB$ = SX$ + O1$ + O2$ + O3$ + EX$
3470 ER% = 0 ''GOSUB 2050
3475 GOSUB 2050
3480 IF M% = 1 THEN 2530 ELSE 3030
3490 GOSUB 1290: GOTO 9500
3700 '
3710 '     ********************************
3720 '     **   DISPLAY RAW TRACK DATA   **
3730 '     ********************************
3740 CLS : IF T0% THEN PRINT TAB(32); "*** Encoding a card ***"
3750 T1% = 7: T2% = 12: T3% = 17:
3755 LOCATE T1% - 2, 1, 0: COLOR FG2, BG2: PRINT " TRACK 1 DATA ": COLOR FG1, BG1: PRINT : PRINT LEFT$(O1$, A1%); : IF A1% < 78 THEN PRINT LEFT$(FC$, 78 - A1%);
3760 LOCATE T2% - 2, 1, 0: COLOR FG2, BG2: PRINT " TRACK 2 DATA ": COLOR FG1, BG1: PRINT : PRINT LEFT$(O2$, A2%); : IF A2% < 39 THEN PRINT LEFT$(FC$, 39 - A2%);
3770 LOCATE T3% - 2, 1, 0: COLOR FG2, BG2: PRINT " TRACK 3 DATA ": COLOR FG1, BG1: PRINT : PRINT LEFT$(O3$, A3%); : IF A3% < 80 THEN PRINT LEFT$(FC$, 80 - A3%); : PRINT LEFT$(FC$, 26); :  ELSE IF A3% >= 80 THEN PRINT LEFT$(FC$, 106 - A3%);
3780 IF T4% = 1 THEN RETURN
3790 IF T4% = 2 THEN COLOR FG3, BG3: LOCATE 21, 17, 0: PRINT "Press E to edit, any other key to continue."; : COLOR FG1, BG1
3800 IF T4% = 0 THEN PRINT "";
3810 RETURN


4340 '     ************************
4350 '     **   DISPLAY A LINE   **
4360 '     ************************
4370 LOCATE TOPROW1 + YP%(PL%) - 1, LEFTCOL1 + XP%(PL%) - 1, 0: PRINT " "; TX$(PL%); : COLOR FG1, BG1: PRINT " "; : RETURN
4750 COLOR FG3 + 16, BG3: LOCATE CSRLIN, 24, 0: PRINT " Depress any key to continue. "; : COLOR FG1, BG1: BEEP
4760 KY$ = INKEY$: IF KY$ = "" THEN 4760
4770 RETURN

5550 '
5560 '     ***************************
5570 '     *****   HELP SCREEN   *****
5580 '     ***************************
5590 GOSUB 1290
5600 IF COLOR.MONITOR% THEN SCREEN , , 0, 1: COLOR , , BDR2 ELSE GOSUB 5730: GOTO 5620
5610 IF RETURN.FLAG% = FALSE% THEN GOSUB 1210: GOSUB 1380: RETURN.FLAG% = TRUE%
5620 KY$ = INKEY$: IF KY$ = "" THEN 5620
5630 IF KY$ = CHR$(17) OR KY$ = CHR$(27) THEN COLOR FG1, BG1: CLS : COLOR FG1, BG1, BDR: SCREEN , , 0, 0: GOTO 10475'SUB 8290: GOTO 3860
5650 IF KY$ = CHR$(21) THEN GOSUB 1290: CLS : COLOR FG1, BG1, BDR: SCREEN , , 0, 0: ENCODE$ = "UNFORMATTED": GOTO 9500
5660 IF KY$ = CHR$(2) THEN COLOR FG1, BG1: CLS : COLOR FG1, BG1, BDR: SCREEN , , 0, 0: REWRITE$ = "Y": GOSUB 6180: GOTO 5590
5690 IF KY$ = CHR$(18) THEN COLOR FG1, BG1: CLS : COLOR FG1, BG1, BDR: SCREEN , , 0, 0: GOTO 2530
5696 BEEP: GOTO 5620

5720 '  ***** DISPLAY HELP SCREEN *****
5730 TOPROW1 = 5: LEFTCOL1 = 19: BWIDTH = 40: BHEIGHT = 13
5740 COLOR FG1, SCRN2: CLS : COLOR FG1, BG1: GOSUB 10290
5750 LOCATE TOPROW1 + 1, LEFTCOL1 + 8, 0: PRINT "FUNCTION KEY ASSIGNMENTS";
5770 LOCATE TOPROW1 + 4, LEFTCOL1 + 2, 0: PRINT "F1: ==>  WRITE CARD"
5780 LOCATE TOPROW1 + 6, LEFTCOL1 + 2, 0: PRINT "F2: ==>  COMMUNICATION PARAMETERS"
5800 LOCATE TOPROW1 + 8, LEFTCOL1 + 2, 0: PRINT "F3: ==>  READ A CARD"
5820 LOCATE TOPROW1 + 10, LEFTCOL1 + 2, 0: PRINT "F4: ==>  EXIT PROGRAM"
5830 RETURN
5840 '
5850 ' ********************
5860 ' ** INITIALIZATION **
5870 ' ********************
5880 WIDTH "LPT1:", 255
5890 TLC$ = CHR$(213): TRC$ = CHR$(184): BLC$ = CHR$(212): BRC$ = CHR$(190)
5900 LST$ = CHR$(198): RST$ = CHR$(181): TST$ = CHR$(209): BST$ = CHR$(207)
5910 HORIZ$ = CHR$(205): VERT$ = CHR$(179): HLIN$ = CHR$(205)
5920 TRUE% = 1: FALSE% = 0: ESCAPE$ = CHR$(27)
5930 MS$ = STRING$(100, " "): FC$ = STRING$(160, ".")
5940 COLOR 15, 0, 0: CLS : KEY OFF
5950 '
5960 '****** Read System Configuration File ******
5970 ON ERROR GOTO 6700
5980 OPEN "MRW600.FIL" FOR INPUT AS #1
5990 LINE INPUT #1, TX$
6000 COMPORT$ = TX$: GOTO 6030
6010 '
6020 GOTO 6160
6030 LINE INPUT #1, TX$
6040 IF TX$ = "COLOR" THEN COLOR.MONITOR% = TRUE%: GOTO 6110
6050 IF TX$ = "MONOCHROME" THEN COLOR.MONITOR% = FALSE%: GOTO 6110
6060 GOTO 6160
6110 LINE INPUT #1, TX$
6111 IF TX$ = "BCC" THEN BCC% = TRUE%: GOTO 6115
6112 IF TX$ = "NO" THEN BCC% = FALSE%: GOTO 6115
6113 GOTO 6160
6115 KY$ = INKEY$: IF KY$ = "" THEN CLOSE : ON ERROR GOTO 0: GOTO 6650
6120 IF KY$ = ESCAPE$ THEN 6160
6130 GOTO 6110
6140 '
6150 '****** Console-Enter System Configuration ******
6160 CLOSE : ON ERROR GOTO 0
6170 '=========================================================================
6180 CLS : COLOR 15: LOCATE 2, 13, 0: PRINT "Which serial port will be used for the MRW600 Encoder?"
6190 LOCATE 3, 33, 0: PRINT "1. ===> COM1"
6200 LOCATE 4, 33, 0: PRINT "2. ===> COM2"
6210 LOCATE 5, 30, 0: PRINT "ENTER 1 OR 2 "; : COLOR 31: PRINT "===> "; : COLOR 15
6220 KY$ = INKEY$: IF KY$ = "" THEN 6220
6230 IF KY$ = "1" THEN PRINT "COM1": COMPORT$ = "COM1:": GOTO 6235
6231 IF KY$ = "2" THEN PRINT "COM2": COMPORT$ = "COM2:": GOTO 6235
6232 BEEP: GOTO 6220
6233 '=======================================================
6235 COLOR 15: LOCATE 5, 43, 0: PRINT "===> ": PRINT STRING$(79, HLIN$);
6236 LOCATE 7, 5, 0: PRINT "SELECT BAUD RATE "
6237 LOCATE 8, 13, 0: PRINT "1.     300"
6238 LOCATE 9, 13, 0: PRINT "2.     600"
6239 LOCATE 10, 13, 0: PRINT "3.    1200"
6240 LOCATE 11, 13, 0: PRINT "4.    2400"
6241 LOCATE 12, 13, 0: PRINT "5.    4800"
6242 LOCATE 13, 13, 0: PRINT "6.    9600"
6243 LOCATE 14, 13, 0: PRINT "7.   19200"
6244 LOCATE 15, 4, 0: PRINT "ENTER 1,2,3,4,5,6 OR 7"
6245 COLOR 31: LOCATE 15, 26, 0: PRINT "===> "; : COLOR 15
6246 KY$ = INKEY$: IF KY$ = "" THEN 6246
6247 IF KY$ = "1" THEN BAUD$ = "300": PRINT "300": COMPORT$ = COMPORT$ + "300,": GOTO 6250
6248 IF KY$ = "2" THEN BAUD$ = "600": PRINT "600": COMPORT$ = COMPORT$ + "600,": GOTO 6250
     IF KY$ = "3" THEN BAUD$ = "1200": PRINT "1200": COMPORT$ = COMPORT$ + "1200,": GOTO 6250
     IF KY$ = "4" THEN BAUD$ = "2400": PRINT "2400": COMPORT$ = COMPORT$ + "2400,": GOTO 6250
     IF KY$ = "5" THEN BAUD$ = "4800": PRINT "4800": COMPORT$ = COMPORT$ + "4800,": GOTO 6250
     IF KY$ = "6" THEN BAUD$ = "9600": PRINT "9600": COMPORT$ = COMPORT$ + "9600,": GOTO 6250
     IF KY$ = "7" THEN BAUD$ = "19200": PRINT "19200": COMPORT$ = COMPORT$ + "19200,": GOTO 6250
     BEEP: GOTO 6246
6250 COLOR 15: LOCATE 15, 26, 0: PRINT "===> ";
6260 LOCATE 7, 45, 0: PRINT "SELECT PARITY"
6261 LOCATE 9, 47, 0: PRINT "1.   ODD,7,1"
6262 LOCATE 11, 47, 0: PRINT "2.  EVEN,7,1"
6263 LOCATE 13, 47, 0: PRINT "3.  NONE,8,1"
6264 LOCATE 15, 40, 0: PRINT "ENTER 1,2 OR 3"
6265 COLOR 31: LOCATE 15, 54, 0: PRINT "===> "; : COLOR 15
6266 KY$ = INKEY$: IF KY$ = "" THEN 6266
6267 IF KY$ = "1" THEN PARITY$ = "ODD,7,1": PRINT "ODD,7,1": COMPORT$ = COMPORT$ + "O,7,1,CS": X1 = 1: GOTO 6268
     IF KY$ = "2" THEN PARITY$ = "EVEN,7,1": PRINT "EVEN,7,1": COMPORT$ = COMPORT$ + "E,7,1,CS": X1 = 0: GOTO 6268
     IF KY$ = "3" THEN PARITY$ = "NONE,8,1": PRINT "NONE,8,1": COMPORT$ = COMPORT$ + "N,8,1,CS": X1 = 1: GOTO 6268
     BEEP: GOTO 6266
6268 COLOR 15: LOCATE 15, 54, 0: PRINT "===> ":
6272 PRINT STRING$(79, HLIN$);
6289 LOCATE 17, 20, 0: PRINT "Do you have a color monitor?  (Y/N) "; : COLOR 31: PRINT "===> "; : COLOR 15
6290 DEF SEG = 0: POKE &H417, (PEEK(&H417) OR &H40): DEF SEG
6300 KY$ = INKEY$: IF KY$ = "" THEN 6300
6310 IF KY$ = "Y" THEN PRINT KY$: COLOR.MONITOR% = TRUE%: GOTO 6350
6320 IF KY$ = "N" THEN PRINT KY$: COLOR.MONITOR% = FALSE%: GOTO 6350
6330 BEEP: GOTO 6290
6340 '=========================================================
6350 COLOR 15: LOCATE 17, 56, 0: PRINT "===> ":  PRINT STRING$(79, HLIN$);
6360 LOCATE 19, 27, 0: PRINT "*** Select BCC Option ***"
6370 LOCATE 20, 22, 0: PRINT "1. Data TX/RX With Block Check Character "
6380 LOCATE 21, 22, 0: PRINT "2. Without Block Check Character "
6390 LOCATE 22, 30, 0: PRINT "Enter 1 or 2 "; : COLOR 31: PRINT "===> "; : COLOR 15
6400 KY$ = INKEY$: IF KY$ = "" THEN 6400
6410 IF KY$ = "1" THEN PRINT KY$: BCC% = TRUE%: GOTO 6450
6420 IF KY$ = "2" THEN PRINT KY$: BCC% = FALSE%: GOTO 6450
6430 BEEP: GOTO 6400
6440 '========================================================================
6450 COLOR 15: LOCATE 22, 43, 0: PRINT "===>": PRINT STRING$(79, HLIN$)
6460 COLOR 31: LOCATE 5, 48, 0: PRINT LEFT$(COMPORT$, 4);
     LOCATE 15, 31, 0: PRINT BAUD$
     LOCATE 15, 59, 0: PRINT PARITY$
    
6470 LOCATE 17, 61, 0: IF COLOR.MONITOR% THEN PRINT "Y" ELSE PRINT "N"
6480 LOCATE 22, 48, 0: IF BCC% THEN PRINT "1" ELSE PRINT "2"
6490 COLOR 15
6500 LOCATE 24, 19, 0: PRINT "Is the above information correct?  (Y/N) "; : COLOR 31: PRINT "===> "; : COLOR 15
6510 KY$ = INKEY$: IF KY$ = "" THEN 6510
6520 IF KY$ = "Y" THEN PRINT KY$; : GOTO 6570
6530 IF KY$ = "N" THEN PRINT KY$; : GOTO 6180
6540 BEEP: GOTO 6500
6550 '
6560 '****** Store Configuration File ******
6570 COLOR 31: LOCATE 24, 19, 0: PRINT "       Storing Configuration File.             "; : COLOR 15
6580 OPEN "MRW600.FIL" FOR OUTPUT AS #1
6590 PRINT #1, COMPORT$
6600 IF COLOR.MONITOR% THEN PRINT #1, "COLOR" ELSE PRINT #1, "MONOCHROME"
6615 IF BCC% THEN PRINT #1, "BCC" ELSE PRINT #1, "NO"
6620 CLOSE #1:
6640 '****** Set Up Color Definitions ******
6650 ON ERROR GOTO 6655       '880106
     IF COLOR.MONITOR% THEN
         SCREEN , , 0, 0: SCRN = 1: SCRN2 = 4: SCRN3 = 6
         BDR = 1: BDR2 = 4: BDR3 = 6: FG1 = 7: BG1 = 0
         FG2 = 7: BG2 = 4: FG3 = 14: BG3 = 0: FG4 = 8
         BG4 = 0: FG5 = 12: BG5 = 0: SCREEN , , 1, 0
         GOSUB 5730
         SCREEN , , 0, 0
         GOTO 6670
     END IF
6655 RESUME 6656              '880106
6656 COLOR.MONITOR% = FALSE%  '880106
6660 SCRN = 7: SCRN2 = 7: SCRN3 = 7: BDR = 0: BDR2 = 0: BDR3 = 0: FG1 = 15: BG1 = 0: FG2 = 0: BG2 = 7: FG3 = 15: BG3 = 0: FG4 = 7: BG4 = 0: FG5 = 0: BG5 = 7
6670 IF REWRITE$ = "Y" THEN RETURN ELSE GOTO 6720
6680 '
6690 '****** Error Trap ******
6700 RESUME 6160
6710 '
6720 COLOR FG1, BG1, BDR
6730 TEMP$ = CHR$(0): UP.ARROW$ = TEMP$ + "H"
6740 DOWN.ARROW$ = TEMP$ + "P"
6750 LEFT.ARROW$ = TEMP$ + "K"
6760 RIGHT.ARROW$ = TEMP$ + "M"
6770 DEL.CHAR$ = TEMP$ + "S"
6780 INS.CHAR$ = TEMP$ + "R"
6800 RETRN$ = CHR$(13)
6810 QT$ = CHR$(34) + "," + CHR$(34)
6820 MB$ = STRING$(115, CHR$(29))
6830 KR$ = CHR$(176)
6840 BS$ = CHR$(29): SX$ = CHR$(2): EX$ = CHR$(3): BK$ = CHR$(8)
6850 CR$ = CHR$(13)
6860 KC% = 0: KF% = 0: FO% = 0: FR% = 0: FB% = 0: FC% = 0
6870 B1$ = "%": B2$ = ";": B3$ = "+": B4$ = "?"
6890 KEY 1, CHR$(21)
6900 KEY 2, CHR$(2)
6920 KEY 3, CHR$(18)
6950 KEY 4, CHR$(17)
6969 KEY 5, CHR$(20)
7510 RETURN 150 '
7600 T0% = 1: T1% = 0: T2% = 0: T3% = 0

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -