{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}
{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}
{																								}
{									GENERIC FILES										}
{									```````````````````````										}
{																								}
{	A Generic Utilities unit, for use by any program.
	Copyright © by David Sinclair, 1990 ­ 2001.
	
	<http://www.dejal.com/pascal/>
	
	I am releasing these units to the Pascal community.  Feel free to use them in whole or part in your Pascal programs.
	You are also welcome to modify these units to suit your needs.  If you wish to re-distribute the sources with your changes,
	please clearly indicate that you have changed them.  In all cases, you must leave these comments and the copyright notice intact.
	If you use a significant portion of these units, I would appreciate acknowledgement in your About dialog and/or documentation,
	e.g. ³Dejal Generic Utilities copyright © by David Sinclair, 1990 - 2001.²
	
	I¹d appreciate it if you also e-mail me at <pascal@dejal.com> if you find these units useful.  If you have any questions about
	these units, you can e-mail me at that address and I will do my best to help, time permitting.  However, these units are provided
	³as is² and I do not guarantee their reliablity or suitability for any particular purpose.
	
	These units have been used extensively in my Dejal shareware and freeware products over the years.  Most of the code was written
	many years ago, and the code and style may not be optimal in all cases, but unless otherwise noted all routines have been used
	in released software, so should work as described.
	
	Please visit <http://www.dejal.com/> and try out Dejal QuickEncrypt and/or my other shareware products.  If you want to show
	your appreciation for these units financially, registrations for my shareware are always welcome!  Or you can make a donation to
	me via my online order form: <http://www.dejal.com/kagi/>.
	
	I hope you find these units useful, and good luck in your Pascal endeavors!
	
	- David Sinclair, Dejal
}
{											* * *												}
{	Note that this unit will only work under System 7: do not use it under		}
{	System 6.  This unit requires the Folders interface file.							}
{											* * *												}
{	UNIT HISTORY:  (Reverse chronology)											}
{																								}
{	Start ­ finish dates:		Comments / changes:										}
{																								}
{	27 October 2001			Public release as source code.							}
{	22 June 1997				Added the FileReadLinePtr and FileReadLineStr routines.			}
{	16 March 1997				Added the creator parameter to the						}
{								fileCreateTemporary routine.							}
{	25 February 1996			Added the textFileType constant.						}
{	3 October 1995				Added fileFromScrap and fileToScrap routines.		}
{	24 September 1995		Added the fileCreateTemporary routine.				}
{	1 February 1995			Fixed problem with positioning icons of created		}
{								folders, and made the folderBit and initedBit			}
{								constants public.											}
{	27 January 1995			Started the unit based on code from my Phase		}
{								Two Shareware applications.								}
{											* * *												}
{	N.B:	Most of my units require the compile-time variables Œapplication¹	}
{			and Œdebug¹, both of which are booleans.									}
{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}
{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}


UNIT genFiles;


INTERFACE


	USES

		Folders, genNumerics, genStrings;


	CONST

		ignoreFileType = '••••';		{ Assumed to never be used; pass to fileSetTypeAndDates to not }
										{	set either the creator or file type codes }

		unknownFileType = '????';	{ Used for temporary files, etc. }
		textFileType = 'TEXT';			{ A very common file type }

		positionTheIcon = true;			{ Used when creating unique files or folders to position the icon }
		dontPositionIcon = false;		{ Don¹t position the icon }

		delOnError = true;				{ Used when closing files: delete file if an error }
		dontDelete = false;				{ Don¹t delete the file even if an error occurred }

		folderBit = 3;						{ BitSet etc value for the ioFlAttrib field of the catInfoRec record }
		bundleBit = 2;						{ BitSet etc value for the fdFlags field of the FInfo record }
		initedBit = 7;						{ BitSet etc value for the fdFlags field of the FInfo record }


	TYPE

		catInfoRec = CInfoPBRec;		{ An easier name! }


{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}


	FUNCTION fileGetCatInfo (VAR fileSpec: FSSpec; VAR p: catInfoRec): osErr;

{ Accepts: files or folders. }


	FUNCTION fileSetCatInfo (VAR fileSpec: FSSpec; VAR p: catInfoRec): osErr;

{ Accepts: files or folders. }


	FUNCTION fileIsFolder (VAR p: catInfoRec): boolean;

{ Accepts: files or folders. }


	FUNCTION fileGetFInfo (fileSpec: FSSpec; VAR fndrInfo: FInfo): osErr;

{ Accepts: files or folders. }


	FUNCTION fileSetFInfo (fileSpec: FSSpec; fndrInfo: FInfo): osErr;

{ Accepts: files or folders. }


	FUNCTION fileGotoSubFolder (folderSpec: FSSpec; VAR err: osErr): FSSpec;

{ Accepts: only folders. }


	FUNCTION fileGotoParentFolder (fileSpec: FSSpec; VAR err: osErr): FSSpec;

{ Accepts: files or folders. }


	FUNCTION fileGetDates (fileSpec: FSSpec; VAR createDate, modDate: longint): osErr;

{ Accepts: files or folders. }


	FUNCTION fileSetTypeAndDates (fileSpec: FSSpec; creatorCode, fileTypeCode: osType;								{}
									createDate, modDate: longint): osErr;

{ Accepts: files or folders. }


	FUNCTION fileSetDates (fileSpec: FSSpec; createDate, modDate: longint): osErr;

{ Accepts: files or folders. }


	FUNCTION fileEnoughRoom (fileSpec: FSSpec; totalSizeNeeded: longint): osErr;

{ Accepts: files or folders. }


	FUNCTION fileExists (fileSpec: FSSpec): osErr;

{ Accepts: files or folders. }


	FUNCTION fileCreateUnique (VAR fileSpec: FSSpec; suffix: str31; creator, fileType: osType;				{}
									positionIcon: boolean; positionSpec: FSSpec): osErr;

{ Accepts: only files. }


	FUNCTION fileCreateUniqueFolder (VAR folderSpec: FSSpec; folderSuffix: str31;							{}
									positionIcon: boolean; positionSpec: FSSpec): osErr;

{ Accepts: only folders. }


	FUNCTION fileRenameUnique (VAR fileSpec: FSSpec; newName: str31): osErr;

{ Accepts: files or folders. }


	FUNCTION fileMoveUnique (fromSpec, toSpec: FSSpec): osErr;

{ Accepts: files or folders. }


	FUNCTION fileCreateTemporary (VAR fileSpec: FSSpec; creator, fileType: OSType): OSErr;

{ Accepts: only files. }


	FUNCTION fileMoveToTrash (fileSpec: FSSpec): osErr;

{ Accepts: files or folders. }


	FUNCTION fileOpenDataFork (fileSpec: FSSpec; permission: signedByte;									{}
									VAR refNum: integer; VAR fileSize: longint): osErr;

{ Accepts: only files. }


	PROCEDURE fileCloseDataFork (refNum: integer; fileSpec: FSSpec;											{}
									deleteIfErr: boolean; VAR err: osErr);

{ Accepts: only files. }

	FUNCTION fileFromScrap (fileSpec: FSSpec; scrapKind: OSType): OSErr;

{ Accepts: only files. }

	FUNCTION fileToScrap (fileSpec: FSSpec; scrapKind: OSType): OSErr;

{ Accepts: only files. }

	FUNCTION FileReadLinePtr(refNum: Integer; thePtr: Ptr; VAR count: Longint): OSErr;

{Accepts: only files.}

	FUNCTION FileReadLineStr(refNum: Integer; VAR theStr: Str255): OSErr;

{Accepts: only files.}

	FUNCTION FileGetIconSuite (creator, fileType: OSType): Handle;


{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}
{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}


IMPLEMENTATION


	TYPE

		uniqueOpType = (createFile, createFolder, renameFile, moveFile);


{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}


	FUNCTION fileGetCatInfo (VAR fileSpec: FSSpec; VAR p: catInfoRec): osErr;

{ Accepts: files or folders. }

{ A FSSpec version of PBGetCatInfoSync.  Pass a file or folder specification, and a catalog info }
{ parameter block record.  FYI, the fileSpec parameter is passed as a var parameter since the name }
{ from it is passed as a pointer to PBGetCatInfoSync, to ensure the pointer remains valid; it is not }
{ modified at all.  You normally shouldn¹t need to call this routine, as the following ones should }
{ provide pretty much all the functionallity you¹ll need. }
{ Written by David Sinclair, 27 January 1995. }

	BEGIN
		p.ioNamePtr:= @fileSpec.name;
		p.ioVRefNum:= fileSpec.vRefNum;
		p.ioFDirIndex:= 0;
		p.ioDrDirID:= fileSpec.parID;

		fileGetCatInfo:= PBGetCatInfoSync(@p);
	END;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	FUNCTION fileSetCatInfo (VAR fileSpec: FSSpec; VAR p: catInfoRec): osErr;

{ Accepts: files or folders. }

{ A FSSpec version of PBSetCatInfoSync.  Pass a file or folder specification, and a valid catalog info }
{ parameter block record.  You should have previously called fileGetCatInfo to fill in the }
{ parameter block values correctly.  FYI, the parameter block is passed as a var parameter to }
{ save stack space; if it were a value parameter, the entire block would be shoved onto the stack, }
{ instead of just a pointer to it.  You normally shouldn¹t need to call this routine, as the }
{ following ones should provide pretty much all the functionallity you¹ll need. }
{ Written by David Sinclair, 27 January 1995. }

	BEGIN
		p.ioNamePtr:= @fileSpec.name;
		p.ioVRefNum:= fileSpec.vRefNum;
		p.ioFDirIndex:= 0;
		p.ioDrDirID:= fileSpec.parID;

		fileSetCatInfo:= PBSetCatInfoSync(@p);
	END;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	FUNCTION fileIsFolder (VAR p: catInfoRec): boolean;

{ Accepts: files or folders. }

{ Returns true if the item described by the parameter block is a folder. }
{ Written by David Sinclair, 27 January 1995. }

	BEGIN
		fileIsFolder:= BitTst(@p.ioFlAttrib, folderBit)
	END;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	FUNCTION fileGetFInfo (fileSpec: FSSpec; VAR fndrInfo: FInfo): osErr;

{ Accepts: files or folders. }

{ Returns the Finder info for the specified file or folder.  The same as calling FSpGetFInfo, except }
{ it works for both files and folders. }
{ Written by David Sinclair, 27 January 1995. }

		VAR
			p: catInfoRec;

	BEGIN
		fileGetFInfo:= fileGetCatInfo(fileSpec, p);

		fndrInfo:= p.ioFlFndrInfo;
	END;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	FUNCTION fileSetFInfo (fileSpec: FSSpec; fndrInfo: FInfo): osErr;

{ Accepts: files or folders. }

{ Changes the Finder info for the specified file or folder.  The same as calling FSpSetFInfo, except }
{ it works for both files and folders. }
{ Written by David Sinclair, 27 January 1995. }

		VAR
			p: catInfoRec;
			err: osErr;

	BEGIN
		err:= fileGetCatInfo(fileSpec, p);

		BitSet(@fndrInfo.fdFlags, initedBit);			{ Make sure the inited bit is set, so the FInfo }
														{	isn¹t set to default values }
		p.ioFlFndrInfo:= fndrInfo;

		IF err = noErr THEN
			err:= fileSetCatInfo(fileSpec, p);

		fileSetFInfo:= err
	END;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	FUNCTION fileGotoSubFolder (folderSpec: FSSpec; VAR err: osErr): FSSpec;

{ Accepts: only folders. }

{ Given a spec of a folder, this routine returns a spec describing the contents of that folder, i.e. }
{ we enter the folder.  Old values of err are preserved, if any. }
{ Written by David Sinclair, 7 December 1994. }

		VAR
			p: catInfoRec;
			temp: osErr;

	BEGIN
		p.ioNamePtr:= @folderSpec.name;
		p.ioVRefNum:= folderSpec.vRefNum;
		p.ioFDirIndex:= 0;
		p.ioDrDirID:= folderSpec.parID;

		temp:= PBGetCatInfoSync(@p);

		IF err = noErr THEN
			err:= temp;

		folderSpec.parID:= p.ioDrDirID;

		fileGotoSubFolder:= folderSpec
	END;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	FUNCTION fileGotoParentFolder (fileSpec: FSSpec; VAR err: osErr): FSSpec;

{ Accepts: files or folders. }

{ Given a fileSpec (of which only the vRefNum and parID fields need be valid), this routine }
{ returns a spec of the enclosing folder itself.  Old values of err are preserved, if any. }
{ Written by David Sinclair, 7 December 1994. }

		VAR
			p: catInfoRec;
			temp: osErr;

	BEGIN
		p.ioNamePtr:= @fileSpec.name;
		p.ioVRefNum:= fileSpec.vRefNum;
		p.ioFDirIndex:= -1;
		p.ioDrDirID:= fileSpec.parID;

		temp:= PBGetCatInfoSync(@p);

		IF err = noErr THEN
			err:= temp;

		fileSpec.parID:= p.ioDrParID;

		fileGotoParentFolder:= fileSpec
	END;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	FUNCTION fileGetDates (fileSpec: FSSpec; VAR createDate, modDate: longint): osErr;

{ Accepts: files or folders. }

{ Returns the creation and modification dates of the specified file or folder. }
{ Written by David Sinclair, 8 November 1994. }

		VAR
			p: catInfoRec;

	BEGIN
		fileGetDates:= fileGetCatInfo(fileSpec, p);

		createDate:= p.ioFlCrDat;
		modDate:= p.ioFlMdDat;
	END;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	FUNCTION fileSetTypeAndDates (fileSpec: FSSpec; creatorCode, fileTypeCode: osType;								{}
									createDate, modDate: longint): osErr;

{ Accepts: files or folders. }

{ Sets the creator and file type codes, plus the creation and modification dates of the specified file; }
{ pass ignoreFileType for either or both of the two codes or zero for either or both of the two dates }
{ to only set the other items. }
{ Written by David Sinclair, 8 November 1994. }

		VAR
			p: catInfoRec;
			ignored: longint;
			err: osErr;

	BEGIN
		err:= fileGetCatInfo(fileSpec, p);

		IF err = noErr THEN
			BEGIN
				IF createDate <> 0 THEN
					p.ioFlCrDat:= createDate;

				IF modDate <> 0 THEN
					p.ioFlMdDat:= modDate;

				IF NOT BitTst(@p.ioFlAttrib, folderBit) THEN
					BEGIN													{ Only set these if it¹s a file }
						IF creatorCode <> ignoreFileType THEN
							p.ioFlFndrInfo.fdCreator:= creatorCode;

						IF fileTypeCode <> ignoreFileType THEN
							p.ioFlFndrInfo.fdType:= fileTypeCode;
					END;

				err:= fileSetCatInfo(fileSpec, p);
			END;

		fileSetTypeAndDates:= err
	END;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	FUNCTION fileSetDates (fileSpec: FSSpec; createDate, modDate: longint): osErr;

{ Accepts: files or folders. }

{ Sets the creation and modification dates of the specified file or folder; pass zero for either to only }
{ set the other; use the above routine to also set the creator and file type codes. }
{ Written by David Sinclair, 8 November 1994. }

	BEGIN
		fileSetDates:= fileSetTypeAndDates(fileSpec, ignoreFileType, ignoreFileType, createDate, modDate);
	END;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	FUNCTION fileEnoughRoom (fileSpec: FSSpec; totalSizeNeeded: longint): osErr;

{ Accepts: files or folders. }

{ If you know how big an output file will be, call this function before creating or opening the file; }
{ it will return an error if there isn¹t enough disk space in the specified location. }
{ Written by David Sinclair, 24 July 1994. }

		VAR
			sizingRef: integer;
			err, human: osErr;

	BEGIN
		err:= fileCreateUnique(fileSpec, null, '????', '????', dontPositionIcon, fileSpec);
		IF err = noErr THEN
			err:= FSpOpenDF(fileSpec, fsWrPerm, sizingRef);
		IF err = noErr THEN
			err:= allocate(sizingRef, totalSizeNeeded);
		human:= FSClose(sizingRef);
		human:= FSpDelete(fileSpec);

		fileEnoughRoom:= err
	END;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	FUNCTION fileExists (fileSpec: FSSpec): osErr;

{ Accepts: files or folders. }

{ Returns noErr if the specified file or folder exists, otherwise an error (fnfErr probably, or possibly }
{ dirNFErr or nsvErr). }
{ Written by David Sinclair, 16 November 1994. }

		VAR
			p: catInfoRec;

	BEGIN
		fileExists:= fileGetCatInfo(fileSpec, p);
	END;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	FUNCTION uniqueOperation (operation: uniqueOpType; VAR fileSpec, positionSpec: FSSpec;		{}
									newName: str31; creator, fileType: osType; positionIcon: boolean): osErr;

{ Creates a new empty file or folder, or renames a file uniquely, as specified by the }
{ operation parameter.  If a file or folder already exists in that directory with the same }
{ name, it adds numbers to the name until a unique name is found.  The fileSpec is }
{ returned with the final name, and for folders the dirID of the newly created folder is }
{ returned in the parID field of the fileSpec, and the name is left as was originally }
{ provided.  Called by the following four ³nice interface² routines. }
{ Written by David Sinclair, 2 June 1994, based on code from SndConverter. }

		VAR
			nameDupCount: integer;
			createdDirID: longint;
			oldName, tempName: str31;
			err, tempErr: osErr;


		PROCEDURE positionTheIcon;

{ Subroutine to adjust the icon position. }

			CONST
				shift = 15;

			VAR
				fndrInfo: FInfo;
				location: point;
				positionErr: osErr;

		BEGIN
			positionErr:= fileGetFInfo(positionSpec, fndrInfo);

			location:= fndrInfo.fdLocation;

			WITH location DO
				BEGIN
					v:= v + shift;
					h:= h + shift;
				END;

			IF positionErr = noErr THEN
				positionErr:= fileGetFInfo(fileSpec, fndrInfo);

			fndrInfo.fdLocation:= location;

			IF positionErr = noErr THEN
				positionErr:= fileSetFInfo(fileSpec, fndrInfo)
		END;


		PROCEDURE addSuffixToName;

{ Subroutine to add the correct suffix to the name. }

			VAR
				suffix: str31;

		BEGIN
			suffix:= null;

			IF nameDupCount > 1 THEN
				suffix:= concat(' ', strFromNum(nameDupCount));

			IF operation = createFile THEN
				suffix:= concat(newName, suffix)
			ELSE IF operation = createFolder THEN
				suffix:= concat(suffix, newName);

			suffix:= concat(copy(oldName, 1, 31 - length(suffix)), suffix);

			IF operation = renameFile THEN
				newName:= suffix
			ELSE IF operation = moveFile THEN
				tempName:= suffix
			ELSE
				fileSpec.name:= suffix
		END;


	BEGIN
		createdDirID:= fileSpec.parID;
		nameDupCount:= 1;

		IF operation = renameFile THEN
			oldName:= newName
		ELSE
			oldName:= fileSpec.name;

		IF operation IN [createFile, createFolder] THEN
			addSuffixToName;

		REPEAT					{ Add numbers to name until a unique name is found }
			CASE operation OF
				createFile: 
					err:= FSpCreate(fileSpec, creator, fileType, 0);
				createFolder: 
					err:= FSpDirCreate(fileSpec, 0, createdDirID);
				moveFile: 
					err:= FSpCatMove(fileSpec, positionSpec);
				OTHERWISE		{ renameFile }
					err:= FSpRename(fileSpec, newName);
			END;

			nameDupCount:= nameDupCount + 1;
			IF err = dupFNErr THEN
				BEGIN
					addSuffixToName;

					IF operation = moveFile THEN
						BEGIN
							tempErr:= FSpRename(fileSpec, tempName);
							IF tempErr = noErr THEN
								fileSpec.name:= tempName
						END
				END;

		UNTIL (err <> dupFNErr) | (nameDupCount >= maxInt);

		CASE operation OF
			createFolder: 
				fileSpec.name:= oldName;
			renameFile: 
				fileSpec.name:= newName;
			OTHERWISE
				;		{ No post-processing to do for createFile and moveFile }
		END;

		IF positionIcon THEN
			positionTheIcon;

		IF operation = createFolder THEN				{ Enter the new folder }
			fileSpec.parID:= createdDirID;

		uniqueOperation:= err
	END;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	FUNCTION fileCreateUnique (VAR fileSpec: FSSpec; suffix: str31; creator, fileType: osType;				{}
									positionIcon: boolean; positionSpec: FSSpec): osErr;

{ Accepts: only files. }

{ Creates a new empty file with the given name, suffix, location, and types.  If a file already exists }
{ in that directory with the same name, it adds numbers to the filename until a unique name is }
{ found.  The fileSpec is returned with the final name.  Pass a suffix to add to the end of the name, }
{ shortening the original filename if necessary, or null to have no suffix.  Pass true for positionIcon }
{ to have the icon positioned just to the right and below the original file¹s, and pass the original }
{ file in positionSpec (it is ignored if positionIcon is false).  The constants positionTheIcon and }
{ dontPositionIcon are also available. }
{ Written by David Sinclair, 2 June 1994; suffix option added 23 November 1994. }

	BEGIN
		fileCreateUnique:= uniqueOperation(createFile, fileSpec, positionSpec, suffix, creator, fileType, positionIcon)
	END;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	FUNCTION fileCreateUniqueFolder (VAR folderSpec: FSSpec; folderSuffix: str31;							{}
									positionIcon: boolean; positionSpec: FSSpec): osErr;

{ Accepts: only folders. }

{ Creates a new empty folder with the name and location as specified by the fileSpec, with the }
{ specified folder suffix automatically appended to the name.  If a file or folder already exists in }
{ that directory with the same name, it adds numbers to the folder name until a unique name is }
{ found.  The folderSpec is returned with the same name as it originally had, but with the dirID of }
{ the created folder instead of the original: you can then use that folderSpec to create files within }
{ that folder.  Pass true for positionIcon to have the icon positioned just to the right and below the }
{ original file¹s, and pass the original file in positionSpec (it is ignored if positionIcon is false).  }
{ The constants positionTheIcon and dontPositionIcon are also available. }
{ Written by David Sinclair, 5 June 1994. }

	BEGIN
		fileCreateUniqueFolder:= uniqueOperation(createFolder, folderSpec, positionSpec, folderSuffix, 'none', 'none', positionIcon);
	END;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	FUNCTION fileRenameUnique (VAR fileSpec: FSSpec; newName: str31): osErr;

{ Accepts: files or folders. }

{ Renames the specified file as the new name.  If a file already exists in that directory with the }
{ same name, it adds numbers to the filename until a unique name is found.  The fileSpec is }
{ returned with the final name. }
{ Written by David Sinclair, 6 June 1994. }

	BEGIN
		fileRenameUnique:= uniqueOperation(renameFile, fileSpec, fileSpec, newName, 'none', 'none', false)
	END;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	FUNCTION fileMoveUnique (fromSpec, toSpec: FSSpec): osErr;

{ Accepts: files or folders. }

{ Moves the specified file from it¹s current location to the new location; toSpec must be on the }
{ same volume as fromSpec.  Note that toSpec should be a folderSpec of the directory itself, not }
{ it¹s content.  If a file already exists in that directory with the same name, it adds numbers to the }
{ filename until a unique name is found. }
{ Written by David Sinclair, 17 November 1994. }

	BEGIN
		fileMoveUnique:= uniqueOperation(moveFile, fromSpec, toSpec, null, 'none', 'none', false);
	END;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	FUNCTION fileCreateTemporary (VAR fileSpec: FSSpec; creator, fileType: OSType): OSErr;

{ Accepts: only files. }

{ Creates a temporary work file in the Temporary Items folder.  fileSpec.vRefNum should contain }
{ a valid vRefNum; if fileSpec.name is non-null, it is used, otherwise the default name ³Workfile² }
{ is used. }
{ Written by David Sinclair, 24 September 1995; added creator parameter, 16 March 1997. }

		VAR
			err: OSErr;

	BEGIN
		WITH fileSpec DO
			BEGIN
				err:= FindFolder(vRefNum, kTemporaryFolderType, kCreateFolder, vRefNum, parID);

				IF name = null THEN
					name:= 'Workfile';
			END;

		IF err = noErr THEN
			err:= fileCreateUnique(fileSpec, null, creator, fileType, dontPositionIcon, fileSpec);

		fileCreateTemporary:= err
	END;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	FUNCTION fileMoveToTrash (fileSpec: FSSpec): osErr;

{ Accepts: files or folders. }

{ Moves the specified file to the Trash, renaming if necessary. }
{ Written by David Sinclair, 17 November 1994. }

		VAR
			trashVRefNum: integer;
			trashDirID: longint;
			trashSpec: FSSpec;
			err: osErr;

	BEGIN
		err:= FindFolder(fileSpec.vRefNum, kTrashFolderType, kCreateFolder, trashVRefNum, trashDirID);

		IF err = noErr THEN
			BEGIN
				err:= FSMakeFSSpec(trashVRefNum, trashDirID, null, trashSpec);

				IF err = noErr THEN
					err:= fileMoveUnique(fileSpec, trashSpec)
			END;

		fileMoveToTrash:= err
	END;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	FUNCTION fileOpenDataFork (fileSpec: FSSpec; permission: signedByte;									{}
									VAR refNum: integer; VAR fileSize: longint): osErr;

{ Accepts: only files. }

{ Opens the data fork of the specified file, with the specified permission (usually one of }
{ fsRdWrPerm or fsRdPerm).  It returns the access refNum to it and the size of the data fork in }
{ bytes.  Apart from normal errors, the error eofErr is returned if the data fork is empty. }
{ Written by David Sinclair, 31 March 1994. }

		VAR
			err: osErr;

	BEGIN
		err:= FSpOpenDF(fileSpec, permission, refNum);

		IF err = noErr THEN
			BEGIN
				err:= getEOF(refNum, fileSize);
				IF (err = noErr) & (fileSize <= 0) THEN
					err:= eofErr
			END;

		fileOpenDataFork:= err
	END;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	PROCEDURE fileCloseDataFork (refNum: integer; fileSpec: FSSpec;											{}
									deleteIfErr: boolean; VAR err: osErr);

{ Accepts: only files. }

{ Closes the specified data file and flushes the volume (as specified by the vRefNum parameter of }
{ the fileSpec) to write any changes.  Pass delOnError for deleteIfError to delete the file if an error }
{ has occurred (if writing, the file is probably invalid), or dontDelete to not delete it.  A new error }
{ is only reported if err is noErr. }
{ Written by David Sinclair, 31 March 1994; deleteIfErr feature added 17 April 1994. }

		VAR
			temp: osErr;

	BEGIN
		temp:= FSClose(refNum);								{ Close the data fork of the file }
		IF err = noErr THEN
			err:= temp;

		temp:= flushVol(NIL, fileSpec.vRefNum);			{ Update the volume information }
		IF err = noErr THEN
			err:= temp;

		IF deleteIfErr & (err <> noErr) THEN					{ Delete the file if an error occurred }
			temp:= FSpDelete(fileSpec)							{	anywhere, and so requested }
	END;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	FUNCTION fileFromScrap (fileSpec: FSSpec; scrapKind: OSType): OSErr;

{ Accepts: only files. }

{ Writes the specified kind of scrap data to the file fileSpec, which must exist (so call }
{ fileCreateUnique or fileCreateTemporary beforehand if necessary).  If the scrap couldn¹t }
{ be read, e.g. there is nothing of the specified kind, the error noTypeErr is returned; File }
{ Manager errors can also be returned.  The constants textKind, stylKind and pictKind }
{ are available for scrapKind. }
{ Written by David Sinclair, 3 October 1995. }

		VAR
			scrapHndl: Handle;
			scrapLen: Longint;
			refNum: Integer;
			err, temp: OSErr;

	BEGIN
		numReadScrap(scrapKind, scrapHndl, scrapLen);
		err:= scrapLen;

		IF (scrapHndl <> NIL) & (scrapLen > 0) THEN
			BEGIN
				err:= FSpOpenDF(fileSpec, fsWrPerm, refNum);

				IF err = noErr THEN
					BEGIN
						err:= SetEOF(refNum, 0);
						HLock(scrapHndl);
						err:= FSWrite(refNum, scrapLen, scrapHndl^);
						HUnlock(scrapHndl);
						DisposeHandle(scrapHndl);

						temp:= FSClose(refNum);
						temp:= FlushVol(NIL, fileSpec.vRefNum);
					END;
			END;

		fileFromScrap:= err
	END;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	FUNCTION fileToScrap (fileSpec: FSSpec; scrapKind: OSType): OSErr;

{ Accepts: only files. }

{ Writes the contents of the specified file to the scrap, with the given scrap kind.  The constants }
{ textKind, stylKind and pictKind are available for scrapKind. }
{ Written by David Sinclair, 3 October 1995. }

		VAR
			scrapHndl: Handle;
			scrapLen: Longint;
			refNum: Integer;
			err, temp: OSErr;

	BEGIN
		err:= FSpOpenDF(fileSpec, fsRdPerm, refNum);

		IF err = noErr THEN
			BEGIN
				err:= GetEOF(refNum, scrapLen);

				err:= numNewHandle(scrapHndl, scrapLen);

				IF err = noErr THEN
					BEGIN
						HLock(scrapHndl);
						err:= FSRead(refNum, scrapLen, scrapHndl^);
						HUnlock(scrapHndl);

						numWriteScrap(scrapKind, scrapHndl, scrapLen);

						numDisposeHandle(scrapHndl);
					END;

				temp:= FSClose(refNum);
			END;

		fileToScrap:= err
	END;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	FUNCTION FileReadLinePtr(refNum: Integer; thePtr: Ptr; VAR count: Longint): OSErr;
	
	{Reads a single line from the file into the pointer.  Pass a valid pointer and the size of the pointer in count; the amount
		read is returned in count.}
	{Written by David Sinclair, 22 June 1997.}
	
	VAR
		p:					ParamBlockRec;
		newlinePtr:			Ptr;
		err:				OSErr;
	
	BEGIN
		With p DO BEGIN
			ioRefNum:= refNum;
			ioBuffer:= thePtr;
			ioReqCount:= count;
			ioActCount:= 0;
			ioPosMode:= fsAtMark;
			SetBit(ioPosMode,128,true);
			newlinePtr:= @ioPosMode;
			newlinePtr^:= 13;
			ioPosOffset:= 0;
			END;
		
		err:= PBReadSync(@p);
		count:= p.ioActCount;
		
		FileReadLinePtr:= err
		END;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	FUNCTION FileReadLineStr(refNum: Integer; VAR theStr: Str255): OSErr;
	
	{Reads a single line from the file into theStr until EOL encountered or the string is full.}
	{Written by David Sinclair, 22 June 1997.}
	
	VAR
		len:					Longint;
		err:				OSErr;
	
	BEGIN
		len:= 255;
		
		err:= FileReadLinePtr(refNum,@theStr[1],len);
		
		theStr[0]:= Chr(len);
		IF (err=eofErr) & (len > 0) THEN err:= noErr;
		
		FileReadLineStr:= err
		END;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	PROCEDURE SearchVolForAnIcon(VAR dPB: DTPBRec; iconType1: OSType; iconType2: SignedByte; iconSize: Longint; iconSuiteHdl: Handle;
								VAR foundOne: Boolean);

	{Searches the specified volume for the appropriate icon.  Only called by SearchVolForIconSuite, below.}
	{Written by David Sinclair, 19 April 1998.}
	
	VAR
		bufferHdl:				Handle;
		err:					OSErr;

	BEGIN
		err:= numNewHandle(bufferHdl,iconSize);
		
		IF err=noErr THEN BEGIN
			dPB.ioDTBuffer:= bufferHdl^;
			dPB.ioDTReqCount:= iconSize;
			dPB.ioIconType:= iconType2;

			numBlindLockHandle(bufferHdl);
			
			err:= PBDTGetIconSync(@dPB);								{Look for the icon in the desktop database}
			
			numBlindUnlockHandle(bufferHdl);
			
			IF err=noErr THEN
				err:= AddIconToSuite(bufferHdl,iconSuiteHdl,iconType1);
			END;
		
		IF err<>noErr THEN
			numDisposeHandle(bufferHdl)
		ELSE
			foundOne:= true;
		END;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	PROCEDURE SearchVolForIconSuite (vRef: Integer; creator, fileType: OSType; iconSuiteHdl: Handle; VAR foundOne: Boolean);

	{Searches the specified volume for the appropriate icon.  Only called by FileGetIconSuite, below.}
	{Written by David Sinclair, 19 April 1998.}
	
	VAR
		dPB:					DTPBRec;
		filename:				Str255;
		err:					OSErr;

	BEGIN
		filename:= null;
		dPB.ioNamePtr:= @filename;
		dPB.ioVRefNum:= vRef;
		
		err:= PBDTGetPath(@dPB);
		
		IF err=noErr THEN BEGIN
			dPB.ioNamePtr:= @filename;
			dPB.ioFileCreator:= creator;
			dPB.ioFileType:= fileType;

			SearchVolForAnIcon(dPB,kLarge1BitMask,kLargeIcon,kLargeIconSize,iconSuiteHdl,foundOne);
			SearchVolForAnIcon(dPB,kLarge4BitData,kLarge4BitIcon,kLarge4BitIconSize,iconSuiteHdl,foundOne);
			SearchVolForAnIcon(dPB,kLarge8BitData,kLarge8BitIcon,kLarge8BitIconSize,iconSuiteHdl,foundOne);
			SearchVolForAnIcon(dPB,kSmall1BitMask,kSmallIcon,kSmallIconSize,iconSuiteHdl,foundOne);
			SearchVolForAnIcon(dPB,kSmall4BitData,kSmall4BitIcon,kSmall4BitIconSize,iconSuiteHdl,foundOne);
			SearchVolForAnIcon(dPB,kSmall8BitData,kSmall8BitIcon,kSmall8BitIconSize,iconSuiteHdl,foundOne);
			END;
		END;

{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}

	FUNCTION FileGetIconSuite (creator, fileType: OSType): Handle;
	
	{Gets an icon suite for the specified kind of file from the desktop database of one of the available volumes.  Returns
		an icon suite (which can be drawn by calling PlotIconSuite), or nil if the icons couldn¹t be found.  Make sure you
		call DisposeIconSuite when you¹re completely done with the icons.}
	{Written by David Sinclair, 19 April 1998.}
	
	VAR
		iconSuiteHdl:			Handle;
		volName:				Str31;
		vPB:					ParamBlockRec;
		foundOne:				Boolean;
		err:					OSErr;
	
	BEGIN
		
		
		iconSuiteHdl:= nil;						{¶¶¶ hack; this routine currently bombs the machine, so it¹s commented out until I have time to fix it}
		
		
(*												{¶¶¶ hack}
		foundOne:= false;
		volName:= null;
		vPB.ioVolIndex:= 1;
		vPB.ioNamePtr:= @volName;
		
		err:= NewIconSuite(iconSuiteHdl);
		
		IF err=noErr THEN REPEAT
			err:= PBGetVInfoSync(@vPB);
			
			IF err = noErr THEN
				SearchVolForIconSuite(vPB.ioVRefNum, creator, fileType, iconSuiteHdl, foundOne);
			
			vPB.ioVolIndex:= vPB.ioVolIndex + 1;
			UNTIL foundOne | (err<>noErr);
		
		IF NOT foundOne & (iconSuiteHdl<>nil) THEN BEGIN
			err:= DisposeIconSuite(iconSuiteHdl,True);
			iconSuiteHdl:= nil;
			END;
*)												{¶¶¶ hack}
		
		FileGetIconSuite:= iconSuiteHdl
		END;


{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}
{--------------------------------|--------------------------------------------------------------------|---------------------------------------------------------|------------------------}


END.