Try these
Well tested and work.
Note: any missing functions can be pinched from PG.
I've included fn's to filter and list files in the folder (these use a globalised XREF array)
'~'
/* This function makes an alias record to a folder given
the working directory reference number (from FILES$ etc),
the number of the alias, and the target resource file reference
number */
CLEAR LOCAL
DIM fSpec;0,fVRefNum,fParID&,63 fName$
LOCAL FN makeFolderAlias(inName$,inVrefNum%,resID,ResRef%)
'~'
DIM makeAlias,@fromFile,@aHndl&
fName$ = inName$
fVRefNum = inVrefNum%
fromFile = 0
'fParID& = FN getParID(fName$,fVRefNum)
LONG IF FN NEWALIAS(fromFile,fSpec,aHndl&)
makeAlias = _fnfErr
XELSE
FN pGreplaceXRes(aHndl&,_"alis",resID,fName$,ResRef)
makeAlias = _noErr
END IF
END FN = makeAlias
'~'
'~'
/* This function makes an alias record to a folder by asking the user
to select a file in the folder.
*/
local fn MakeAliasToFolder (fileType$,targetResRef%,theAlias)
dim @WDrefNum%
dim fileName$
'dim folderPath$
dim theResult
'dim oldresRefNo
dim osErr
WDrefNum% = 0'be paranoid
fileName$ = FILES$ (_fFolder,fileType$,,WDrefNum%)'Nav folder dialog
LONG IF WDrefNum%'if folder selected
'tron break
'oldresRefNo = fn curresfile
fileName$ = ""
'CALL USERESFILE (targetResRef%)
osErr = FN makeFolderAlias(fileName$,WDrefNum%,theAlias,targetResRef%)
long if osErr = _noErr
gExperimentDirty = _True
xelse
fn pGshowErr(13)
end if
'CALL USERESFILE (oldresRefNo)
end if
end fn
'~'
'~'
'This function returns a working directory reference number
'(as used by OPEN etc) given an alias resource number and
'resource file reference number
local fn GetFolderAliasWD%(resID,resRefNo)
DIM fSpec;0,fVRefNum,fParID&,63 fName$
dim useAlias
dim wdRefNo
dim oldresRefNo
dim ParWDRefNum%
oldresRefNo = fn curresfile
call useresfile (resRefNo)
fName$ = ""
useAlias = FN useAlias(resID,fSpec)
call useresfile (oldresRefNo)
LONG IF useAlias = _noErr
PARENTID = fParID&
ParWDRefNum% = FN getWDRefNum(fParID&,fVrefNum%)
WDRefNo% = FOLDER(fName$, ParWDRefNum%)
xelse
wdRefNo = 0
end if
end fn = wdRefNo
'~'
'~'
LOCAL FN checkFileType (RefNum%,thefile$,theType&)
DIM ParamBlk.128
DIM fileType&
dim ioErr%
dim OK as boolean
ParamBlk.ioNamePtr& = @thefile$
ParamBlk.ioVRefNum% = RefNum%
ParamBlk.ioFDirIndex& = 0
ioErr% = FN GETFILEINFO (@ParamBlk)
LONG IF ioErr% = 0
fileType& = ParamBlk.ioFlUsrWds.fdType&
LONG IF filetype& = theType&'tests for file type
OK = _True
xelse
OK = _False
END IF
END IF
END FN = OK
'~'
'~'
LOCAL FN filefolderList(volRef,fType&)
'---------------------------------------
' Given a volume reference number to a
' folder, fills an array with the file Name's
' of all files of a given type and returns
' the number of files of that type in the folder.
'---------------------------------------
dim indx,pathName$,fName$
dim @ Vref
dim elementCount
dim count
dim handleSize&
Dim arrayPts
Vref = volRef
count = 0'initialise count
pathName$ = FN convertWDRef$("",Vref)
indx = -1
DO
fName$ = FILES$(indx,,pathName$,Vref)
DEC(indx)
LONG IF RIGHT$(fName$,1) <> ":"'<- this is changed from HFS.FLTR
long if fName$ <> ""'actually a file!
long if FN checkFileType (volRef,fName$,fType&)'check file type
inc(count)
handleSize& = fn GETHANDLESIZE (gFileInfo.nil&)'get size of handle
arrayPts = (handleSize&/_gFileListSz)-1'array size allowed for
long if count > arrayPts'check enough memory
FN shrinkArray (gFileInfo.nil&,handleSize& + _gFileListSz*5)'get memory for 5 more points
end if
gFileInfo.fileName$(count) = fName$
end if
END IF
end if
UNTIL fName$ = ""
END FN = count
'~'
--
-----------------------------------------------------------------------
Dr David Cottrell
School of Psychology
James Cook University
Let my words be as honey, for tomorrow I will probably have to eat them.
-----------------------------------------------------------------------