MT Decode 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
global myCounter:LongInt
global myFcre:OSType, myFtype:OStype

codeResource "osax"

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

  put NewPtrClear(80) into myWorkPtr

  put myWorkPtr into myDescPtr
  put myWorkPtr + 8 into myFssPtr
  put myWorkPtr + 78 into tempPtr

  put AEGetParamPtr(theAEEvent@,"tgfl",typeFSS,typeCode,myFssPtr,70,myactSize) into err

  if err <> 0 then
    put false into flFlg
  else
    put true into flFlg
  end if

  if flFlg then

    put AEGetParamDesc(theAEEvent@,"fcrt",typeType,myDescPtr@) into err
    if myDescPtr@.descriptorType = typeNull then
      put "ttxt" into myFcre
    else
      put myDescPtr@.dataHandle@@.OStype into myFcre
    end if
    put AEDisposeDesc(myDescPtr@) into err


    put AEGetParamDesc(theAEEvent@,"asty",typeType,myDescPtr@) into err
    if myDescPtr@.descriptorType = typeNull then
      put "TEXT" into myFtype
    else
      put myDescPtr@.dataHandle@@.OStype into myFtype
    end if
    put AEDisposeDesc(myDescPtr@) into err

  end if

  put AEGetParamDesc(theAEEvent@,keyDirectObject,typeChar,myDescPtr@) into err
  if err <> 0 then
    DisposPtr myWorkPtr
    return err
  end if


  put myDescPtr@.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(myDescPtr@) into err
    DisposPtr myWorkPtr
    return 0
  end if


  ----
  put 0 into myResult
  put NumToChar(10) into tempPtr@.charType
  repeat
    put Munger(myStrHandle,myResult,tempPtr,1,tempPtr,0) into myResult
    if myResult < 0 then exit repeat
  end repeat

  put 0 into myResult
  put NumToChar(13) into tempPtr@.charType
  repeat
    put Munger(myStrHandle,myResult,tempPtr,1,tempPtr,0) into myResult
    if myResult < 0 then exit repeat
  end repeat

  put 0 into myResult
  put NumToChar(32) into tempPtr@.charType
  repeat
    put Munger(myStrHandle,myResult,tempPtr,1,tempPtr,0) into myResult
    if myResult < 0 then exit repeat
  end repeat

  put 0 into myResult
  put NumToChar(9) into tempPtr@.charType
  repeat
    put Munger(myStrHandle,myResult,tempPtr,1,tempPtr,0) into myResult
    if myResult < 0 then exit repeat
  end repeat

  ----

  put GetHandleSize(myStrHandle) into myactSize
  if (myactSize mod 4) <> 0 then
    put AEDisposeDesc(myDescPtr@) into err
    DisposPtr myWorkPtr
    return -50
  end if


  put (myactSize*6)/8 into tgSize
  put myactSize-1 into myUnits

  -- put myStrHandle@ into aPtr

  repeat with x = 0 to myUnits

    put charToNum(myStrHandle@@.charType[x]) into tgx

    if tgx = 61 then
      repeat with z = 0 to 5
        BitClr myStrHandle@,(z+(x*6))
      end repeat
      exit repeat
    end if

    put decTable(tgx) into tgy

    if tgy = 255 then
      put AEDisposeDesc(myDescPtr@) into err
      DisposPtr myWorkPtr
      return -50
    else
      put NumToChar(tgy) into tempPtr@.charType
    end if

    repeat with z = 0 to 5
      if Bittst(tempPtr,z+2) then
        BitSet myStrHandle@,(z+(x*6))
      else
        BitClr myStrHandle@,(z+(x*6))
      end if
    end repeat

  end repeat

  put CharToNum(myStrHandle@@.charType[myUnits]) into tgx
  put CharToNum(myStrHandle@@.charType[myUnits-1]) into tgy

  if tgx = 61 then
    if tgy = 61 then
      put tgSize-2 into tgSize
    else
      put tgSize-1 into tgSize
    end if
  end if

  if not flFlg then
    hLock myStrHandle
    if theReply@.descriptorType <> typeNull then
      put AEPutParamPtr(theReply@, keyDirectObject, typeChar,myStrHandle@,tgSize) into err
    end if
    HUnlock myStrHandle
    put AEDisposeDesc(myDescPtr@) into err
    DisposPtr myWorkPtr

    return 0

  end if

  ---

  put FSpOpenDF(myFssPtr@,fsRdWrPerm,myRefnum) into err

  if err<>0 and err<>-43 then
    put AEDisposeDesc(myDescPtr@) into xerr
    DisposPtr myWorkPtr
    return err
  end if

  if err = -43 then

    put FSpCreate(myFssPtr@, myFcre, myFtype, 0) into err
    if err = 0 then
      put FSpOpenDF(myFssPtr@,fsRdWrPerm,myRefnum) into err
    end if
  end if

  if err = 0 then

    put SetFPos(myrefNum,1,0) into ferr
    hLock myStrHandle
    put FSWrite(myrefNum,tgSize,myStrHandle@) into err
    HUnlock myStrHandle
    put SetEOF(myrefNum,tgSize) into ferr
    put FSClose(myrefNum) into ferr
    put FlushVol(nil,(myFssPtr@.IntegerType)) into ferr
  end if


  put AEDisposeDesc(myDescPtr@) into xerr
  DisposPtr myWorkPtr


  return err


end DecodeBase64

function decTable tgX

  if tgx = 47 then
    return 63
  else if tgx = 43 then
    return 62
  else if (48 <= tgx and tgx <= 57) then
    return tgx+4
  else if (65 <= tgx and tgx <= 90) then
    return tgx-65
  else if (97 <= tgx and tgx <= 122) then
    return tgx-71
  else
    return 255
  end if

end decTable