[futurebasic] Re: [FB] Alias to a folder

Message: < previous - next > : Reply : Subscribe : Cleanse
Home   : October 2000 : Group Archive : Group : All Groups

From: David Cottrell <David.Cottrell@...>
Date: Mon, 23 Oct 2000 15:11:58 +1000
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.
-----------------------------------------------------------------------