MT Parse CGI : Source

Source

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

global theAEEvent:R,theReply:R, handerRefCon:LongInt
global myCounter:LongInt, myLen:LongInt, strOff:LongInt
global digPtr:pointer

codeResource "osax"

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

  put NewPtr(32) into myWorkPtr

  put myWorkPtr into myListPtr
  put myWorkPtr + 8 into myDescPtr
  put myWorkPtr + 16 into myStrDescPtr
  put myWorkPtr + 24 into mySubListPtr

  ------
  put 0 into myDscd
  put 0 into mySrcd

  put AEGetParamDesc(theAEEvent@,"encd","enum",myDescPtr@) into err
  if err <> 0 then
    put 83 into myDscd
  else
    put CharToNum(myDescPtr@.dataHandle@@.charType) into myDscd
    put AEDisposeDesc(myDescPtr@) into xerr
  end if

  if myDscd = 160 then put 77 into myDscd

  ----
  put AEGetParamDesc(theAEEvent@,"wtfn",typeBoolean,myDescPtr@) into err
  if err <> 0 then
    put false into wnamFlg
  else
    put myDescPtr@.dataHandle@@.booleanType into wnamFlg
    put AEDisposeDesc(myDescPtr@) into xerr
  end if
  ---
  put AEGetParamDesc(theAEEvent@,keyDirectObject,typeChar,myStrDescPtr@) into err
  if err <> 0 then
    DisposPtr myWorkPtr
    return err
  end if

  put myStrDescPtr@.dataHandle into myStrHandle
  put GetHandleSize(myStrHandle) into myLen
  if myLen < 2 then
    put AEDisposeDesc(myStrDescPtr@) into xerr
    DisposPtr myWorkPtr
    return -1708
  end if


  MoveHHi myStrHandle
  -----
  put NumToChar(61) into myListPtr@.charType
  put 0 into myBufLen
  put 0 into myCounter
  repeat
    put Munger(myStrHandle,myCounter,myListPtr,1,NIL,0) into myCounter
    if myCounter < 0 then exit repeat
    add 1 to myCounter
    add 1 to myBufLen
    if myCounter >= myLen then exit repeat
  end repeat

  if myBufLen = 0 then
    put AEDisposeDesc(myStrDescPtr@) into xerr
    DisposPtr myWorkPtr
    return -1708
  end if

  put myBufLen*2 +1 into myBufLen
  put NewPtr(myBufLen*4) into digPtr
  put MemError() into err
  if err <> 0 then
    put AEDisposeDesc(myStrDescPtr@) into xerr
    DisposPtr myWorkPtr
    return err
  end if

  put AEcreateList(nil,0,false,myListPtr@) into err
  if err <> 0 then
    put AEDisposeDesc(myStrDescPtr@) into xerr
    DisposPtr myWorkPtr
    DisposPtr digPtr
    return err
  end if

  ----
  put 1 into digIndex
  put 0 into myCounter
  put -1 into digPtr@.longIntType[1]
  put -1 into ClumPoss
  put -2 into FldPoss

  put 0 into err

  repeat

    if myCounter > (myLen-1) then exit repeat

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

    if tgX = 61 then
      --- "="

      if ClumPoss+1 = myCounter then
        put -1708 into err

      else if FldPoss > ClumPoss then
        put -1708 into err

      else
        add 1 to digIndex
        put myCounter into digPtr@.longIntType[digIndex]
        put myCounter into FldPoss
      end if

    else if tgX = 38 then
      --- "&"

      if FldPoss < ClumPoss then
        put -1708 into err
      else
        add 1 to digIndex
        put myCounter into digPtr@.longIntType[digIndex]
        put myCounter into ClumPoss
      end if

    else if tgX = 43 then
      --- "+"

      put NumToChar(32) into myStrHandle@@.charType[myCounter]

    else if tgX = 37 then
      --- "%"
      if myCounter < (myLen-2) then

        put CharToNum(myStrHandle@@.charType[myCounter+1]) into tgy
        put CharToNum(myStrHandle@@.charType[myCounter+2]) into tgz

        put HexToDexer(tgy) into digA
        put HexToDexer(tgz) into digB

        if tgy <> digA and tgz <> digB then

          put (digA*16)+digB into zzz
          put NumToChar(zzz) into myStrHandle@@.charType[myCounter]
          put myCounter+1 into strOff
          put Munger(myStrHandle,strOff,NIL,2,digPtr,0) into myResult
          put myLen-2 into myLen

        end if

      end if

    end if

    if err <> 0 then
      put AEDisposeDesc(myListPtr@) into xerr
      put AEDisposeDesc(myStrDescPtr@) into xerr
      DisposPtr myWorkPtr
      DisposPtr digPtr
      return err
    end if

    add 1 to myCounter

    next repeat

  end repeat

  if digIndex = 1 or ((digIndex mod 2) = 1) then
    put AEDisposeDesc(myListPtr@) into xerr
    put AEDisposeDesc(myStrDescPtr@) into xerr
    DisposPtr myWorkPtr
    DisposPtr digPtr
    return -1708
  end if

  add 1 to digIndex
  put GetHandleSize(myStrHandle) into digPtr@.longIntType[digIndex]

  ---

  put 0 into mySrType
  if (myDscd <> 78 and myDscd <> 77) then
    put CheckKcode(myStrHandle) into mySrType
    if mySrType = 1 then
      --- SJIS
      put 83 into mySrcd
    else if mySrType = 2 then
      --- EUC
      put 69 into mySrcd
    else --- 3
      --- JIS
      put 74 into mySrcd
    end if
  else
    put 78 into mySrcd
  end if
  ---

  put digIndex div 2 into dy

  HLock myStrHandle

  if wnamFlg then

    repeat with x = 1 to dy

      put AEcreateList(nil,0,false,myDescPtr@) into err
      if err <> 0 then
        exit repeat
      end if

      put digPtr@.LongIntType[x*2-1]+1 into stOneOff
      put digPtr@.LongIntType[x*2] into stTwoOff

      put stTwoOff-stOneOff into tgLen
      put myStrHandle@+stOneOff into tgPtr

      put AEPutPtr(myDescPtr@,0,typeChar,tgPtr,tgLen) into err
      if err <> 0 then
        put AEDisposeDesc(myDescPtr@) into xerr
        exit repeat
      end if

      put stTwoOff+1 into stTwoOff
      put digPtr@.LongIntType[x*2+1] into stThreeOff

      put stThreeOff - stTwoOff into tgLen
      put myStrHandle@+stTwoOff into tgPtr

      put AEPutPtr(myDescPtr@,0,typeChar,tgPtr,tgLen) into err
      if err <> 0 then
        put AEDisposeDesc(myDescPtr@) into xerr
        exit repeat
      end if

      put AEPutDesc(myListPtr@,0,myDescPtr@) into err
      put AEDisposeDesc(myDescPtr@) into xerr
      if err <> 0 then exit repeat

    end repeat

  else

    repeat with x = 1 to dy
      put digPtr@.LongIntType[x*2]+1 into stTwoOff
      put digPtr@.LongIntType[x*2+1] into stThreeOff
      put stThreeOff - stTwoOff into tgLen
      put myStrHandle@+stTwoOff into tgPtr
      put AEPutPtr(myListPtr@,0,typeChar,tgPtr,tgLen) into err
      if err <> 0 then
        exit repeat
      end if

    end repeat
  end if


  Hunlock myStrHandle
  put AEDisposeDesc(myStrDescPtr@) into xerr

  if err <> 0 then
    put AEDisposeDesc(myListPtr@) into xerr
    DisposPtr myWorkPtr
    DisposPtr digPtr
    return err
  end if

  if (myDscd <> 78) and (mySrcd <> myDscd) then

    if myDscd = 74 then
      put NumToChar(27) into digPtr@.chartype[0]
      put NumToChar(36) into digPtr@.chartype[1]
      put NumtoChar(66) into digPtr@.charType[2]

      put NumToChar(27) into digPtr@.chartype[3]
      put NumToChar(40) into digPtr@.chartype[4]
      put NumToChar(66) into digPtr@.charType[5]
    end if


    if wnamFlg then

      repeat with x = 1 to dy

        put AEGetNthDesc(myListPtr@,x,"list",myKey,myDescPtr@) into err
        if err <> 0 then exit repeat

        put AEGetNthDesc(myDescPtr@,2,"TEXT",myKey,mySubListPtr@) into err
        if err <> 0 then
          put AEDisposeDesc(myDescPtr@) into xerr
          exit repeat
        end if

        put mySubListPtr@.dataHandle into myTgHandle

        put convertEncode(myTgHandle,mySrcd,myDscd) into err
        if err <> 0 then
          put AEDisposeDesc(mySubListPtr@) into xerr
          put AEDisposeDesc(myDescPtr@) into xerr
          exit repeat
        end if

        put AEPutDesc(myDescPtr@,2,mySubListPtr@) into err
        put AEDisposeDesc(mySubListPtr@) into xerr
        if err <> 0 then
          put AEDisposeDesc(myDescPtr@) into xerr
          exit repeat
        end if

        put AEPutDesc(myListPtr@,x,myDescPtr@) into err
        put AEDisposeDesc(myDescPtr@) into xerr

        if err <> 0 then exit repeat

      end repeat

    else

      repeat with x = 1 to dy

        put AEGetNthDesc(myListPtr@,x,"TEXT",myKey,myDescPtr@) into err
        if err <> 0 then exit repeat

        put myDescPtr@.dataHandle into myTgHandle
        put convertEncode(myTgHandle,mySrcd,myDscd) into err

        if err <> 0 then
          put AEDisposeDesc(myDescPtr@) into xerr
          exit repeat
        end if

        put AEPutDesc(myListPtr@,x,myDescPtr@) into err
        put AEDisposeDesc(myDescPtr@) into xerr
        if err <> 0 then exit repeat

      end repeat

    end if

    if err <> 0 then
      put AEDisposeDesc(myListPtr@) into xerr
      DisposPtr myWorkPtr
      DisposPtr digPtr
      return err
    end if

  end if

  if theReply@.descriptorType <> typeNull then
    put AEPutParamDesc(theReply@, keyDirectObject,myListPtr@) into err
  end if

  put AEDisposeDesc(myListPtr@) into xerr
  DisposPtr myWorkPtr
  DisposPtr digPtr

  return err

