[futurebasic] Re: [FB] base 64

Message: < previous - next > : Reply : Subscribe : Cleanse
Home   : May 1999 : Group Archive : Group : All Groups

From: "Osamu Shigematsu" <shige@...>
Date: Fri, 21 May 1999 11:05:59 +0900
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$ = "この文章をJISに変換します。"

  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