FB II Compiler

PG PRO

Debugging

Memory

System

Mathematics

Resources

Disk I/O

Windows

Controls

Menus

Mouse

Keyboard

Text

Fonts

Drawing

Sound

Clipboard

Printing

Communication

ASM

Made with FB

TEXT

Encode and decode in base 64


'=================
LOCAL FN DecodeBase64(hndl&)
  DIM osErr%
  DIM result&,state%,size&,rsize&
  DIM ofs&,s%,rep%
  DIM rPtr&,i&,j%,r&;0,rh%,rl%,p%

  DEFSTR LONG
  result& = _nil
  LONG IF hndl&<>_nil
    state% = FN HGETSTATE(hndl&)
    osErr% = FN HUNLOCK(hndl&)
    s% = &H0D00 : ofs& = 0 : rep% = 0
    DO
      ofs& = FN MUNGER (hndl&,ofs&,@s%,1,@rep%,0)
    UNTIL ofs&<0
    s% = &H0A00 : ofs& = 0
    DO
      ofs& = FN MUNGER (hndl&,ofs&,@s%,1,@rep%,0)
    UNTIL ofs&<0
    size& = FN GETHANDLESIZE(hndl&)
    LONG IF size&<>0 AND (size& AND 3<>0)
      rsize& = (size&>>2)*3
      result& = FN NEWHANDLE (rsize&)
      LONG IF result&<>_nil
        osErr% = FN HLOCK(hndl&)
        osErr% = FN HLOCK(result&)
        rPtr& = [result&]
        FOR i&=0 TO size&-1 STEP 4
          r& = 0
          FOR j%=0 TO 3
            p% = PEEK([hndl&]+i&+j%)
            COMPILE LONG IF _false
              SELECT
                CASE p%>=_"A" AND p%<=_"Z"
                  p% = p%-&H41
                CASE p%>=_"a" AND p%<=_"Z"
                  p% = p%-&H47
                CASE p%>=_"0" AND p%<=_"9"
                  p% = p%+&H04
                CASE p%=_"+"
                  p% = p%+&H13
                CASE p%=_"/"
                  p% = p%+&H10
                CASE ELSE
                  p% = 0
              END SELECT
            COMPILE END IF
            SELECT
              CASE p%>=_"a"
                p% = p%-&H47
              CASE p%>=_"A"
                p% = p%-&H41
              CASE p%>=_"0" AND p%<=_"9"
                p% = p%+&H04
              CASE p%=_"+"
                p% = p%+&H13
              CASE p%=_"/"
                p% = p%+&H10
              CASE ELSE
                p% = 0
            END SELECT
            'p% INSTR(1,"BCDEFGHIJKLMNOPQRSTUVEXYZabcdefghijklmnopqrstuvwxyz0123456789+/",CHR$(p%))
            ' You had better user table for better performance.
            r& = (r&<<6)+p%
          NEXT j%
          POKE rPtr&  ,rh%
          %    rPtr&+1,rl%
          rPtr& = rPtr&+3
        NEXT
        osErr% = FN HUNLOCK(result&)
        LONG IF {([hndl&]+size&-2)}=_"=="
          osErr% = FN SETHANDLESIZE(result&,rsize&-2)
        XELSE
          LONG IF PEEK([hndl&]+size&-1)=_"="
            osErr% = FN SETHANDLESIZE(result&,rsize&-1)
          END IF
        END IF
      END IF
    END IF
    osErr% = FN HSETSTATE(hndl&,state%)
  END IF
END FN = result&
Ops, that was decode routine...
Here is encoder (for Japanese text)
COMPILE 0,_macsBugLabels
LOCAL FN EncodeBase64(@txtHPtr&)
  DIM err%,size&,last%,newHndl&,newSize&,p&,t$,i%
  txtH& = [txtHPtr&]
  LONG IF txtH&
    size& = FN GETHANDLESIZE(hndl&)
    LONG IF size&
      last% = size& MOD 3
      size& = (size& \ 3)+1
      LONG IF last%
        err% = FN SETHANDLESIZE(hndl&,size&+size&+size&)
        IF err% THEN EXIT FN
        FOR i%=1 TO last%
          POKE([hndl&]+size&+size&+size&-i%),0
        NEXT
      END IF

      newHndl& = FN NEWHANDLE(0)
      LONG IF newHndl&<>_nil
        WHILE size&
          p& = {[hndl&]}
          p& = (p& << 8)+PEEK([hndl&]+2)
          t$ = ""
          FOR i%=0 TO 3
            t$ MID$("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/",
                 p& AND &H3F+1,1)+t$ : p& = p&>>6
          NEXT
          err% = FN HLOCK(hndl&)
          BLOCKMOVE [hndl&]+3,[hndl&],size&+size&+size&
          err% = FN HUNLOCK(hndl&)
          newSize& = newSize&+4
          err% = FN HUNLOCK(newHndl&)
          err% = FN SETHANDLESIZE(newHndl&,newSize&)
          LONG IF err%=_noErr
            err% = FN HLOCK(newHndl&)
            BLOCKMOVE @t$+1,[newHndl&]+newSize&-4,4
            DEC(size&)
          XELSE
            size& = 0
            DEF DISPOSEH(newHndl&)
            EXIT FN
          END IF
        WEND
      XELSE
        err% = _memFullErr
        EXIT FN
      END IF
      SELECT last%
        CASE 0,1
        CASE 2
          POKE WORD([newHndl&]+newSize&-2),_"=="
        CASE 3
          POKE([newHndl&]+newSize&-1),_"="
      END SELECT
      DEF DISPOSEH(txtH&)
      & txtHPtr&,newHndl&
    END IF
  XELSE
    err% = _nilHandleErr
  END IF