end DecodeArgs


function HexToDexer tgNm
  if 48 <= tgNm and tgNm <= 57 then
    return (tgNm-48)
  else if 65 <= tgNm and tgNm <= 70 then
    return (tgNm-55)
  else if 97 <= tgNm and tgNm <= 102 then
    return (tgNm-87)
  end if
  return tgNm
end HexToDexer


function convertEncode tgHandle,mySrcd,myDscd

  put GetHandleSize(tgHandle) into tgHandleLen
  if tgHandleLen = 0 then return 0

  put myDscd+0 into myDscd
  put mySrcd+0 into mySrcd

  if 77 = myDscd then
    return L12Mac(tgHandle)
  else
    --- Kanji Convert
    if mySrcd = 83 then
      if myDscd = 69 then
        return SJIS2EUC(tgHandle)
      else if myDscd = 74 then
        return SJIS2JIS(tgHandle)
      end if
    else if mySrcd = 69 then
      if myDscd = 83 then
        return EUC2SJIS(tgHandle)
      else if myDscd = 74 then
        return EUC2JIS(tgHandle)
      end if
    else if mySrcd = 74 then
      if myDscd = 83 then
        return JIS2SJIS(tgHandle)
      else if myDscd = 69 then
        return JIS2EUC(tgHandle)
      end if
    end if
  end if

  return 0

