CyberStratege 8/CyberStratege_CD_08.iso/h-c.dxr/00075_Text_75.txt

Text File | 1983-06-06 | 7KB | 282 lines

on pouetpouet
  --A collection of Windows Utilitys for Director.
  --This collection is provided for FREE ... Test and Test often.
  --If  you can think of more utilities to add to this collection, please
  --email your suggestions to us.  We are trying to build a powerstation,
  --but we are starting with a battery.
  --
  --EMAIL -  [e-mail]   (Paul Farry)
  --or  [e-mail] (Matthew Kennedy)
  --
  --Even if you can't think of any suggestions for new stuff, but you like what we've done
  --please email both of us and say so....We look forward to feedback.
  --

on startmovie
  opendirutil
  if xfactorylist("Fileio") =EMPTY then openxlib "FileIO"
end

on stopmovie
  --make sure your done all your fileio related mDisposes
  if xfactorylist("Fileio") <> EMPTY then closexlib "FileIO"
  closedirutil
end

on openDirutil
  global x
  openxlib("DirUtil")
  set x = DirUtil(mNew)
end

on closeDirUtil
  global x
  x(mDispose)
  closexlib("DirUtil")
end


on qtversion
  global x
  put x(mQTVersion) into field "QTVersion"
end

on qtversionstring
  global x
  put x(mQTVersionStr) into field "QTVersionString"
end

on setattrib afilename
  global s_util
  --NORMAL   00   /* Normal file, no attributes */
  --RDONLY   01   /* Read only attribute */
  --HIDDEN    02 /* Hidden file */
  --SYSTEM    04 /* System file */
  --ARCH        32 /* Archive */
  --to get combinations add together the numbers
  if voidp(aFilename) then
    set f = fileio(mNew,"?read","*")
    if objectp(f) then
      set afilename = f(mFilename)
      f(mdispose)
    end if
  end if
  if not voidp(aFilename) then
    s_util(mSetAttrib,afilename,00) --presently it will set a file to NORMAL
  end if
end

on  getfileattrib afilename
  global x
  --NORMAL   00   /* Normal file, no attributes */
  --RDONLY   01   /* Read only attribute */
  --HIDDEN    02  /* Hidden file */
  --SYSTEM    04  /* System file */
  --LABEL       08  /*volume label*/
  --DIR            16  /*directory*/
  --ARCH        32  /* Archive */
  --to get combinations add together the numbers
  if voidp(aFilename) then
    set f = fileio(mNew,"?read","*")
    if objectp(f) then
      set afilename = f(mFilename)
      f(mdispose)
    end if
  end if
  if not voidp(aFilename) then

    set attrib = x(mgetattrib,afilename)
    set at = string(attrib)&": "
    if (x(mbitAND,attrib,1)<>0) then
      set at = at & "R"
    else
      set at = at &"_"
    end if
    if (x(mbitAND,attrib,2)<>0) then
      set at = at & "H"
    else
      set at = at &"_"
    end if
    if (x(mbitAND,attrib,4)<>0) then
      set at = at & "S"
    else
      set at = at &"_"
    end if
    if (x(mbitAND,attrib,8)<>0) then
      set at = at & "L"
    else
      set at = at &"_"
    end if
    if (x(mbitAND,attrib,16)<>0) then
      set at = at & "D"
    else
      set at = at &"_"
    end if
    if (x(mbitAND,attrib,32)<>0) then
      set at = at & "A"
    else
      set at = at &"_"
    end if

  else
    set at="No Filename"
  end if
  put at into field "Attribute"
end

on testfileattr
  getfileattrib("c:\msdos.sys")
  put field "attribute"
end

on GetDriveType  adrivenum
  global x,drives
  set drives = ["DRIVE_UNDETERMINED","DRIVE_NOTEXIST",¬
                         "DRIVE_REMOVABLE","DRIVE_FIXED","DRIVE_REMOTE"]
  if voidp(adrivenum) then
    put value(field "DriveNum") into adrivenum
  end if
  set drtypeno=  x(mGetDriveType,adrivenum)
  set drtype = getat(drives,drtypeno+1)
  put drtype into field "DriveType"
