MT Zap Resource : 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 myPbPtr:Pointer

codeResource "osax"

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

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

  if err <> 0 then
    return err
  end if

  put NewPtrClear(414) into myWorkPtr

  put myWorkPtr into myFssPtr
  put myWorkPtr + 70 into myPbPtr
  put myWorkPtr + 150 into myDescPtr
  put myWorkPtr + 158 into myNmPtr

  if (myType = "list") then

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

    put 0 into myLSize
    put AECountItems(myDescPtr@,myLSize) into err
    if err <> 0 then
      put AEDisposeDesc(myDescPtr@) into xErr
      DisposPtr myWorkPtr
      return err
    end if

    if myLSize = 0 then
      put AEDisposeDesc(myDescPtr@) into xErr
      DisposPtr myWorkPtr
      return 0
    end if

    put myNmPtr+1 into aPtr

    repeat with x = 1 to myLSize

      put AESizeOfNthItem(myDescPtr@,x,myType,mySize) into err
      if err <> 0 then exit repeat

      if myType = "TEXT" and mySize < 256 then
        put AEGetNthPtr(myDescPtr@,x,"TEXT",AEKeyword,typeCode,aPtr,mySize,myactSize) into err
        if err <> 0 then exit repeat

        put NumToChar(myactSize) into myNmPtr@.charType
        put myNmPtr@.Str255Type into myFname
        put FSMakeFSSpec(0, 0, myFname, myFssPtr@) into err
        if err <> 0 then exit repeat

      else

        put AEGetNthPtr(myDescPtr@,x,typeFSS,AEKeyword,typeCode,myFssPtr,70,myactSize) into err
        if err <> 0 then exit repeat

      end if


      put Zapper(myFssPtr) into err

      if err <> 0 then exit repeat
    end repeat

    put AEDisposeDesc(myDescPtr@) into xErr


  else

    if myType = "TEXT" and mySize < 256 then

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

      put NumToChar(myactSize) 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@,keyDirectObject,typeFSS,typeCode,myFssPtr,70,myactSize) into err

      if err <> 0 then
        DisPosPtr myWorkPtr
        return err
      end if

    end if

    ----
    put Zapper(myFssPtr) into err
    ----

  end if

  DisposPtr myWorkPtr

  return err

end zapResFork


function Zapper myFssPtr

  put myFssPtr@.IntegerType into myPbPtr@.ioVRefNum
  put myFssPtr+2 into aPtr
  put aPtr@.LongIntType into myPbPtr@.ioDrDirID
  put myFssPtr+6 into myPbPtr@.ioNamePtr

  put PBHGetFInfo(myPbPtr) into err

  if err <> 0 then
    return err
  end if

  put myPbPtr@.ioFlRLgLen into myLen
  put myPbPtr + 30 into aPtr
  put BitTst(aPtr,0) into openFlg

  if openFlg then
    return -47
  end if

  if myLen = 0 then
    return 0
  end if

  ---
  put FSpOpenRF(myFssPtr@, fsRdWrPerm, myrefNum) into err

  if err <> 0 then
    return err
  end if

  get SetEOF(myrefNum,0)
  get FSClose(myrefNum)

  put myPbPtr+40 into tgPtr
  BitClr tgPtr,5
  put Time into myPbPtr@.ioFlMdDat

  put myFssPtr@.IntegerType into myPbPtr@.ioVRefNum
  put myFssPtr+2 into aPtr
  put aPtr@.LongIntType into myPbPtr@.ioDrDirID
  put myFssPtr+6 into myPbPtr@.ioNamePtr

  put PBHSetFInfo(myPbPtr) into err

  if err <> 0 then
    return err
  end if

  put FlushVol(nil,(myFssPtr@.IntegerType)) into err

  return err
end Zapper