end convertEncode


function CheckKcode tgHandle

  put GetHandleSize(tgHandle) -2 into myCKLen

  put 0 into myCHCounter
  put 1 into myCharTp
  put 0 into hanKanaCounter

  repeat
    if myCHCounter > myCKLen  then exit repeat

    put CharToNum(tgHandle@@.charType[myCHCounter]) into tgx
    put CharToNum(tgHandle@@.charType[myCHCounter+1]) into tgy

    if tgx = 27 and (myCHCounter +1) < myCKLen then
      put CharToNum(tgHandle@@.charType[myCHCounter+2]) into tgz

      if tgy = 36 and (tgz = 66 or tgz = 64) then
        return 3
      end if

    else if (129 <= tgx and tgx <= 141) ¬
    or ( 143 <= tgx and tgx <=159) then

      return 1

    else if tgx = 142 then
      if (64 <= tgy and tgy <= 126) ¬
      or (128 <= tgy and tgy <= 160) ¬
      or (224 <= tgy and tgy <= 252) then
        return 1
      end if

    else if 161 <= tgx and tgx <= 171 then

      return 2

    else if 172 <= tgx and tgx <= 223 then

      add 1 to hanKanaCounter

    else if 240 <= tgx and tgx <= 254 then
      return 2

    else if 224 <= tgx and tgx <= 239 then
      if (64 <= tgy and tgy <= 126) ¬
      or (128 <= tgy and tgy <= 160) then
        return 1

      else if 253 <= tgy and tgy <= 254 then
        return 2

      end if

    end if

    add 1 to myCHCounter

  end repeat

  if hanKanaCounter >= (myCKLen div 3) then
    return 2
  else
    return 1
  end if

