MT Encode Base64 : Source

Source

--- This source is written in HyperTalk for CompileIt!

global myType:OStype, mySize:longInt, myactSize:longInt
global theAEEvent:R,theReply:R, handerRefCon:LongInt

codeResource "osax"

pascal function EncodeBase64:I theAEEvent:R, theReply:R, handerRefCon:L

  put NewPtrClear(85) into myWorkPtr

  put myWorkPtr into theParamDesc
  put myWorkPtr + 8 into tempPtr
  put myWorkPtr + 12 into myLinePtr


  put AEGetParamDesc(theAEEvent@,keyDirectObject,"****",theParamDesc@) into err
  if err <> 0 then
    DisposPtr myWorkPtr
    return err
  end if

  if theParamDesc@.descriptorType = typeNull then
    put AEDisposeDesc(theParamDesc@) into err
    DisposPtr myWorkPtr
    return -1708
  end if

  put theParamDesc@.dataHandle into myStrHandle
  put GetHandleSize(myStrHandle) into myactSize

  if myactSize = 0 then
    if theReply@.descriptorType <> typeNull then
      put AEPutParamPtr(theReply@, keyDirectObject, typeChar,tempPtr,0) into err
    end if
    put AEDisposeDesc(theParamDesc@) into err
    DisposPtr myWorkPtr
    return 0
  end if

  MoveHHi myStrHandle
  ----

  put "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=" into myRes
  put CharsHandle(myRes) into myResHandle
  MoveHHi myResHandle

  ----

  put NumToChar(13) into myLinePtr@.charType[72]

  put NewHandle(0) into rtnHandle
  put MemError() into xerr
  if xerr <> 0 then
    put AEDisposeDesc(theParamDesc@) into err
    DisposPtr myWorkPtr
    return xerr
  end if


  put 0 into myStrOff
  ----

  put (myactSize div 54) into lnNum
  put (myactSize mod 54) into mdNum

  -- Hlock myStrHandle

  repeat with x=1 to lnNum

    put (x-1)*54 into basePos
    put myStrHandle@ + basePos into aPtr

    repeat with y = 0 to 71
      repeat with z = 0 to 5
        if BitTst(aPtr,(y*6+z)) then
          BitSet tempPtr,(z+2)
        else
          BitClr tempPtr,(z+2)
        end if
      end repeat

      put CharToNum(tempPtr@.charType) into myStrOff
      put myResHandle@@.charType[myStrOff] into myLinePtr@.charType[y]

    end repeat
    put PtrAndHand(myLinePtr,rtnHandle,73) into xErr
    if xErr <> 0 then
      DisposHandle rtnHandle
      put AEDisposeDesc(theParamDesc@) into err
      DisposPtr myWorkPtr
      return xErr
    end if

  end repeat

  put (mdNum div 3) into tgSet
  put (mdNum mod 3) into tgMd

  put lnNum*54 into basePos
  put myStrHandle@ + basePos into aPtr

  repeat with y = 0 to tgSet
    repeat with zx = 0 to 3
      repeat with z = 0 to 5
        if BitTst(aPtr,(y*24+zx*6+z)) then
          BitSet tempPtr,(z+2)
        else
          BitClr tempPtr,(z+2)
        end if
      end repeat

      put CharToNum(tempPtr@.charType) into myStrOff
      put myResHandle@@.charType[myStrOff] into myLinePtr@.charType[y*4+zx]

    end repeat
  end repeat

  if tgMd <> 0 then
    put myStrHandle@ + (lnNum*54) + (tgSet*3) into aPtr
    put tgSet*4 into tzOff

    if tgMd = 1 then
      repeat with z=0 to 5
        if BitTst(aPtr,z) then
          BitSet tempPtr,(z+2)
        else
          BitClr tempPtr,(z+2)
        end if
      end repeat

      repeat with z=0 to 1
        if BitTst(aPtr,z+6) then
          BitSet tempPtr,(z+10)
        else
          BitClr tempPtr,(z+10)
        end if
      end repeat

      put CharToNum(tempPtr@.charType) into myStrOff
      put myResHandle@@.charType[myStrOff] into myLinePtr@.charType[tzOff]

      put CharToNum(tempPtr@.charType[1]) into myStrOff
      put myResHandle@@.charType[myStrOff] into myLinePtr@.charType[tzOff+1]

      put NumToChar(61) into myLinePtr@.charType[tzOff+2]
      put NumToChar(61) into myLinePtr@.charType[tzOff+3]

    else if tgMd = 2 then
      repeat with z=0 to 5
        if BitTst(aPtr,z) then
          BitSet tempPtr,(z+2)
        else
          BitClr tempPtr,(z+2)
        end if
      end repeat

      repeat with z=0 to 5
        if BitTst(aPtr,z+6) then
          BitSet tempPtr,(z+10)
        else
          BitClr tempPtr,(z+10)
        end if
      end repeat

      repeat with z=0 to 3
        if BitTst(aPtr,z+12) then
          BitSet tempPtr,(z+18)
        else
          BitClr tempPtr,(z+18)
        end if
      end repeat


      put CharToNum(tempPtr@.charType) into myStrOff
      put myResHandle@@.charType[myStrOff] into myLinePtr@.charType[tzOff]

      put CharToNum(tempPtr@.charType[1]) into myStrOff
      put myResHandle@@.charType[myStrOff] into myLinePtr@.charType[tzOff+1]

      put CharToNum(tempPtr@.charType[2]) into myStrOff
      put myResHandle@@.charType[myStrOff] into myLinePtr@.charType[tzOff+2]

      put NumToChar(61) into myLinePtr@.charType[tzOff+3]
    end if

    put PtrAndHand(myLinePtr,rtnHandle,(tgSet*4+4)) into xErr
    if xErr <> 0 then
      DisposHandle rtnHandle
      put AEDisposeDesc(theParamDesc@) into err
      DisposPtr myWorkPtr
      return xErr
    end if

  else

    put PtrAndHand(myLinePtr,rtnHandle,(tgSet*4)) into xErr
    if xErr <> 0 then
      DisposHandle rtnHandle
      put AEDisposeDesc(theParamDesc@) into err
      DisposPtr myWorkPtr
      return xErr
    end if
  end if

  -- Hunlock myStrHandle

  put GetHandleSize(rtnHandle) into mySize

  if theReply@.descriptorType <> typeNull then
    HLock rtnHandle
    put AEPutParamPtr(theReply@, keyDirectObject, "TEXT",rtnHandle@,mySize) into err
    HUnlock rtnHandle
  end if

  DisposHandle rtnHandle
  put AEDisposeDesc(theParamDesc@) into xerr
  DisposPtr myWorkPtr

  return err

end EncodeBase64