end

on WhereISCDRom
  global x
  set hit = false
  set count = 0
  repeat while (hit = false) and (count < 50)
    if x(mIsCDRom,count) then
      set hit = true
      set driveletter = numtochar(count+65)
    end if
    set count = count + 1
  end repeat
  if hit = false then
    set driveletter = "No CDROM Found"
  end if
  put driveletter &":" into field "CD-ROM"
end

on authors
  global x
  put x(mAuthors) into field "Author Info"
end

on seterroron
  global x

  -- 01critical-error-handler message box and returns the error to the calling application.
  -- 02 general-protection-fault message box. This flag should be set only
  --       by debugging applications that  handle GP faults themselves.
  -- 32768 message box when it fails to find  a file.

  x(mSetErrormode,1)
  --Windows errors OFF
end

on seterroroff
  global x
  x(mSetErrorMode,0)
  --Windows errors ON
end

On testmessagebox
  set   mb_Ok                     = 0000
  set  mb_OkCancel         =0001
  set  mb_AbortRetryIgnore = 0002
  set mb_YesNoCancel      = 0003
  set  mb_YesNo            = 0004
  set  mb_RetryCancel      = 0005
  --
  set  mb_IconHand         = 0016
  set  mb_IconQuestion     = 0032
  set  mb_IconExclamation  = 0048
  set  mb_IconAsterisk     = 0064
  --
  set  mb_IconInformation  = mb_IconAsterisk
  set  mb_IconStop         = mb_IconHand
  --
  set  mb_DefButton1       = 0000
  set  mb_DefButton2       = 256
  set  mb_DefButton3       = 512
  --
  set  mb_ApplModal        = 0000
  set  mb_SystemModal      = 4096
  set  mb_TaskModal       =  8192
  --
  set  mb_NoFocus          = 32768
  --
  set  mb_TypeMask         = 15
  set  mb_IconMask         = 240
  set  mb_DefMask          = 3840
  set  mb_ModeMask         = 12288
  set  mb_MiscMask         = 49152
  --
  global x

  put x(mMessageBox,"Caption","text",mb_AbortRetryIgnore +mb_IconExclamation+mb_DefButton3 )

end


on testerrors
  whereiscdrom
  put field "CD-ROM" into cdpath
  put cdpath
  set errortest = fileio(mNew,"read",cdpath &"\Garbage.txt")
  if objectp(errortest) then
    alert "IT's found"
    errortest(mDispose)
  else
    alert "It's not found"
  end if
end

on testPath
  global x
  set the text of cast "pathtext" = x(mGetEnvironVar,"PATH")
end

on testfontnames
  global x
  put x(mFontList) into s
  set fontlist = []
  repeat with i = 1 to the number of lines in s
    append(fontlist,line i of s)
  end repeat
  sort fontlist
  repeat with i = 1 to count(fontlist)
    put getat(fontlist,i) into line i of field "FontNames"
  end repeat
end

On testCopyToCast
  global x
  --set nm= findEmpty(member 1)
  set x1 = random(300)
  set y1 = random(300)
  set x2 = x1+100
  set y2 = y2+100
  x(mCopyToClipBoard,x1,y1,x2,y2)
  pasteClipBoardInto  member 45
  --put "Should be in cast ",nm
end


on testFileCopy sourcefilename,destinationfilename
  global x
  return x(mFileCopy,sourcefilename,destinationfilename)
end


--ISI    mSetAttrib,filename,attrib --Sets the Attibute of attr
--IS     mgetfileattrib,filename     --Gets the Attibute of filename
--II     mGetDriveType,drivenumber --Gets the type of a drive selected
--I      mQTVersion              --Returns an integer status code
--S      mQTVersionStr           --Returns version as a string
--II     mIsCdrom,drivenumber    --Return true if drive CDROM
--S      mAuthors                --Information on authors
--XI     mSetErrorMode,mode      --sets windoze error mode
end pouetpouet