lk607a.bas

写卡用的软件

11 '*********************************************************
12 '**  GICOM  ENCODER PROGRAM ........... VERSION 1.00    **
13 '**    IBM PC VERSION ...... DATE:  06/11/91            **
14 '*********************************************************
15 '------------------ P A T C H   H I S T O R Y ----------------------
CLS

'
'=====> ARRAY DIMENSIONS <=====
70 DIM FMTS$(25), OI$(20), PN$(20), RS$(20), FL(20), TK%(35), DL%(35), FA%(35), FE%(35), CP%(35), AP%(35), AL%(35), CD$(35), PG%(35), TX$(35), VH%(35), DA$(35), LU%(35), MF%(35), XP%(35), YP%(35)
71 DIM SVA(107)
   DIM TRK%(50)
   DIM HST%(50), HSTDATA$(35), FLDTYPE$(50), CONST$(50), ZEROFILL%(35), VARLEN%(35)
   'Some arrays are indexed according to the number of non-constant fields,
   'while others are indexed according to the total number of fields.
   'When the format is loaded (see line number 7790), I% corresponds to
   'the total number of fields, and L% corresponds to the non-constant fields.
   DIM ILLINK%(50) 'links I% to L%
   DIM LILINK%(35) 'links L% to I%
   FOR I% = 1 TO 35
       HST%(I%) = 0
       HSTDATA$(I%) = ""
       ZEROFILL%(I%) = 0
       VARLEN%(I%) = 0
   NEXT I%
   PINCODE$ = CHR$(3) + CHR$(4) + CHR$(5) + CHR$(6)  '871228
   CR% = 13: ET% = 7: ESC% = 27'871228
80 '
90 DEF SEG = 0: POKE &H417, (PEEK(&H417) OR &H40): DEF SEG
100 WIDTH 80
110 '
120 CURSOR.FLASH.FREQ% = 300: '<===== SET TO  20 FOR INTERPRETIVE BASIC
130 '                                 SET TO 300 FOR COMPILED BASIC
140 GOSUB 5880
150 GOTO 5590
160  '
170 '    ***************************
180 '    **   INPUT LINE EDITOR   **
190 '    ***************************
200 FS% = 0: F1% = 0: F2% = 0: F3% = 0: F4% = 0: F5% = 0: F6% = 0: F7% = 0: F8% = 0: F9% = 0: F0% = 0: LB$ = LEFT$(FC$, FW%): FO% = 0: IF LEN(AB$) THEN FD% = 1: MID$(LB$, 1) = AB$
210 STARTX% = POS(1): STARTY% = CSRLIN
220 IF FD% AND LEN(AB$) > FW% THEN AB$ = LEFT$(AB$, FW%)
230 IF FD% = 0 THEN KP% = 0: LB% = 0: GOTO 270
240 KP% = LEN(AB$): LB% = KP%: IF LB% < FW% THEN PRINT AB$; : GOTO 270
250 IF FCD% = 0 THEN PRINT AB$; : GOTO 270
260 CH$ = RIGHT$(LB$, 1): PRINT LEFT$(AB$, LB% - 1); : GOSUB 1710: PRINT CH$; : COLOR FG1, BG1
270 POS.TO.EOL% = 81 - POS(1): IF (FW% - KP%) > POS.TO.EOL% THEN PRINT LEFT$(FC$, POS.TO.EOL%); : PRINT LEFT$(FC$, FW% - KP% - POS.TO.EOL%);  ELSE PRINT LEFT$(FC$, FW% - KP%);
280 LOCATE STARTY%, STARTX%, 0: KP% = 1
290 KF% = 1: KC% = 100
    IF LAST.OPER$ = "1" THEN
        LAST.OPER$ = "2"
    ELSE
        LAST.OPER$ = "0"
    END IF
