Pascal I/O Extensions
Greg Ewing, Pascal Developer

The following unit provides some extensions to the Pascal I/O facilities to interface them more harmoniously with the File Manager. Following the unit is a sample program which shows how easy it is to use them. The extended functions are:

• FSpReset - opens an existing file for reading as Pascal text file, given an FSSpec.
• FSpRewrite - creates a new file with the given type and creator codes, and opens it for writing as a Pascal text file.
• GetOldFile - prompts the user for the name of an existing file.
• GetNewFile - prompts the user for the name of a new file.

Download the complete project

Unit XPascalIO;

{***************************************************}
{*                                                  }
{*                                                  }
{*                                                  }
{*   By Greg Ewing (greg@cosc.canterbury.ac.nz,     }
{*   http://www.cosc.canterbury.ac.nz/~greg)        }
{*   November 1996                                  }
{*   Freeware and Use-at-your-own-risk-ware.        }
{*                                                  }
{*   Updated to CodeWarrior project, 12/17/96.      }
{*   Bill Catambay.                                 }
{*                                                  }
{***************************************************}

Interface

Uses
   Files, StandardFile, Types;
	
{	FSpReset opens an existing file for reading as Pascal text file, given an FSSpec.}
Procedure FSpReset (var f: text; spec: FSSpec);

{	FSpRewrite creates a new file with the given type and creator codes, and }
{	opens it for writing as a Pascal text file. }
Procedure FSpRewrite (var f: text; spec: FSSpec; fileType, fileCreator: OSType);

{	XIOResult may be called to find out the result of the last call to any of the above }
{	routines. Returns noErr if the call succeeded; otherwise it may return either an }
{	Operating System error code, or a return value from IOResult. }
Function XIOResult: OSErr;

{	GetOldFile prompts the user for the name of an existing file. One file type }
{	may be specified. (If you need to use more than one file type, use StandardGetFile.) }
Function GetOldFile (fileType: OSType; var spec: FSSpec): boolean;

{	GetNewFile prompts the user for the name of a new file. Returns true unless}
{	the dialog is cancelled.}
Function GetNewFile (prompt, defaultName: Str255; var spec: FSSpec): boolean;


Implementation

Var
   gXIOResult: OSErr;

Procedure Ignore (x: univ longint);

   begin
   { procedure to ignore function return values }
   end;

Procedure FSpReset (var f: text; spec: FSSpec);

Var
   oldVRefNum: integer;

   Procedure Check (result: OSErr);

   begin
   if result <> noErr then 
      begin
      gXIOResult := result;
      exit(FSpReset);
      end;
   end;

   begin {FSpReset}
   gXIOResult := noErr;
   Ignore(GetVol(nil, oldVRefNum));
   Check(HSetVol(nil, spec.vRefNum, spec.parID));
   reset(f, spec.name);
   Check(IOResult);
   Ignore(SetVol(nil, oldVRefNum));
   end;

Procedure FSpRewrite (var f: text; spec: FSSpec; fileType, fileCreator: OSType);

Var
   oldVRefNum: integer;
   info: FInfo;

   Procedure Check (result: OSErr);

   begin
   if result <> noErr then 
      begin
      gXIOResult := result;
      exit(FSpRewrite);
      end;
   end;

   begin
   gXIOResult := noErr;
   Ignore(GetVol(nil, oldVRefNum));
   Ignore(HSetVol(nil, spec.vRefNum, spec.parID));
   rewrite(f, spec.name);
   Check(IOResult);
   Check(FSpGetFInfo(spec, info));
   info.fdType := fileType;
   info.fdCreator := fileCreator;
   Check(FSpSetFInfo(spec, info));
   Ignore(SetVol(nil, oldVRefNum));
   end;

Function XIOResult: OSErr;

   begin
   XIOResult := gXIOResult;
   end;

Function GetOldFile (fileType: OSType; var spec: FSSpec): boolean;

Var
   reply: StandardFileReply;
   types: SFTypeList;

   begin
   types[0] := fileType;
   StandardGetFile(NIL, 1, @types, reply);
   if reply.sfGood then 
      begin
      spec := reply.sfFile;
      GetOldFile := true;
      end
   else
      GetOldFile := false;
   end;

Function GetNewFile (prompt, defaultName: Str255; var spec: FSSpec): boolean;

Var
   reply: StandardFileReply;
   types: SFTypeList;

   begin
   types[0] := 'TEXT';
   StandardPutFile(prompt, defaultName, reply);
   if reply.sfGood then 
      begin
      spec := reply.sfFile;
      GetNewFile := true;
      end
   else
      GetNewFile := false;
   end;

end.

{ Test program for the XPascalIO unit.                  }
{ Asks the user for an input and an output              }
{ file, and copies one to the other, while echoing      }
{ the contents to the text window.	                     }
{ Greg Ewing, 1996	                                     }

{ Updated to a CodeWarrior project, 12/17/96, Bill Catambay }

Program HSetVolTest;

Uses
   XPascalIO, Fonts;

Var
   spec1, spec2: FSSpec;
   f1, f2: text;
   line: Str255;

Procedure InitToolbox;

   begin
   InitGraf(@qd.thePort);
   InitFonts;
   InitWindows;
   InitMenus;
   TEInit;
   InitDialogs(NIL);
   InitCursor;
   MaxApplZone;
   MoreMasters;
   end;
	
begin
InitToolbox;
if GetOldFile('TEXT', spec1) then
   if GetNewFile('Save copy as:', concat(spec1.name, ' copy'), spec2) then 
      begin
      FSpReset(f1, spec1);
      FSpRewrite(f2, spec2, 'TEXT', 'PJMM');
      while not eof(f1) do 
         begin
         readln(f1, line);
         writeln(line);
         writeln(f2, line);
         end;
      close(f1);
      close(f2);
      end;
end.






Copyright © 1996 Greg Ewing. All Rights Reserved.
Webified by Bill Catambay.

Updated: 19-December-1996