END FN = err%

LOCAL FN SJIS2JIS(p%)
  ` nop
  ` movem.l   d1-d5,-(sp)
  ` clr.l     d0
  ` clr.w     d1
  ` move.w    ^p%,d0
  ` move.b    d0,d1
  ` lsr.w     #8,d0
  ` cmpi.b    #160,d0
  ` scs       d2
  ` moveq     #112,d3
  ` and.b     d2,d3
  ` not.b     d2
  ` andi.b    #176,d2
  ` or.b      d2,d3
  ` cmpi.b    #159,d1
  ` scs       d5
  ` cmpi.b    #127,d1
  ` shi       d2
  ` moveq     #31,d4
  ` sub.b     d2,d4
  ` and.b     d5,d4
  ` move.b    d5,d2
  ` not.b     d2
  ` andi.b    #126,d2
  ` or.b      d2,d4
  ` sub.b     d3,d0
  ` add.b     d0,d0
  ` add.b     d5,d0
  ` lsl.w     #8,d0
  ` add.w     d1,d0
  ` sub.w     d4,d0
  ` movem.l   (sp)+,d1-d5
  ` nop
END FN = REGISTER(D0)

LOCAL FN test
  DIM t$,i%,p%
  DIM isDouble%
  DIM r$
  DIM kin$,kout$
  kin$ = CHR$(&H1B)+CHR$(&H24)+CHR$(&H42)
  kout$ = CHR$(&H1B)+CHR$(&H28)+CHR$(&H42)

  t$ = "B$3$NJ8>O$rJISB$KJQ49$7$^$9!#"

  isDouble% = _false
  FOR i%=1 TO LEN(t$)
    p% = PEEK(@t$+i%)
    LONG IF isDouble%=_false
      LONG IF (p%>=&H81 AND p%<=&H9F) OR (p%>=&HE0 AND p%<=&HFC)
        isDouble%=_true
        r$ = r$+kin$
        p% = FN SJIS2JIS({@t$+i%})
        r$ = r$+CHR$(p% \ &H100)+CHR$(p% MOD &H100)
        INC(i%)
      XELSE
        r$ = r$+CHR$(p%)
      END IF
    XELSE
      LONG IF (p%>=&H81 AND p%<=&H9F) OR (p%>=&HE0 AND p%<=&HFC)
        p% = FN SJIS2JIS({@t$+i%})
        r$ = r$+CHR$(p% \ &H100)+CHR$(p% MOD &H100)
        INC(i%)
      XELSE
        isDouble%=_false
        r$ = r$+kout$
        r$ = r$+CHR$(p%)
      END IF
    END IF
  NEXT i%
  IF isDoube% THEN r$ = r$+kout$

  txtH& = FN NEWHANDLE(LEN(r$))
  LONG IF txtH&
    err% = FN HLOCK(txtH&)
    BLOCKMOVE @r$+1,[txtH&],LEN(r$)
    err% = FN HUNLOCK(txtH&)
    err% = 0                           
    'FN EncodeBase64(txtH&)
    LONG IF err%=_noErr
      size& = FN GETHANDLESIZE(txtH&)
      err% = FN HLOCK(txtH&)
      DEF OPEN "TEXTREDT"
      OPEN "O",#1,"TESTTEXT",SYSTEM(_aplVol)
      WRITE FILE #1,[txtH&],size&
      CLOSE #1
    XELSE
      BEEP
    END IF
    DEF DISPOSEH(txtH&)
  END IF
END FN

FN test
Osamu Shigematsu