300 DEF SEG = 0: POKE &H417, (PEEK(&H417) OR &H40): DEF SEG
310 CH$ = INKEY$: GOSUB 1070: IF CH$ = "" THEN 310
320 CH% = ASC(CH$)
330 IF FC% = 1 THEN 430
340 'IF FS%=0 THEN IF CH$=" " THEN FS%=1: GOTO 1030 ELSE CH%=ASC(CH$):IF CH%=30 THEN 440 ELSE IF CH%=31 THEN 450 ELSE FS%=1
345 IF CH% = 63 THEN GOTO 610
350 IF CH% > 31 THEN GOTO 540
360 IF CH$ = DEL.CHAR$ THEN 880
370 IF CH% = 8 THEN GOSUB 1100: GOTO 1140
380 IF CH$ = INS.CHAR$ THEN
        LAST.OPER$ = "1"
        GOTO 960
    END IF
390 IF CH% = 11 THEN 1030
400 IF CH$ = RIGHT.ARROW$ THEN
        FIRSTCHR$ = "FALSE"
        GOTO 830
    END IF
410 IF CH$ = LEFT.ARROW$ THEN 720
420 IF CH% = 2 THEN F0% = 1: GOSUB 1100: GOTO 780
430 IF CH% = 13 THEN F3% = 1: GOSUB 1100: GOTO 780
440 IF CH$ = UP.ARROW$ THEN IF KP% < 81 THEN F2% = 1: GOSUB 1100: GOTO 780 ELSE IF KP% > 80 THEN PRINT MID$(LB$, KP%, 1); : LOCATE CSRLIN - 1, POS(1) - 1, 0: KP% = KP% - 80: GOTO 290
450 IF CH$ = DOWN.ARROW$ THEN IF LB% < 81 OR (LB% > 80 AND (LB% - KP%) < 80) THEN F1% = 1: GOSUB 1100: GOTO 780 ELSE IF (LB% - KP%) > 79 THEN GOSUB 1100: LOCATE CSRLIN + 1, POS(1), 0: KP% = KP% + 80: GOTO 290
460 IF CH% = 17 THEN F4% = 2: GOSUB 1100: GOTO 780
470 IF CH% = 27 THEN F4% = 1: GOSUB 1100: GOTO 780
480 IF CH% = 5 THEN F5% = 1: GOSUB 1100: GOTO 780
490 IF CH% = 26 THEN F6% = 1: GOSUB 1100: GOTO 780
500 IF CH% = 21 THEN F8% = 1: GOSUB 1100: GOTO 780
510 IF CH% = 16 THEN F9% = 1: GOSUB 1100: GOTO 780
520 IF CH% = 18 THEN F7% = 1: GOSUB 1100: GOTO 780
530 BEEP: GOTO 310
540 IF FA% = 0 AND CH% > 47 AND CH% < 58 THEN 620
542 IF FA% = 0 AND CH% > 47 AND CH% < 63 AND ENCODE$ = "UNFORMATTED" THEN 620
550 IF FA% AND (CH% > 31 AND CH% < 96) THEN 620
560 IF TK% = 2 AND FA% = 0 THEN IF CH% = 59 THEN 620
570 IF TK% = 3 AND FA% = 0 THEN IF CH% = 43 OR CH% = 58 THEN 620
580 IF FA% = 0 AND (TK% = 2 OR TK% = 3) AND CH% = 61 THEN 620
590 IF CH% = 63 THEN 620
600 IF CH% = 127 THEN LOCATE STARTY%, STARTX%, 0: FD% = 0: AB$ = "": GOTO 200
610 BEEP: GOTO 310
620 IF KP% < FW% OR FW% = 1 THEN FO% = 0: GOTO 650
630 'IF FO% THEN BEEP
640 FO% = 1
650 IF KP% > LB% AND LB% < FW% THEN LB% = LB% + 1
660 MID$(LB$, KP%) = CH$
    GOSUB 1710
    PRINT CH$;
    IF KP% < FW% THEN
        KP% = KP% + 1
    ELSE
        PRINT BS$;
        KF% = 0
        KC% = 100
        GOTO 310
    END IF
    IF FIRSTCHR$ = "TRUE" THEN
        FIRSTCHR$ = "FALSE"
        IF CH% >= 32 AND CH% <= 124 AND LAST.OPER$ <> "2" THEN
            IF LB% >= KP% THEN
                GOTO 1030
            END IF
        END IF
    END IF