end CheckKcode



function EUC2SJIS tgHandle

  put GetHandleSize(tgHandle) into tgHandleLen
  put 0 into myCounter
  put tgHandleLen-2 into myEUCLen

  repeat

    if myCounter > myEUCLen then
      exit repeat
    end if

    put CharToNum(tgHandle@@.charType[myCounter]) into tgX
    put CharToNum(tgHandle@@.charType[myCounter+1]) into tgy

    if isEuc(tgx) and isEuc(tgy) then

      put tgx - 128 into chr1
      put tgy - 128 into chr2

      if chr1 < 95 then
        put 112 into rwOf
      else
        put 176 into rwOf
      end if

      put ((chr1 mod 2) = 1) into myFlg

      if myFlg then
        if chr2 > 95 then
          put 32 into celOf
        else
          put 31 into celOf
        end if
      else
        put 126 into celOf
      end if

      put ((chr1 + 1) div 2) + rwOf into tgx
      put chr2 + celOf into tgy


      put NumToChar(tgx) into tgHandle@@.chartype[myCounter]
      put NumToChar(tgy) into tgHandle@@.chartype[myCounter+1]

      add 2 to myCounter
      next repeat
    else
      add 1 to myCounter
      next repeat
    end if

  end repeat

  return 0

end EUC2SJIS


function isEuc tgx
  return ((161 <= tgx ) and (tgx <= 254))
end isEuc


function JIS2SJIS tgHandle

  put GetHandleSize(tgHandle) into tgHandleLen

  put false into kmode
  put 0 into myCounter

  repeat

    if myCounter > (tgHandleLen-2) then
      exit repeat
    end if

    put CharToNum(tgHandle@@.charType[myCounter]) into tgX

    if tgx = 13 then
      if kmode then
        put false into kmode
      end if
      add 1 to myCounter
      next repeat

    else

      put CharToNum(tgHandle@@.charType[myCounter+1]) into tgy
      put CharToNum(tgHandle@@.charType[myCounter+2]) into tgz

      if tgx = 27 then

        if tgy = 36 and (tgz = 66 or tgz = 64) then
          --- In

          put Munger(tgHandle,myCounter,NIL,3,digPtr,0) into Merr
          put tgHandleLen-3 into tgHandleLen
          if not kmode then
            put true into kmode
          end if


          next repeat

        else if (tgy = 40 and tgz = 66)¬
        or (tgy = 40 and tgz = 74) then

          --- out
          put Munger(tgHandle,myCounter,NIL,3,digPtr,0) into Merr
          put tgHandleLen-3 into tgHandleLen

          if kmode then
            put false into kmode
          end if


          next repeat

        end if

      end if

      if kmode then

        if tgX < 95 then
          put 112 into rwOf
        else
          put 176 into rwOf
        end if

        put ((tgX mod 2) = 1) into myFlg

        if myFlg then
          if tgy > 95 then
            put 32 into celOf
          else
            put 31 into celOf
          end if
        else
          put 126 into celOf
        end if

        put ((tgx + 1) div 2) + rwOf into tgx
        put tgy + celOf into tgy


        put NumToChar(tgx) into tgHandle@@.chartype[myCounter]
        put NumToChar(tgy) into tgHandle@@.chartype[myCounter+1]

        add 2 to myCounter
        next repeat

      else

        add 1 to myCounter
        next repeat

      end if

    end if
  end repeat

  return 0

