Pcode V1.0b 2/4

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

        crctt = crctt * 2 AND 65535
END SUB

FUNCTION dec& (hexnum$)
        FOR i = 1 TO LEN(hexnum$)
                hexdigit = ASC(MID$(hexnum$, i, 1))
                decnum& = decnum& * 16 + hexdigit - 48 + 7 * (hexdigit > 64)
        NEXT i
        dec& = decnum&
END FUNCTION

SUB decode
decode1:
        INPUT #1, header$: version$ = LEFT$(header$, 7)
        IF version$ <> "pcode11" AND version$ <> "pcode12" THEN
                IF EOF(1) THEN CALL fileerror(3) ELSE GOTO decode1
        END IF
        IF version$ = "pcode11" THEN ll = 280 ELSE ll = 260
        length = dec&(MID$(header$, 8, 7))
        crcorg& = dec&(MID$(header$, 15, 4))
        ptime& = dec&(MID$(header$, 19, 4))
        pdate& = dec&(MID$(header$, 23, 4))
        outfile$ = RTRIM$(MID$(header$, 27, 8))
        outfile$ = outfile$ + "." + RTRIM$(MID$(header$, 35, 3))
        OPEN outfile$ FOR OUTPUT AS #2 LEN = 4096
        lines = length * 5 \ ll + 1
        FOR a = 1 TO lines
decode2:
                LINE INPUT #1, buffer: buffer = RTRIM$(buffer)
                IF LEFT$(buffer, 2) <> "dA" THEN
                        IF EOF(1) THEN CALL fileerror(7) ELSE GOTO decode2
                END IF
                CALL decodeline
        NEXT a
        destlen = LOF(2): length = LOF(1)
        CLOSE #1, #2
        CALL settimedate(outfile$, ptime&, pdate&)
        IF crcorg& <> crctt THEN CALL fileerror(1)
END SUB

SUB decodeline
        a& = SADD(buffer): a& = a& - 65536 * (a& < 0)
        bsegment = VARSEG(buffer) + (a& \ 16): boffset = (a& MOD 16)
        DEF SEG = bsegment
        FOR a = 2 TO LEN(buffer) - 1
                code = PEEK(boffset + a) - 35
                cpos = cpos - 1
                IF cpos = -1 THEN
                        cpos = 4: mscode = code
                ELSE
                        byte = code + (mscode MOD 3) * 92
                        mscode = mscode \ 3
                        PRINT #2, CHR$(byte);
                        CALL crc16(byte)
                END IF
        NEXT a
END SUB

SUB encode
        count& = length: block = 4096: power = 1: y = CSRLIN
        line$ = SPACE$(65): buffer = SPACE$(4096)
        outfile$ = infile$: CALL parsename(outfile$, ext$)
        OPEN outfile$ + ".pcd" FOR OUTPUT AS #2 LEN = 4096
        PRINT #2, "pcode12"; RIGHT$("000000" + HEX$(length), 7);
        PRINT #2, "000000000000"; LEFT$(outfile$ + "        ", 8);
        PRINT #2, LEFT$(ext$ + "   ", 3)
        WHILE (count&)
                IF count& < block THEN block = count&: buffer = SPACE$(block)
                GET #1, , buffer
                CALL encodeblock
                count& = count& - block
                LOCATE , 1: PRINT "Bytes Left:"; STR$(count&); "   ";

        WEND
        CALL send(1)
        CLOSE #1
        CALL gettimedate(infile$, ptime&, pdate&)
        SEEK #2, 15: PRINT #2, RIGHT$("000" + HEX$(crctt), 4);
        PRINT #2, RIGHT$("000" + HEX$(ptime&), 4);
        PRINT #2, RIGHT$("000" + HEX$(pdate&), 4);
        destlen = LOF(2)


... RAM = Rarely Adequate Memory
--- FMail 0.94
 * Origin: CzarLand BBS * Windsor, ON * Canada (1:246/27.0)