670 GOTO 290
680 '
700 '
710 '  ***** LEFT ARROW *****
720 IF KP% = 1 THEN BEEP: GOTO 310
730 IF KP% > LB% THEN PRINT "."; BS$; BS$; KR$; BS$;  ELSE PRINT MID$(LB$, KP%, 1); BS$; BS$; KR$; BS$;
740 COLOR FG1, BG1
750 KP% = KP% - 1: GOTO 290
760 '
770 '  ***** RETURN *****
780 IF FC% <> 1 THEN IF (FR% OR (FZ% AND (LB% > 0))) AND (CH% = 13 OR CH% = 31) THEN IF LB% < FW% THEN BEEP: F1% = 0: F3% = 0: GOTO 310
790 IF FZ% = 1 AND LB% = 0 THEN LB$ = STRING$(FW%, "0") ELSE LB$ = LEFT$(LB$, LB%)
800 FR% = 0: TK% = 0: FZ% = 0: FD% = 0: FCD% = 0: AB$ = "": COLOR FG1, BG1: RETURN
810 '
820 '  ***** RIGHT ARROW *****
830 IF KP% = FW% OR KP% > LB% THEN BEEP: GOTO 310
840 PRINT MID$(LB$, KP%, 1); : KP% = KP% + 1: IF FCD% THEN CH$ = MID$(LB$, KP%, 1): GOSUB 1710
850 PRINT KR$; BS$; : GOTO 290
860 '
870 '  ***** DELETE CHARACTER *****
880 IF KP% > LB% THEN BEEP: GOTO 290
890 IF KP% = LB% THEN PRINT "."; BS$; : GOTO 930
900 AB$ = MID$(LB$, KP% + 1, LB% - KP%): MID$(LB$, KP%) = AB$: SAVEX% = POS(1): SAVEY% = CSRLIN
910 POS.TO.EOL% = 81 - POS(1): IF LEN(AB$) > POS.TO.EOL% THEN PRINT LEFT$(AB$, POS.TO.EOL%); : PRINT MID$(AB$, POS.TO.EOL% + 1); :                                               ELSE PRINT AB$;
920 PRINT "."; : LOCATE SAVEY%, SAVEX%, 0
930 LB% = LB% - 1
    GOTO 290
940 '
950 '  ***** INSERT CHARACTER *****
960 IF KP% + 1 >= LEN(LB$) THEN
        BEEP
        GOTO 290
    END IF                        ' 880125
    MID$(LB$, KP% + 1) = MID$(LB$, KP%, LB% - KP% + 1): IF LB% < FW% THEN LB% = LB% + 1
