Pcode V1.0b 3/4

 BBS: Inland Empire Archive
Date: 06-13-93 (15:36)             Number: 253
From: DAVE ARIGAN                  Refer#: NONE
  To: ALL                           Recvd: NO  
Subj: Pcode V1.0b 3/4                Conf: (2) Quik_Bas

        CLOSE #2
        PRINT
END SUB

SUB encodeblock
        a& = SADD(buffer): a& = a& - 65536 * (a& < 0)
        bsegment = VARSEG(buffer) + (a& \ 16): boffset = (a& MOD 16)
        DEF SEG = bsegment
        FOR pointer = 0 TO block - 1
                byte = PEEK(boffset + pointer)
                CALL crc16(byte)
                lscode(cpos) = byte MOD 92
                mscode = mscode + (byte \ 92) * power
                power = power * 3
                cpos = cpos + 1
                IF cpos = 4 THEN
                        CALL send(0)
                        power = 1
                        cpos = 0
                        mscode = 0
                END IF
        NEXT pointer
END SUB

SUB fileerror (errornum)
        CLS : PRINT "ERROR: ";
        IF errornum = 1 THEN PRINT "Bad CRC, file could be corrupt."
        IF errornum = 2 THEN PRINT "Source file not found."
        IF errornum = 3 THEN PRINT "Incorrect version."
        IF errornum = 4 THEN PRINT "Can't read file time/date."
        IF errornum = 5 THEN PRINT "Can't write file time/date."
        IF errornum = 6 THEN PRINT "Can't access file for I/O."
        IF errornum = 7 THEN PRINT "Source file too short."
        END
END SUB

SUB gettimedate (file$, time&, date&)
        handle = openh(file$)
        inreg.ax = &H5700
        inreg.bx = handle
        CALL INTERRUPTX(&H21, inreg, outreg)
        time& = outreg.cx
        date& = outreg.dx
        IF outreg.flags AND 1 THEN CALL fileerror(4)
        CALL closeh(handle)
END SUB

FUNCTION openh (file$)
        f$ = file$ + CHR$(0)
        inreg.dx = SADD(f$)
        inreg.ds = VARSEG(f$)
        inreg.ax = &H3D02
        CALL INTERRUPTX(&H21, inreg, outreg)
        IF outreg.flags AND 1 THEN CALL fileerror(6)
        openh = outreg.ax
END FUNCTION

SUB parsename (file$, ext$)
        ext$ = ""
        FOR a = LEN(file$) TO 1 STEP -1
                IF INSTR(":\", MID$(file$, a, 1)) THEN
                        file$ = MID$(file$, a + 1)
                        EXIT FOR
                END IF
        NEXT a
        FOR a = LEN(file$) TO 1 STEP -1
                IF MID$(file$, a, 1) = "." THEN
                        ext$ = MID$(file$, a + 1)
                        file$ = LEFT$(file$, a - 1)
                        EXIT FOR
                END IF
        NEXT a
END SUB

SUB send (flag) STATIC
        IF NOT flag THEN
                lnpos = lnpos + 1
                MID$(line$, lnpos) = CHR$(mscode + 35)
                FOR a = 1 TO cpos


... A feature is a bug with seniority.
--- FMail 0.94
 * Origin: CzarLand BBS * Windsor, ON * Canada (1:246/27.0)