end JIS2SJIS


function EUC2JIS tgHandle

  put GetHandleSize(tgHandle) into tgHandleLen

  put 0 into myCounter
  put tgHandleLen-2 into myLen
  put false into kmode

  put digPtr into escInPtr
  put digPtr+3 into escOutPtr

  repeat

    if myCounter > myLen then
      if kmode then
        put false into kmode
        put Munger(tgHandle,myCounter,escOutPtr,0,escOutPtr,3) into myCounter
      end if
      exit repeat

    end if

    put CharToNum(tgHandle@@.charType[myCounter]) into tgX

    if tgX = 13 then
      if kmode then
        put false into kmode
        put Munger(tgHandle,myCounter,escOutPtr,0,escOutPtr,3) into myCounter
        add 3 to myLen
      end if

      add 1 to myCounter
      next repeat

    else

      if tgX > 128 then
        put CharToNum(tgHandle@@.charType[myCounter+1]) into tgy

        if tgy > 128 then

          if not kmode then
            put Munger(tgHandle,myCounter,escInPtr,0,escInPtr,3) into myCounter
            add 3 to myLen
            put true into kmode
          end if

          put NumToChar(tgx-128) into tgHandle@@.chartype[myCounter]
          put NumToChar(tgy-128) into tgHandle@@.chartype[myCounter+1]

        end if

        add 2 to myCounter
        next repeat

      else
        if kmode then
          put false into kmode
          put Munger(tgHandle,myCounter,escOutPtr,0,escOutPtr,3) into myCounter
          add 3 to myLen
        end if

        add 1 to myCounter
        next repeat
      end if

    end if
  end repeat


  return 0

end EUC2JIS


function JIS2EUC tgHandle

  put GetHandleSize(tgHandle) into tgHandleLen
  put tgHandleLen-2 into myLen
  put false into kmode
  put 0 into myCounter

  repeat

    if myCounter > myLen then
      exit repeat
    end if

    put CharToNum(tgHandle@@.charType[myCounter]) into tgX

    if tgX = 13 then
      if kmode then
        put false into kmode
      end if
      add 1 to myCounter
      next repeat

    else

      put CharToNum(tgHandle@@.charType[myCounter+1]) into tgy
      put CharToNum(tgHandle@@.charType[myCounter+2]) into tgz

      if tgx = 27 then

        if tgy = 36 and (tgz = 66 or tgz = 64) then
          --- In
          put Munger(tgHandle,myCounter,nil,3,digPtr,0) into myCounter

          put myLen-3 into myLen

          if not kmode then
            put true into kmode
          end if
          next repeat

        else if (tgy = 40 and tgz = 66)¬
        or (tgy = 40 and tgz = 74) then

          --- out
          put Munger(tgHandle,myCounter,nil,3,digPtr,0) into myCounter
          put myLen-3 into myLen

          if kmode then
            put false into kmode
          end if
          next repeat

        end if

      end if

      if kmode then
        put NumToChar(tgx+128) into tgHandle@@.chartype[myCounter]
        put NumToChar(tgy+128) into tgHandle@@.chartype[myCounter+1]

        add 2 to myCounter
        next repeat

      else
        add 1 to myCounter
        next repeat
      end if

    end if
  end repeat


  return 0