970 IF FA% = 0 THEN AB$ = "0" ELSE AB$ = " "
980 MID$(LB$, KP%) = AB$: I% = LB% - KP% + 1: SAVEX% = POS(1): SAVEY% = CSRLIN
990 POS.TO.EOL% = 81 - POS(1): IF I% > POS.TO.EOL% THEN PRINT MID$(LB$, KP%, POS.TO.EOL%); : PRINT MID$(LB$, KP% + POS.TO.EOL%, I% - POS.TO.EOL%);  ELSE PRINT MID$(LB$, KP%, I%);
1000 LOCATE SAVEY%, SAVEX%, 0: GOTO 290
1010 '
1020 '  ***** KILL REST OF LINE *****
1030 IF LB% >= KP% THEN I% = LB% - KP% + 1: SAVEX% = POS(1): SAVEY% = CSRLIN: PRINT LEFT$(FC$, I%); : LOCATE SAVEY%, SAVEX%, 0: LB% = KP% - 1 ELSE BEEP
1040 GOTO 290
1050 '
1060 '  ***** CURSOR *****
1070 KC% = KC% + 1: IF KC% < CURSOR.FLASH.FREQ% THEN RETURN
1080 IF FC% = 1 THEN 1100
1090 KC% = 0: IF KF% THEN KF% = 0: PRINT KR$; BS$; : RETURN
1100 KF% = 1: IF KP% <= LB% THEN PRINT MID$(LB$, KP%, 1); BS$; : RETURN
1110 PRINT LEFT$(FC$, 1); BS$; : RETURN
1120 '
1130 '  ***** DELETE KEY *****
1140 IF KP% = 1 THEN BEEP: GOTO 290
1150 IF KP% = FW% AND LB% = FW% THEN FO% = 0: GOTO 880
1160 PRINT BS$; : KP% = KP% - 1: GOTO 880
1170 '
1180 '     ********************
1190 '     **   PAGE TITLE   **
1200 '     ********************
1210 TOPROW1 = 5: LEFTCOL1 = 15: BWIDTH = 50: BHEIGHT = 15
1220 COLOR FG1, SCRN: CLS : COLOR FG1, BG1: GOSUB 10290
1230 LOCATE TOPROW1 + 1, LEFTCOL1 + (BWIDTH - LEN(TL$)) / 2, 0
1240 PRINT TL$; : RETURN
1250 '
1260 '     **********************
1270 '     **   CLEAR FIELDS   **
1280 '     **********************
1290 FOR I% = 1 TO NL%: IF CD$(I%) = "" THEN DA$(I%) = "": FE%(I%) = 0 ELSE DA$(I%) = CD$(I%): IF LEN(DA$(I%)) = DL%(I%) THEN FE%(I%) = 1
1300 AP%(I%) = CP%(I%): IF FA%(I%) AND 1 THEN FE%(I%) = 1: AL%(I%) = LEN(DA$(I%)) ELSE AL%(I%) = DL%(I%)
1310 NEXT I%
     FOR I% = 1 TO NL%
         DA$(I%) = ""
         HSTDATA$(I%) = ""
     NEXT I%
1320 A1% = P1%: A2% = P2%: A3% = P3%: PP% = 1: PM% = 1: PL% = LU%(PM%): O1$ = X1$: O2$ = X2$: O3$ = X3$
1330 RETURN
1340 '
1350 '     **********************
1360 '     **   DISPLAY PAGE   **
1370 '     **********************
1380 FOR I% = 1 TO NS%
1390 J% = LU%(I%)
1400 IF PG%(J%) <> PP% THEN 1440
1410 LOCATE TOPROW1 + YP%(J%) - 1, LEFTCOL1 + XP%(J%) - 1, 0
     PRINT " "; TX$(J%); " ";
     IF HSTDATA$(J%) <> "" THEN DA$(J%) = HSTDATA$(J%)'ADDED 871228
1420 IF (DA$(J%) = "") OR (FA%(J%) AND 128 = 128) AND (DA$(J%) = STRING$(DL%(J%), "0")) THEN
         IF HSTDATA$(J%) <> "" THEN
             PRINT HSTDATA$(J%);
         ELSE
             PRINT LEFT$(FC$, DL%(J%));
         END IF
         GOTO 1440
     END IF
1430 PRINT DA$(J%);
     IF LEN(DA$(J%)) < DL%(J%) THEN
         PRINT LEFT$(FC$, DL%(J%) - LEN(DA$(J%)));
     ELSE
         IF FA%(J%) AND 4 THEN
             LB$ = DA$(J%): CH$ = RIGHT$(LB$, 1)
             GOSUB 1720
             PRINT BS$; CH$;
             COLOR FG1, BG1
         END IF
     END IF
