MT Hex Dump : Source

Source

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

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

codeResource "osax"

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

  put AESizeOfParam(theAEEvent@,keyDirectObject,myType,mySize) into err

  if err <> 0 or myType = typeNull or mySize=0 then

    --================== Dump File data ====================--

    put AESizeOfParam(theAEEvent@,"scfl",myType,mySize) into err
    if err <> 0 then
      return err
    end if

    put NewPtrClear(338) into myWorkPtr

    put myWorkPtr into myFssPtr
    put myWorkPtr + 70 into myNmPtr
    put myWorkPtr + 326 into myOffPtr
    put myWorkPtr + 330 into myListPtr

    if myType = "TEXT" then

      if mySize > 255 then
        DisposPtr myWorkPtr
        return -1708
      end if

      put myNmPtr+1 into aPtr
      put AEGetParamPtr(theAEEvent@,"scfl","TEXT",typeCode,aPtr,mySize,myactSize) into err
      if err <> 0 then
        DisposPtr myWorkPtr
        return err
      end if

      put NumToChar(mySize) into myNmPtr@.charType
      put myNmPtr@.Str255Type into myFname
      put FSMakeFSSpec(0, 0, myFname, myFssPtr@) into err
      if err <> 0 then
        DisPosPtr myWorkPtr
        return err
      end if

    else

      put AEGetParamPtr(theAEEvent@,"scfl",typeFSS,typeCode,myFssPtr,70,myactSize) into err
      if err <> 0 then
        DisPosPtr myWorkPtr
        return err
      end if

    end if

    ----
    put FSpOpenDF(myFssPtr@,fsRdWrPerm,myRefnum) into err
    if err <> 0 then
      DisPosPtr myWorkPtr
      return err
    end if

    put GetEOF(myRefNum,eofPoss) into err

    ----

    put AEGetParamPtr(theAEEvent@,"rdfm","long",typeCode,myOffPtr,4,myactSize) into err
    if err = 0 then
      put myOffPtr@.longIntType into stOff

      if abs(stOff) > eofPoss then
        put FSClose(myRefNum) into err
        DisposPtr myWorkPtr
        return -1708
      end if

      if stOff > 0 then
        put stOff-1 into stOff
      else if stOff < 0 then
        put stOff+eofPoss into stOff
      end if

    else
      put 0 into stOff
    end if

    ----

    put AEGetParamPtr(theAEEvent@,"rdto","long",typeCode,myOffPtr,4,myactSize) into err
    if err = 0 then
      put myOffPtr@.longIntType into edOff

      if abs(edOff) > eofPoss then
        put FSClose(myRefNum) into err
        DisposPtr myWorkPtr
        return -1708
      end if

      if edOff = 0 then
        put eofPoss into edOff
      else if edOff < 0 then
        put edOff+eofPoss+1 into edOff
      end if

    else
      put eofPoss into edOff
    end if

    put edOff-stOff into myBufSize

    if myBufSize <= 0 then
      put FSClose(myRefNum) into err
      DisPosPtr myWorkPtr
      return -1708
    end if

    ----

    put MaxMem(dum) into myMemSize

    if myBufSize > (myMemSize-32768) then
      put FSClose(myRefNum) into err
      DisPosPtr myWorkPtr
      return -108
    end if

    put NewPtr(myBufSize) into myTemPtr
    put MemError() into err
    if err <> 0 then
      put FSClose(myRefNum) into xerr
      DisPosPtr myWorkPtr
      return err
    end if

    put SetFPos(myRefNum,1,stOff) into xerr
    put FSRead(myRefNum,myBufSize,myTemPtr) into err
    put FSClose(myRefNum) into xerr
    if err <> 0 then
      DisposPtr myTemPtr
      DisposPtr myWorkPtr
      return err
    end if

    ---

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

    put myBufSize-1 into scanLen

    repeat with x = 0 to scanLen

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

      put (tgX mod 16) into tgZ1
      if 0 <= tgZ1 and tgZ1 <= 9 then
        put NumToChar(tgZ1+48) into myOffPtr@.charType[1]
      else
        put NumToChar(tgZ1+55) into myOffPtr@.charType[1]
      end if

      put tgX div 16 into tgZ1
      if 0 <= tgZ1 and tgZ1 <= 9 then
        put NumToChar(tgZ1+48) into myOffPtr@.charType[0]
      else
        put NumToChar(tgZ1+55) into myOffPtr@.charType[0]
      end if

      put AEPutPtr(myListPtr@,0,"TEXT",myOffPtr,2) into err
      if err <> 0 then
        put AEDisposeDesc(myListPtr@) into xerr
        DisposPtr myTemPtr
        DisposPtr myWorkPtr
        return err
      end if

    end repeat

    ----
    if theReply@.descriptorType <> typeNull then
      put AEPutParamDesc(theReply@, keyDirectObject,myListPtr@) into err
    end if
    ---
    put AEDisposeDesc(myListPtr@) into xerr
    DisposPtr myTemPtr
    DisposPtr myWorkPtr

    return err

  else --====== Dump Direct parameter ====--

    put NewPtrClear(18) into myWorkPtr

    put myWorkPtr into myDescPtr
    put myWorkPtr + 8 into myListPtr
    put myWorkPtr + 16 into tempPtr


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

    put myDescPtr@.dataHandle into tgHandle
    put GetHandleSize(tgHandle) into tgSize

    ---
    put AEGetParamDesc(theAEEvent@,"rdfm","long",myListPtr@) into err
    if err = 0 then
      put myListPtr@.dataHandle@@.longIntType into stOff
      put AEDisposeDesc(myListPtr@) into xerr

      if abs(stOff) > tgSize then
        put AEDisposeDesc(myDescPtr@) into xerr
        DisposPtr myWorkPtr
        return -1708
      end if

      if stOff > 0 then
        put stOff-1 into stOff
      else if stOff < 0 then
        put stOff+tgSize into stOff
      end if

    else
      put 0 into stOff
    end if

    ----
    put AEGetParamDesc(theAEEvent@,"rdto","long",myListPtr@) into err
    if err = 0 then

      put myListPtr@.dataHandle@@.longIntType into edOff

      put AEDisposeDesc(myListPtr@) into xerr

      if abs(edOff) > tgSize then
        put AEDisposeDesc(myDescPtr@) into xerr
        DisposPtr myWorkPtr
        return -1708
      end if

      if edOff = 0 then
        put tgSize into edOff
      else if edOff < 0 then
        put edOff+tgSize+1 into edOff
      end if

    else
      put tgSize into edOff
    end if

    -----
    put edOff-stOff into scanLen

    if scanLen <= 0 then
      put AEDisposeDesc(myDescPtr@) into xerr
      DisposPtr myWorkPtr
      return -1708
    end if
    -----

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

    put edOff-1 into scanLen

    repeat with x = stOff to scanLen

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

      put (tgX mod 16) into tgZ1

      if 0 <= tgZ1 and tgZ1 <= 9 then
        put NumToChar(tgZ1+48) into tempPtr@.charType[1]
      else
        put NumToChar(tgZ1+55) into tempPtr@.charType[1]
      end if

      put tgX div 16 into tgZ1

      if 0 <= tgZ1 and tgZ1 <= 9 then
        put NumToChar(tgZ1+48) into tempPtr@.charType[0]
      else
        put NumToChar(tgZ1+55) into tempPtr@.charType[0]
      end if

      put AEPutPtr(myListPtr@,0,"TEXT",tempPtr,2) into err
      if err <> 0 then
        put AEDisposeDesc(myDescPtr@) into xerr
        put AEDisposeDesc(myListPtr@) into xerr
        DisposPtr myWorkPtr
        return err
      end if

    end repeat

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

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

    return err

  end if

end hexDump