end JIS2EUC


function SJIS2EUC tgHandle

  put GetHandleSize(tgHandle) into tgHandleLen

  put tgHandleLen-2 into myLen
  put 0 into myCounter

  repeat

    if myCounter > myLen then
      exit repeat
    end if

    put CharToNum(tgHandle@@.charType[myCounter]) into tgX
    put CharToNum(tgHandle@@.charType[myCounter+1]) into tgy

    if IsSjis1(tgX) and IsSjis2(tgy) then

      if tgY < 159 then
        put 1 into ad
      else
        put 0 into ad
      end if

      if tgX < 160 then
        put 112 into row
      else
        put 176 into row
      end if

      if ad = 1 then
        if tgY > 127 then
          put 32 into cell
        else
          put 31 into cell
        end if
      else
        put 126 into cell
      end if

      put NumToChar((tgX - row) * 2 - ad + 128) into tgHandle@@.chartype[myCounter]
      put NumToChar(tgY - cell + 128) into tgHandle@@.chartype[myCounter+1]

      add 2 to myCounter
      next repeat

    else

      add 1 to myCounter
      next repeat
    end if
  end repeat

  return 0

end SJIS2EUC


function IsSjis1 chrNum
  return ( (129 <= chrNum and chrNum <= 159) ¬
  or (224 <= chrNum and chrNum <= 239))
end IsSjis1

function IsSjis2 chrNum
  return ( 64 <= chrNum and chrNum <= 252)
end IsSjis2


function SJIS2JIS tgHandle

  put GetHandleSize(tgHandle) into tgHandleLen

  put digPtr into escInPtr
  put digPtr+3 into escOutPtr

  put false into kmode

  put 0 into myCounter
  put tgHandleLen-2 into myLen

  repeat

    if myCounter > myLen then
      if kmode then
        put false into kmode
        put Munger(tgHandle,myCounter,escOutPtr,0,escOutPtr,3) into myCounter
      end if
      exit repeat
    end if

    put CharToNum(tgHandle@@.charType[myCounter]) into tgX

    if tgX = 13 then

      if kmode then
        put false into kmode
        put Munger(tgHandle,myCounter,escOutPtr,0,escOutPtr,3) into myCounter
        add 3 to myLen
      end if
      add 1 to myCounter
      next repeat

    else

      if IsSjis1(tgX) then
        put CharToNum(tgHandle@@.charType[myCounter+1]) into tgy

        if IsSjis2(tgy) then

          if not kmode then
            put Munger(tgHandle,myCounter,escInPtr,0,escInPtr,3) into myCounter
            add 3 to myLen
            put true into kmode
          end if

          if tgY < 159 then
            put 1 into ad
          else
            put 0 into ad
          end if

          if tgX < 160 then
            put 112 into row
          else
            put 176 into row
          end if

          if ad = 1 then
            if tgY > 127 then
              put 32 into cell
            else
              put 31 into cell
            end if
          else
            put 126 into cell
          end if

          put NumToChar((tgX - row) * 2 - ad) into tgHandle@@.chartype[myCounter]
          put NumToChar(tgY - cell) into tgHandle@@.chartype[myCounter+1]

        end if

        add 2 to myCounter
        next repeat

      else

        if kmode then
          put false into kmode
          put Munger(tgHandle,myCounter,escOutPtr,0,escOutPtr,3) into myCounter
          add 3 to myLen
        end if

        add 1 to myCounter
        next repeat
      end if

    end if
  end repeat

  return 0

end SJIS2JIS


function L12Mac tgHandle

  put GetResource("tble",1001) into myRsrcHandle

  if myRsrcHandle = nil then
    put ResError() into err
    return err
  end if

  put GetHandleSize(tgHandle) into tgHandleLen
  put tgHandleLen-1 into myLen

  repeat with x = 0 to myLen
    put charToNum(tgHandle@@.charType[x]) into dx
    put myRsrcHandle@@.charType[dx] into tgHandle@@.charType[x]
  end repeat

  ReleaseResource myRsrcHandle

  return 0

end L12Mac