1440 NEXT I%
1450 RETURN
1460 '
1470 '     ********************
1480 '     **   DOWN ARROW   **
1490 '     ********************
1500 I% = PM%: IF PM% = 0 THEN PM% = 1
1510 IF I% >= NS% THEN BEEP: 'GOTO 3920
1520 I% = I% + 1
1530 IF FC% = 1 THEN IF (FA%(LU%(I%)) AND 2) > 0 THEN 1510
1540 PM% = I%
1550 GOSUB 4370: PL% = LU%(PM%)
1560 IF PP% <> PG%(PL%) THEN PP% = PG%(PL%): 'GOTO 3880
1570 'GOTO 3910
1580 '
1590 '     ******************
1600 '     **   UP ARROW   **
1610 '     ******************
1620 I% = PM%
1630 IF I% = 1 THEN BEEP: 'GOTO 3920
1640 I% = I% - 1
1650 IF FC% = 1 THEN IF (FA%(LU%(I%)) AND 2) > 0 THEN 1630
1660 GOTO 1540
1670 '
1680 '***************************************
1690 '**  Check Digit Calculating Routine  **
1700 '***************************************
1710 IF FCD% = 0 OR KP% < FW% THEN RETURN
1720 EE% = LEN(LB$) - 2: FF% = EE% + 1: TL% = 0
1730 FOR II% = 0 TO EE%: NN% = ASC(MID$(LB$, FF% - II%, 1)) AND 15
1740 IF (II% AND 1) = 0 THEN NN% = NN% + NN%: IF NN% > 9 THEN NN% = NN% - 9
1750 TL% = TL% + NN%: NEXT
1760 CD$ = CHR$(((10 - (TL% MOD 10)) MOD 10) OR 48)
1770 IF CD$ <> CH$ THEN BEEP: COLOR FG5, BG5 ELSE COLOR FG1, BG1
1780 RETURN
2010 '
2020 '     ***********************
2030 '     **   ENCODE A CARD   **
2040 '     ***********************
2050 FX% = 0: T4% = 1: T7% = 0: GOSUB 3740
2060 ON ERROR GOTO 2360
2070 OPEN COMPORT$ FOR RANDOM AS #1
2080  LB$ = INPUT$(LOC(1), 1)
2090 COLOR FG3 + 16, BG3: LOCATE 21, 20, 0: PRINT " *** Pass a card through encoder *** "; : COLOR FG1, BG1
2091 IF BCC% THEN 2094
2092 GOTO 2100
2094 IF ER% THEN 2100
2095 LENOB% = LEN(OB$): CS3% = ASC(CHR$(0))
2096 FOR K% = 1 TO LENOB%: CH3% = ASC(MID$(OB$, K%, 1)): CS3% = CS3% XOR CH3%
2097 NEXT K%
2098 CS3% = CS3% XOR ASC(SX$)
2099 OB$ = OB$ + CHR$(CS3%): 'PRINT OB$; : GOTO 2099
2100 PRINT #1, OB$;
2110 '
2120 '***** READ INCOMING MESSAGE *****
2121 '      Added WHILE..WEND and GOSUB 60000 on 870622
2123 WHILE EOF(1)
2124   IF INKEY$ = ESCAPE$ THEN ON ERROR GOTO 0: GOTO 2330
2125 WEND
2127 GOSUB 60000
2128 '
2260 ON ERROR GOTO 0
2270 CLOSE 1
2275 IF X1 = 1 THEN LB$ = LB$ + CHR$(CS3%)
2280 IF LB$ = OB$ THEN
         RETURN
     END IF
2290 CLS : LOCATE 12, 31, 0: PRINT " ENCODE ERROR! ";
2300 LOCATE 14, 30, 0: PRINT "PLEASE TRY AGAIN."; : PRINT : PRINT : BEEP
2310 GOSUB 4750
2315 ER% = 1
2320  IF T7% = 1 THEN T9% = 1: FX% = 0: T4% = 1: GOSUB 9907: GOTO 2060
2323 ' IF T7% = 1 THEN 2060
2325 GOTO 2050
2330 CLOSE 1
2335 IF T7% = 1 OR T8% = 1 THEN 9500
2337 FX% = 1: CLS : LOCATE 11, 26, 0: PRINT "ENCODE OPERATION ABORTED!": PRINT : ON ERROR GOTO 0: GOSUB 4750: RETURN
2340 '
2350 '***** ERROR TRAP *****
2360 IF ERR = 5 THEN RESUME NEXT
2370 IF ERR = 57 THEN RESUME
     IF ERR = 64 THEN GOTO 90000         '880125
2380 IF INKEY$ = ESCAPE$ THEN RESUME 2330
2390 LOCATE 21, 20, 0: COLOR FG3 + 16, BG3: PRINT "     ERROR!.......CHECK ENCODER!"; STRING$(20, " "); : COLOR FG1, BG1: BEEP
2392 IF T8% = 1 OR T7% = 1 THEN KY$ = INKEY$