Pcode V1.0b 1/4

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

' Pcode V1.0b - written by David Arigan
'
' Features: 16 bit CRCs
'           Fast 7 bit encryption
'           File Date/Time preservation
'           Ignores extra line spacing and/or garbage
'
' Usage:    QB /RUN PCODE.BAS /L LIB\QB.QLB
'
' $INCLUDE: 'qb.bi'

DECLARE SUB parsename (file$, ext$)
DECLARE SUB decode ()
DECLARE SUB decodeline ()
DECLARE SUB settimedate (file$, time&, date&)
DECLARE SUB gettimedate (file$, time&, date&)
DECLARE SUB crc16 (byte%)
DECLARE SUB encodeblock ()
DECLARE SUB send (flag%)
DECLARE SUB encode ()
DECLARE SUB closeh (handle%)
DECLARE FUNCTION openh% (file$)
DECLARE FUNCTION dec& (hexnum$)
DECLARE SUB fileerror (errnum%)

DEFINT A-Z

DIM SHARED buffer AS STRING
DIM SHARED bsegment AS INTEGER
DIM SHARED boffset AS INTEGER
DIM SHARED crctt AS LONG
DIM SHARED length AS LONG
DIM SHARED destlen AS LONG
DIM SHARED lines AS INTEGER
DIM SHARED block AS INTEGER
DIM SHARED inreg AS RegTypeX
DIM SHARED outreg AS RegTypeX
DIM SHARED mscode AS INTEGER
DIM SHARED lscode(0 TO 3)  AS INTEGER
DIM SHARED power AS INTEGER
DIM SHARED cpos AS INTEGER
DIM SHARED line$, infile$, outfile$

CLS
PRINT "PCode V1.0 - written by David Arigan"
PRINT
PRINT "1) Encode file"
PRINT "2) Decode file"
PRINT "3) Quit"
PRINT
PRINT "Choice: "; : LOCATE , , 1
DO: a$ = INKEY$: LOOP UNTIL a$ = "1" OR a$ = "2" OR a$ = "3"
PRINT a$
PRINT : LOCATE , , 0
IF a$ = "3" THEN CLS : END
LINE INPUT "Source Filename: "; infile$
IF infile$ = "" THEN RUN
PRINT
IF a$ = "1" THEN OPEN infile$ FOR BINARY AS #1
IF a$ = "2" THEN OPEN infile$ FOR INPUT AS #1
length = LOF(1): IF length = 0 THEN CALL fileerror(2)
IF a$ = "1" THEN CALL encode
IF a$ = "2" THEN CALL decode
PRINT "Total lines:"; lines
PRINT "Source file length:"; length
PRINT "Destination file length"; destlen
PRINT "Ratio: "; LTRIM$(STR$(destlen * 100 \ length)); "%"
END

SUB closeh (handle)
        inreg.ax = &H3E00
        inreg.bx = handle
        CALL INTERRUPTX(&H21, inreg, outreg)
        IF outreg.flags AND 1 THEN fileerror (6)
END SUB

SUB crc16 (byte)
        crctt = (crctt XOR byte * 256&) * 2
        IF crctt AND 32768 THEN crctt = crctt XOR 4129


... SENILE.COM found . . . Out Of Memory . . .
--- FMail 0.94
 * Origin: CzarLand BBS * Windsor, ON * Canada (1:246/27.0)