MT Encode URL : Source

Source

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

global theAEEvent:R,theReply:R, handerRefCon:LongInt
global myCounter:LongInt, myLen:LongInt

codeResource "osax"

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

  put NewPtrClear(8) into myDescPtr

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

  put myDescPtr@.dataHandle into myStrHandle
  put GetHandleSize(myStrHandle) into myLen
  ---
  if myLen = 0 then
    if theReply@.descriptorType <> typeNull then
      put AEPutParamDesc(theReply@, keyDirectObject,myDescPtr@) into err
    end if

    put AEDisposeDesc(myDescPtr@) into xerr
    DisposPtr myDescPtr
    return 0
  end if
  ---

  put 0 into myCounter
  put myLen-1 into endOff

  put NewPtr(myLen*3) into myURLPtr

  if myURLPtr = NIL then
    put AEDisposeDesc(myDescPtr@) into xerr
    DisposPtr myDescPtr
    return -108
  end if

  ---

  repeat with x = 0 to endOff

    put CharToNum(myStrHandle@@.charType[x]) into tgX

    if NeedURL(tgx) then

      put NumToChar(37) into myURLPtr@.charType[myCounter]

      put (tgx div 16) into lowNum
      if lowNum < 10 then
        put lowNum+48 into lowNum
      else
        put lowNum+55 into lowNum
      end if

      put NumToChar(lowNum) into myURLPtr@.charType[myCounter+1]

      put (tgx mod 16) into HiNum
      if HiNum < 10 then
        put HiNum+48 into HiNum
      else
        put HiNum+55 into HiNum
      end if

      put NumToChar(HiNum) into myURLPtr@.charType[myCounter+2]
      add 3 to myCounter

    else
      put NumToChar(tgx) into myURLPtr@.charType[myCounter]
      add 1 to myCounter
    end if
  end repeat

  ----
  if theReply@.descriptorType <> typeNull then
    put AEPutParamPtr(theReply@, keyDirectObject, typeChar,myURLPtr,myCounter) into err
  end if

  put AEDisposeDesc(myDescPtr@) into xerr
  DisPosPtr myDescPtr
  DisposPtr myURLPtr

  return 0

end EncodeURL

function NeedURL tgX
  if tgX < 42 or 122 < tgX then
    return true
  else
    return (tgX = 43 ¬
    or tgX = 44 ¬
    or tgX = 47 ¬
    or (58 <= tgX and tgX <= 64) ¬
    or (91 <= tgX and tgX <= 94) ¬
    or tgx = 96 )
  end if
end NeedURL