unit fileIO;

  { This unit provides a class definition and methods that provide file access.  It    }
  { operates only on files that already exist (ie, the application is responsible for  }
  { creating the file initially.                                                       }
  {                                                                                    }
  { Operations on files and file objects --------------------------------------------- }
  {                                                                                    }
  { iFileObj      -  Initializes a new file object based on a file name, volume        }
  {                  reference number and file desired file permissions (read only,    }
  {                  read/write, etc.).                                                }
  { iFileObjFSS   -  Initializes a new file object based on a file system spec (FSS),  }
  {                  the data structure returned by the standard file package.         }
  { free          -  Closes the file associated with the file object and releases the  }
  {                  file object.                                                      }
  { readFile      -  Reads 'count' bytes from the file object and places the data into }
  {                  the buffer pointed to by 'buffptr'.                               }
  { writeFile     -  Writes 'count' bytes from the buffer pointed to by 'buffptr' to   }
  {                  the file object.                                                  }
  { readline      -  Reads from the file object until an end of line character         }
  {                  (carriage return) is encountered, returning the data in the       }
  {                  string specified by 'theLine'.  If more than 255 characters are   }
  {                  read only the first 255 will be placed into 'theLine'.            }
  { writeline     -  Writes the string specified in 'theLine' to the file object,      }
  {                  followed by an end of line character (carriage return).           }
  { writestr      -  Writes the string 'theLine' to the file object.                   }
  { readInteger   -  Reads 2 bytes of data from the file object and returns them as an }
  {                  integer value in 'theInteger'.                                    }
  { writeInteger  -  Writes the integer value 'theInteger' to the file object.         }
  { readLongint   -  Reads 4 bytes of data from the file object and returns them as an }
  {                  integer value in 'theLongint'.                                    }
  { writeLongint  -  Writes the long integer value 'theLongint' to the file object.    }
  { readSingle    -  Reads 4 bytes of data from the file object and returns them as a  }
  {                  single precision floating point (real) value in 'theSingle'.      }
  { writeSingle   -  Writes the single precision real 'theSingle' to the file object.  }
  { readDouble    -  Reads 8 bytes of data from the file object and returns them as a  }
  {                  double precision floating point (real) value in 'theDouble'.      }
  { writeDouble   -  Writes the double precision real 'theDouble' to the file object.  }
  { readChar      -  Reads 1 byte of data from the file object and returns it as a     }
  {                  character value in 'theChar'.                                     }
  { writeChar     -  Writes the character value 'theChar' to the file object.          }
  {                                                                                    }
  { Setting and retrieving attributes of files and file objects ---------------------- }
  {                                                                                    }
  { getfName      -  Returns the name of the file associated with the file object in   }
  {                  'fName'.                                                          }
  { setfName      -  Change the name of the file associated with the file object to    }
  {                  the string in 'newName'.                                          }
  { getVRef       -  Returns the volume reference number of the file associated with   }
  {                  the file object in 'theVRef'.                                     }
  { getRefNum     -  Returns the file system reference number of the file associated   }
  {                  with the file object in 'theRef'.                                 }
  { lastError     -  Returns the most recent file system error for the file object as  }
  {                  the function result.                                              }
  { getPermission -  Returns the file permissions for the file associated with the     }
  {                  file object in 'permission'.                                      }
  { getFType      -  Returns the file type of the file associated with the file object.}
  { setFType      -  Sets the file type of the file associated with the file object.   }
  { setEndOfFile  -  Sets the end of file marker of the file associated with the file  }
  {                  object to the current read/write position within the file.        }
  { getFPosition  -  Returns the read/write position within the file in 'position'.    }
  { setFPosition  -  Sets the read/write position within the file to 'position' bytes  }
  {                  from the beginning of the file.                                   }
  
interface

	uses
		objIntf, Types, Files, Devices;

	type
		cFileObj = object(TObject)
				fileName: str255;              { name of the file                                  }
				vRef: integer;                 { volume reference for the file                     }
				dirID: longint;
				refNum: integer;
				lastErr: OSErr;
				perm: signedByte;
				finderInfo: fInfo;
				useFSS: boolean;               { initialized with iFileObjFSS                      }

				function iFileObj (fName: str255; vRefNum: integer; permission: signedByte): OSErr;
				function iFileObjFSS (fss: FSSpec; permission: signedByte): OSErr;
				function readFile (var count: longint; buffPtr: ptr): OSErr;
				function writeFile (var count: longint; buffPtr: ptr): OSErr;
				function readLine (var theLine: str255): OSErr;
				function writeLine (theLine: str255): OSErr;
				function writeStr (theLine: str255): OSErr;
				function readInteger (var theInteger: integer): OSErr;
				function writeInteger (theInteger: integer): OSErr;
				function readLongint (var theLongint: longint): OSErr;
				function writeLongint (theLongint: longint): OSErr;
				function readSingle (var theSingle: real): OSErr;
				function writeSingle (theSingle: real): OSErr;
				function readDouble (var theDouble: double): OSErr;
				function writeDouble (theDouble: double): OSErr;
				function readChar (var theChar: char): OSErr;
				function writeChar (theChar: char): OSErr;

				procedure getfName (var fName: str255);
				function setfName (newName: str255): OSErr;
				procedure getVRef (var theVRef: integer);
				procedure getRefNum (var theRef: integer);
				function lastError: OSErr;
				procedure getPermission (var permission: signedByte);

				procedure getFType (var theType: OSType);
				procedure setFType (newType: OSType);
				procedure getFCreator (var theCreator: OSType);
				procedure setFCreator (newCreator: OSType);

				function getFSize (var size: longint): OSErr;
				function setFSize (newSize: longint): OSErr;
				function setEndOfFile: OSErr;
				function getFPosition (var position: longint): OSErr;
				function setFPosition (position: longint): OSErr;

				procedure free;
				override;
			end;

implementation

	var
		param: paramBlockRec;

	function cFileObj.iFileObj (fName: str255; vRefNum: integer; permission: signedByte): OSErr;

	begin
		useFSS := false;
		hLock(handle(SELF));
		fileName := fName;
		vRef := vRefNum;
		dirID := 0;
		perm := permission;
		with param do
			begin
				ioCompletion := nil;
				ioNamePtr := @fileName;
				ioVRefNum := vRef;
				ioVersNum := 0;
				ioPermssn := perm;
				ioMisc := nil;
				lastErr := PBOpenSync(@param);
				if lastErr = noErr then
					begin
						refNum := ioRefNum;
						lastErr := getFInfo(fileName, vRef, finderInfo);
					end
				else
					refNum := 0;
			end;
		iFileObj := lastErr;
		hUnlock(handle(SELF));
	end;

	function cFileObj.iFileObjFSS (fss: FSSpec; permission: signedByte): OSErr;

		var
			hParam: hParamBlockRec;
			
	begin
		useFSS := true;
		hLock(handle(SELF));
		fileName := fss.name;
{		if fss.parID = 0 then}
			vRef := fss.vRefNum
{		else
			vRef := 0};
		dirID := fss.parID;
		perm := permission;
		with hParam do
			begin
				ioCompletion := nil;
				ioNamePtr := @fileName;
				ioVRefNum := vRef;
				ioDirID   := dirID;
				ioVersNum := 0;
				ioPermssn := perm;
				ioMisc := nil;
				lastErr := PBHOpenSync(@hParam);
				if lastErr = noErr then
					begin
						refNum := ioRefNum;
						lastErr := FSpGetFInfo(fss, finderInfo);
					end
				else
					refNum := 0;
			end;
		iFileObjFSS := lastErr;
		hUnlock(handle(SELF));
	end;

	function cFileObj.readFile (var count: longint; buffPtr: ptr): OSErr;

	begin
		lastErr := FSRead(refNum, count, buffPtr);
		readFile := lastErr;
	end;

	function cFileObj.writeFile (var count: longint; buffPtr: ptr): OSErr;

	begin
		lastErr := FSWrite(refNum, count, buffPtr);
		writeFile := lastErr;
	end;

	function cFileObj.readLine (var theLine: str255): OSErr;

	begin
		hLock(handle(SELF));
		with param do
			begin
				ioCompletion := nil;
				ioPermssn := fsCurPerm;
				ioRefNum := refNum;
				ioBuffer := @theLine[1];            { read into theLine             }
				ioReqCount := 255;                  { ask for a whole string worth  }
				ioPosMode := $0D80;                 { stop @ newline char (#13)     }
				ioPosOffset := 0;
			end;
		lastErr := PBReadSync(@param);
		if param.ioActCount > 0 then
			begin
				theLine[0] := chr(param.ioActCount);
				if theLine[length(theLine)] = chr(13) then
					theLine[0] := chr(length(theLine) - 1);
			end
		else
			theLine := '';
		readLine := lastErr;
		hUnlock(handle(SELF));
	end;

	function cFileObj.writeLine (theLine: str255): OSErr;

		var
			CR: string[1];

	begin
		hLock(handle(SELF));
		with param do
			begin
				ioCompletion := nil;
				ioPermssn := fsCurPerm;
				ioRefNum := refNum;
				ioBuffer := @theLine[1]; { write from theLine    }
				ioReqCount := length(theLine);
				ioPosMode := fsAtMark;
				ioPosOffset := 0;
			end;
		lastErr := PBWriteSync(@param);
		if lastErr = noErr then { append carriage return }
			begin
				CR := ' ';
				CR[1] := chr(13);
				param.ioBuffer := @CR[1];
				param.ioReqCount := 1;
				param.ioPosMode := fsAtMark;
				param.ioPosOffset := 0;
				lastErr := PBWriteSync(@param);
			end;
		writeLine := lastErr;
		hUnlock(handle(SELF));
	end;

	function cFileObj.writeStr (theLine: str255): OSErr;

	begin
		hLock(handle(SELF));
		with param do
			begin
				ioCompletion := nil;
				ioPermssn := fsCurPerm;
				ioRefNum := refNum;
				ioBuffer := @theLine[1]; { write from theLine    }
				ioReqCount := length(theLine);
				ioPosMode := fsAtMark;
				ioPosOffset := 0;
			end;
		lastErr := PBWriteSync(@param);
		writeStr := lastErr;
		hUnlock(handle(SELF));
	end;

	function cFileObj.readInteger (var theInteger: integer): OSErr;

		var
			numBytes: longint;
			temp: integer;

	begin
		numBytes := sizeof(integer);
		lastErr := FSRead(refNum, numBytes, @temp);
		theInteger := temp;
		readInteger := lastErr;
	end;

	function cFileObj.writeInteger (theInteger: integer): OSErr;

		var
			numBytes: longint;

	begin
		numBytes := sizeof(integer);
		lastErr := FSWrite(refNum, numBytes, @theInteger);
		writeInteger := lastErr;
	end;

	function cFileObj.readLongint (var theLongint: longint): OSErr;

		var
			numBytes: longint;
			temp: longint;

	begin
		numBytes := sizeof(longint);
		lastErr := FSRead(refNum, numBytes, @temp);
		theLongint := temp;
		readLongint := lastErr;
	end;

	function cFileObj.writeLongint (theLongint: longint): OSErr;

		var
			numBytes: longint;

	begin
		numBytes := sizeof(longint);
		lastErr := FSWrite(refNum, numBytes, @theLongint);
		writeLongint := lastErr;
	end;

	function cFileObj.readSingle (var theSingle: real): OSErr;

		var
			numBytes: longint;

	begin
		numBytes := sizeof(real);
		lastErr := FSRead(refNum, numBytes, @theSingle);
		readSingle := lastErr;
	end;

	function cFileObj.writeSingle (theSingle: real): OSErr;

		var
			numBytes: longint;

	begin
		numBytes := sizeof(real);
		lastErr := FSWrite(refNum, numBytes, @theSingle);
		writeSingle := lastErr;
	end;

	function cFileObj.readDouble (var theDouble: double): OSErr;

		var
			numBytes: longint;

	begin
		numBytes := sizeof(double);
		lastErr := FSRead(refNum, numBytes, @theDouble);
		readDouble := lastErr;
	end;

	function cFileObj.writeDouble (theDouble: double): OSErr;

		var
			numBytes: longint;

	begin
		numBytes := sizeof(double);
		lastErr := FSWrite(refNum, numBytes, @theDouble);
		writeDouble := lastErr;
	end;

	function cFileObj.readChar (var theChar: char): OSErr;

		var
			numBytes: longint;
			temp: string[1];

	begin
		numBytes := 1;
		lastErr := FSRead(refNum, numBytes, @temp[1]);
		theChar := temp[1];
		readChar := lastErr;
	end;

	function cFileObj.writeChar (theChar: char): OSErr;

		var
			numBytes: longint;
			temp: string[1];

	begin
		numBytes := 1;
		temp[1] := theChar;
		lastErr := FSWrite(refNum, numBytes, @temp[1]);
		writeChar := lastErr;
	end;

	procedure cFileObj.getfName (var fName: str255);

	begin
		fName := fileName;
	end;

	function cFileObj.setfName (newName: str255): OSErr;

	begin
		if useFSS then
			lastErr := HRename(0, dirID, fileName, newName)
		else
			lastErr := Rename(fileName, vRef, newName);
		if lastErr = noErr then
			fileName := newName;
		setfName := lastErr;
	end;

	procedure cFileObj.getVRef (var theVRef: integer);

	begin
		theVRef := vRef;
	end;

	procedure cFileObj.getRefNum (var theRef: integer);

	begin
		theRef := refNum;
	end;

	function cFileObj.lastError: OSErr;

	begin
		lastError := lastErr;
	end;

	procedure cFileObj.getPermission (var permission: signedByte);

	begin
		permission := perm;
	end;

	procedure cFileObj.getFType (var theType: OSType);

	begin
		theType := finderInfo.fdType;
	end;

	procedure cFileObj.setFType (newType: OSType);

		var
			theFSS: FSSpec;
		
	begin
		finderInfo.fdType := newType;
		if useFSS then
			begin
				theFSS.vRefNum := vRef;
				theFSS.parID   := dirID;
				theFSS.name    := fileName;
				lastErr := FSpSetFInfo(theFSS, finderInfo);
			end
		else
			lastErr := setFInfo(fileName, vRef, finderInfo);
	end;

	procedure cFileObj.getFCreator (var theCreator: OSType);

	begin
		theCreator := finderInfo.fdCreator;
	end;

	procedure cFileObj.setFCreator (newCreator: OSType);

		var
			theFSS: FSSpec;
		
	begin
		finderInfo.fdCreator := newCreator;
		if useFSS then
			begin
				theFSS.vRefNum := vRef;
				theFSS.parID   := dirID;
				theFSS.name    := fileName;
				lastErr := FSpSetFInfo(theFSS, finderInfo);
			end
		else
			lastErr := setFInfo(fileName, vRef, finderInfo);
	end;

	function cFileObj.getFSize (var size: longint): OSErr;

	begin
		lastErr := getEOF(refNum, size);
		getFSize := lastErr;
	end;

	function cFileObj.getFPosition (var position: longint): OSErr;

	begin
		lastErr := getFPos(refNum, position);
		getFPosition := lastErr;
	end;

	function cFileObj.setFSize (newSize: longint): OSErr;

	begin
		lastErr := setEOF(refNum, newSize);
		setFSize := lastErr;
	end;

	function cFileObj.setEndOfFile: OSErr;

		var
			newSize: longint;

	begin
		lastErr := GetFPos(refNum, newSize);
		if lastErr = noErr then
			lastErr := setEOF(refnum, newSize);
		setEndOfFile := lastErr;
	end;

	function cFileObj.setFPosition (position: longint): OSErr;

	begin
		lastErr := setFPos(refNum, fsFromStart, position);
		setFPosition := lastErr;
	end;

	procedure cFileObj.free;

	begin
		if refNum <> 0 then
			lastErr := FSClose(refNum);
		inherited free;
	end;

end.