'===========================================================================
' Subject: UUENCODE/DECODE FOR PB            Date: 04-25-97 (09:12)       
' Author:  Alexander Podkolzin               Code: PB                     
' Origin:  app@nw.sbank.e-burg.su          Packet: BINARY.ABC
'===========================================================================
'---------------------------------------------------------------------------
'                                                                          '
' Alexander Podkolzin. <App@nw.sbank.e-burg.su>                            '
' Demo program for PB3.2 compiller.                                        '
' PUBLIC DOMAIN UUencode and UUdecode functions.                           '
' USE IT ON YOUR OWN RISC!                                                 '
'                                                                          '
' UUencode and UUdecode snippet from my working NewsReader program.        '
' I use it about a year or so. It works fine for me.                       '
' Test it before using!                                                    '
'                                                                          '
' Special thanks to David J. Arigan, whos ideas I used in my program.      '
'                                                                          '
' I do not use here ASM, but functions works very fast ( I hope they are   '
' the fastest from functions written in pure BASIC :) due to pointers ...  '
' Sorry, code is not commented enought, as I feel not free with my English.'
'                                                                          '
' Pleeeease, IF YOU WILL ENHANCE THIS CODE SEND ME YOUR IDEAS !!!          '
'                                                                          '
'---------------------------------------------------------------------------
'
' Demo here:
'
  
  DEFINT A-Z
  
  COLOR 7,0
  CLS
  INPUT "Input FileName to UUencode ", FileName$
  IF NOT fFileHere(FileName$) THEN
    PRINT FileName$; " <- File not found!"
    END
  END IF

  Attach$ = "$$temp$$.$$$"
  Fs& = fFileSize(FileName$)      ' File size
  PRINT "File size ="; Fs&; "bytes."

  COLOR 28,0
  LOCATE 1,70
  PRINT "Encoding..."

  t# = TIMER
'///////////////////////////////////////////////////////////

  AttachUUEncode FileName$, Attach$    ' UU Encoding

'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  COLOR 7,0
  LOCATE 1,70
  PRINT "           "

  LOCATE 3,1
  PRINT "UU Encoding Done!  Time of encoding="; USING$("###.##s",TIMER-T#)
  SOUND 880,.5

  PRINT "Press a key..." : s$ = INPUT$(1)  ' Pause

  COLOR 28,0
  LOCATE 1,70
  PRINT "Decoding..."

  t# = TIMER
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

  ExtractUU Attach$                    ' UU Decoding

'///////////////////////////////////////////////////////////
  COLOR 7,0
  LOCATE 1,70
  PRINT "           "

  LOCATE 5,1
  PRINT "UU Decoding Done!  Time of decoding="; USING$("###.##s",TIMER-T#)
  SOUND 440,.5

  PRINT
  PRINT "THANK YOU VERY MUCH FOR TESTING THIS PROGRAM !"

  END
'
'---------------------------------------------------------------------------
' FileName$ - File name to UUencode
' Attach$   - File to append to
'
 SUB AttachUUEncode(FileName$,Attach$)
'
    file$ = FileName$                   '
    pnam$ = file$                       '
    unam$ = file$                       '
'
    n = RInstr(1,pnam$, "\")
    IF n THEN
       pnam$ = MID$(pnam$, n + 1)
    END IF
'
    unam$ = MID$(file$, RInstr(1,file$, "\") + 1)
    n = INSTR(unam$,".")
    IF n THEN
       unam$ = LEFT$(unam$, n - 1)
    END IF
'
    Src% = FREEFILE
    OPEN file$ FOR BINARY AS Src%
    SrcU% = FREEFILE
    OPEN Attach$ FOR OUTPUT AS Srcu%       ' Or APPEND, if file exists
    PRINT #SrcU%, ""
    PRINT #SrcU%, ""
    PRINT #SrcU%, "+++++++++++++++++++++   Attachment :   ++++++++++++++++++++++"
    PRINT #SrcU%, ""
'
    M1$="begin 644 "
    M2$="end"
    LP$="`"
    cl$ = SPACE$(45)
'
    PRINT #SrcU%,M1$+Pnam$                 'print header line
'
    WHILE NOT EOF(src%)
       BufIn$=cl$
       GET$ #Src%,45,BufIn$
       LineOut$ = EncodeLine(BufIn$)
       Temp = 3 * LEN(LineOut$) \ 4        'get unencoded character count
       LineOut$ = CHR$(32+Temp) + LineOut$ 'add count to line
       PRINT #SrcU%,LineOut$
       LineOut$ = ""
    WEND
    PRINT #SrcU%,LP$
    PRINT #SrcU%,M2$                       'output "end" line
    CLOSE Src%, SrcU%
'
 END SUB
'___________________________________________________________________________
'
 SUB ExtractUU(Unam$)
  SrcFile$ = Unam$
  Src = FREEFILE
  OPEN SrcFile$ FOR INPUT AS Src
  WHILE NOT EOF(Src)
    LINE INPUT #Src, l$
    INCR LineNumber
    IF LEFT$(l$, 5) = "begin" THEN
        DestFile$ = MID$(l$,11)
        Dest = FREEFILE
        OPEN DestFile$ FOR BINARY AS Dest
        DO
          LINE INPUT #Src, l$
          INCR LineNumber
          IF LCASE$(LEFT$(l$, 3)) = "end" THEN EXIT DO
          IF LEN(l$) THEN
            s$ = DecodeLine(MID$(l$,2))
            PUT Dest, , s$
          END IF
        LOOP UNTIL EOF(Src)
        CLOSE Dest
    END IF
  WEND
  CLOSE Src
 END SUB
'___________________________________________________________________________
'
  FUNCTION EncodeLine$(l$)
'
    DIM Iptr AS BYTE PTR
    DIM Optr AS BYTE PTR
'
    l = LEN(l$)
    m = l MOD 3
'
    IF m = 1 THEN
       l$ = l$ + "  "
       INCR l,2
    ELSEIF m = 2 THEN
       l$ = l$ + " "
       INCR l
    END IF
'
    n = l \ 3
    o$ = SPACE$( n * 4 )
'
    Iptr = STRPTR32(l$)
    Optr = STRPTR32(o$)
'
    FOR i=1 TO n
      EncodeCell Iptr,Optr
      INCR Iptr,3
      INCR Optr,4
    NEXT
'
    REPLACE " " WITH "`" IN o$
'
    FUNCTION = o$
'
  END FUNCTION
'___________________________________________________________________________
'
  SUB EncodeCell( InCell AS DWORD, OutCell AS DWORD )
'
    DIM ICell AS BYTE PTR
    DIM OCell AS BYTE PTR
'
    ICell = InCell???
    OCell = OutCell???
'
    a? = @ICell
    a1? = (@ICell AND 252) \  4
    a2? = (a? AND   3)     * 16
'
    INCR ICell
    b? = @ICell
    b1? = (b? AND 240)     \ 16
    b2? = (b? AND  15)     *  4
'
    INCR ICell
    c? = @ICell
    c1? = (c? AND 192)     \ 64
    c2? = (c? AND  63)
'
    @OCell = 32+a1?
    INCR OCell
    @OCell = 32+a2?+b1?
    INCR OCell
    @Ocell = 32+b2?+c1?
    INCR OCell
    @OCell = 32+c2?
'
  END SUB
'___________________________________________________________________________
'
  FUNCTION DecodeLine$(l$)
'
    DIM Iptr AS BYTE PTR
    DIM Optr AS BYTE PTR
'
    REPLACE "`" WITH " " IN l$
    n = LEN(l$) \ 4
    o$ = SPACE$( n * 3 )
'
    Iptr = STRPTR32(l$)
    Optr = STRPTR32(o$)
'
    FOR i=1 TO n
      DecodeCell Iptr,Optr
      INCR Iptr,4
      INCR Optr,3
    NEXT
'
'
    FUNCTION = o$
'
  END FUNCTION
'___________________________________________________________________________
'
  SUB DecodeCell( InCell AS DWORD, OutCell AS DWORD )
'
    DIM ICell AS BYTE PTR
    DIM OCell AS BYTE PTR
'
    ICell = InCell???
    OCell = OutCell???
'
    a?  = @ICell - 32
    a1? = a? * 4
'
    INCR ICell
    b?  = @ICell - 32
    a2? = (b? AND 48) \ 16
    b1? = (b? AND 15) * 16
'
    INCR ICell
    c?  = @ICell - 32
    b2? = (c? AND 60) \  4
    c1? = (c? AND  3) * 64
'
    INCR ICell
    d?  = @ICell - 32
    c2? = (d? AND 63)
'
    @OCell = a1? + a2?
    INCR OCell
    @OCell = b1? + b2?
    INCR OCell
    @Ocell = c1? + c2?
'
  END SUB
'___________________________________________________________________________
'
  FUNCTION RInstr(BYVAL start, BYVAL Main$, BYVAL Search$) PUBLIC
    lm = LEN(Main$)
    ls = LEN(Search$)
    FOR i = lm - ls + 1 TO 1 STEP -1
      IF MID$(Main$,i,ls) = Search$ THEN
        FUNCTION = i
        EXIT FUNCTION
      END IF
    NEXT
    FUNCTION = 0
  END FUNCTION
'
'---------------------------------------------------------------------------
  FUNCTION fFileHere%(FileNAME$) PUBLIC
     FUNCTION = ( DIR$(FileNAME$) <> "" )
  END FUNCTION
'---------------------------------------------------------------------------
 FUNCTION fFileSize&(FileName$)
   IF fFileHere(FileName$) THEN
     f% = FREEFILE
     OPEN "r",f%,FileName$
     l& = LOF(f%)
     CLOSE f%
   ELSE
     l& = -1
   END IF
   FUNCTION = l&
 END FUNCTION
'___________________________________________________________________________