From: cjp@aber.ac.uk (Chris Price)
Newsgroups: comp.lang.pascal
Subject: Re: How to test for a file in SUN-Pascal
Date: 6 Apr 92 14:50:05 GMT
	<1992Apr3.100045.461@uwasa.fi>
Organization: AI Research Group, UCW, Aberystwyth

I am a Pascal programmer who had the same problem.
Here are the C routines that I wrote to enable this.  
Apologies to anyone who thinks C is a reasonable language and who is
offended by my feeble attempts.

The C code is followed by the Pascal interface.
Use them and say thank you.

---------- C module "unixhard.c" -------------- 
/* C module "unixhard.c". Interface routines for file handling. */
/* Compile with cc -c unixhard.c in the place where you are building. */

#include <stdio.h>
#include <pwd.h>
#define MAXLINE 1000
#define FNAMELEN 256
#define PMODE 0644  /* RW for owner, R for group and others. */

/* Definitions of useful system functions. */
struct passwd *getpwent();
char *getenv();


/* This procedure halts the process appropriately. */
exitfromc( exitvalue )
int exitvalue;
{
exit( exitvalue );
}


/* This tries opening a file for read and returns 0 if successful, */
/* and 1 if unsuccessful. It closes the file again afterwards.  */
int oktoread(fname)
{
FILE *filetotry;
if ((filetotry = fopen(fname, "r")) == NULL)
   return(1);
else
   {fclose(filetotry);
    return(0);
  }
}

/* This tries opening a file for write and returns 0 if successful, */
/* and 1 if unsuccessful. It deletes the file again afterwards.  */
int oktowrite(fname)
char fname[];
{
FILE *f;
if ((f = fopen(fname, "w")) == NULL)
   {fprintf(stderr, "opening for write" );
   return(1);}
else {unlink(fname);
      fclose(f);
      return(0);}
}

/* This opens an existing file for random access. */
/* Returning < 0 means failed, else return filedesc */
int copenrandom(fname)
char fname[];
{
int status;
  status = open( fname, 0 );
  return( status );
}


/* This opens a new file for random access. < 0 means failed, else return filedesc. */
int ccreaterandom(fname)
char fname[];
{
int status;
  status = creat( fname, PMODE );
  return( status );
}

int cunlink(fname)
char fname[];
{
int status;
  status = unlink( fname );
  return( status );
}

int ccloserandom(filedesc)
int filedesc;
{
int status;
  status = close( filedesc );
  return( status );
}


int creadrandom(filedesc, byteaddr, whereto)
int filedesc;
long byteaddr;
char *whereto;
{
  lseek( filedesc, byteaddr, 0);
  return( read(filedesc, whereto, 2048) );
}


int cwriterandom(filedesc, byteaddr, wherefrom)
int filedesc;
long byteaddr;
char *wherefrom;
{
  lseek( filedesc, byteaddr, 0);
  return( write(filedesc, wherefrom, 2048) );
}



=================== and here is the Pascal - live long and prosper ========
========= You may want to know about name translation routines.... ========

=============This module will need the following declarations somewhere....

CONST
    MAXFNAME	=	255;	(* Max no. of chars in a filename *)
    UNITSBLOCK	=	2048;	(* No. of units per block	*)
    MAXUNITINDEX	=	2047;	(* UNITSBLOCK - 1		*)

TYPE
    AUnit   =   (* -OS- *) Char;
    UnitIndex   =   0..MAXUNITINDEX;

    FNameIndex  =   0..MAXFNAME;
    FNameType   =   PACKED ARRAY[1..MAXFNAME] OF Char;

    AtRandomBlock = ^RandomBlock
    RandomBlock =   PACKED ARRAY [UnitIndex] of AUnit;
    RandomType  =   INTEGER ;   (* -OS- *)

    (* New for the Sun UNIX version. This type holds a file descriptor. *)
    (* This is used for the implementation in C of OpenRandom etc.      *)
   iobptr = ^INTEGER;

==================================

(*======================================================================*)
(*                                                                      *)
(* Author:              Chris Price.                                    *)
(* Purpose of module:                                                   *)
(*  This module implements the Sun Unix version of the machine dependent*)
(*    file handling routines:                                           *)
(*                      OpenText                                        *)
(*                      CloseText                                       *)
(*                      OpenRandom                                      *)
(*                      CloseRandom                                     *)
(*                      ReadRandom                                      *)
(*                      WriteRandom                                     *)
(*                      ZeroRandomBlock                                 *)
(*                                                                      *)
(* Version      Date    Author          Reason for change               *)
(*    1       03/01/91   CJP          First Sun Unix version            *)
(*                                                                      *)
(*======================================================================*)


(* This function checks that it is possible to read from a given file. *)
FUNCTION OKToRead
( FName: PACKED ARRAY [lb..ub: INTEGER] OF CHAR ): Integer;
EXTERNAL C;

(* This function checks that it is possible to write to a given file. *)
FUNCTION OKToWrite
( FName: PACKED ARRAY [lb..ub: INTEGER] OF CHAR ): Integer;
EXTERNAL C;

(* This function opens an existing file for random access. *)
FUNCTION COpenRandom
( FName: PACKED ARRAY [lb..ub: INTEGER] OF CHAR ): Integer;
EXTERNAL C;

(* This function opens a new file for random access. *)
FUNCTION CCreateRandom
( FName: PACKED ARRAY [lb..ub: INTEGER] OF CHAR ): Integer;
EXTERNAL C;

(* This function unlinks a random access file so it will disappear on close.*)
FUNCTION CUnlink
( FName: PACKED ARRAY [lb..ub: INTEGER] OF CHAR ): Integer;
EXTERNAL C;

(* This function closes a random access file. *)
FUNCTION CCloseRandom
( TheFile: Integer ): Integer;
EXTERNAL C;

(* This function reads a numbered block from a random access file. *)
FUNCTION CReadRandom
(TheFile: Integer; Byteaddr: Integer; WhereTo: AtRandomBlock): Integer;
EXTERNAL C;

(* This function writes a numbered block to a random access file. *)
FUNCTION CWriteRandom
(TheFile: Integer; Byteaddr: Integer; WhereFrom: AtRandomBlock): Integer;
EXTERNAL C;


(*----------------------------------------------------------------------*)
PROCEDURE BlankOut( VAR InName, OutName: FNameType);
(*----------------------------------------------------------------------*)
(* Turns a Pascal filename into a C one by adding a zero at end.        *)
(*----------------------------------------------------------------------*)
VAR
    I,
    Counter: Integer;
BEGIN
    Counter := MAXFNAME + 1;
    REPEAT
        Counter := Counter - 1;
    UNTIL (Counter = 1) OR (InName[Counter] <> ' ');

    FOR I := 1 TO Counter DO
        OutName[I] := InName[I];
    
    OutName[Counter+1] := Chr(0);
END;



(*======================================================================*)
-GLOBAL FUNCTION OpenText
        ( VAR f: text ; VAR FName: FNameType ;
                 NewFile: Boolean ) : Boolean
-ENDGLOBAL
(*======================================================================*)
(* This procedure RESETs or REWRITEs a Pascal text file with name       *)
(* FName if NewFile is false or true respectively.  If it succeeds it   *)
(* returns true, otherwise false.                                       *)
(*======================================================================*)
VAR
    StatusCode : Integer;
    ReturnState: Integer;
    Success : Boolean ;
    ExpName: FNameType;
BEGIN   (* * *   OpenText   * * *)

(*  CheckEnv( FName, ExpName );  --- This will expand environment variables *)
    BlankOut( FName, ExpName );
    
    IF NewFile THEN
    BEGIN
        (*----------------------------------------------------------------*)
        (* Check it is OK to open the file with write access, and do so.*)
        (*----------------------------------------------------------------*)
        ReturnState := OKToWrite( ExpName );
        Success := ReturnState = 0;
        IF Success (*so far*) THEN
        BEGIN
            Rewrite( f, ExpName );
        END (* IF Open succeeded *) ;
        IF NOT(Success) THEN
        BEGIN
            Writeln( '%OpenText Warning : failed to open file ', FName ) ;
            Writeln( ' as new text file : Pascal StatusCode is ', ReturnState ) ;
        END ;

    END
    ELSE
    BEGIN
        (* ------------------------------------------------------------ *)
        (* Only want to read. Check it is allowed and open the file,    *)
        (* for SHARED reading.                                          *)
        (* ------------------------------------------------------------ *)
        ReturnState := OKToRead( ExpName );
        Success := ReturnState = 0;
        IF Success (*so far*) THEN
        BEGIN
            Reset( f, ExpName );
        END (* IF Open succeeded *) ;
    END;

    OpenText := Success ;
    
END     (* * *   OpenText   * * *) ;




(*======================================================================*)
-GLOBAL FUNCTION CloseText
        ( VAR f: text; Discard: Boolean ) : Boolean
-ENDGLOBAL
(*======================================================================*)
(* This procedure closes a Pascal text file.                            *)
(*======================================================================*)
VAR
    Success : Boolean ;

BEGIN   (* * *   CloseText   * * *)

    (* A DUMMY PROC AT PRESENT, not sure I need to do anything, - THINK ABOUT IT. *)
    Success := TRUE;
    CloseText := Success ;

END     (* * *   CloseText   * * *) ;



(*======================================================================*)
-GLOBAL FUNCTION  OpenRandom
        ( VAR f: RandomType; VAR FName: FNameType;
                  IsTemp, NewFile: Boolean) : Boolean
-ENDGLOBAL
(*======================================================================*)
(* Open random file (creating if NewFile, read-only if not) with name   *)
(* FName.  Return true if open was successful.                          *)
(*======================================================================*)
VAR
    CFName: FNameType;
    Status: Integer;
BEGIN   (* * *   OpenRandom   * * *)

    BlankOut( FName, CFName );

    IF NewFile THEN
    BEGIN
        (*------------------------------------------*)
        (* Need to create a file to which to write. *)
        (*------------------------------------------*)
        f := CCreateRandom(CFName);
        IF (f >= 0) AND IsTemp THEN
        BEGIN
            (* Open it TEMPORARY *)
            Status := CUnlink( CFName );
            if Status < 0 then WRITELN('Wouldn''t you know - an UNLINK error');
        END
        ELSE IF f < 0 THEN
        BEGIN
            Writeln( '%OpenRandom Warning : failed to open file ', FName ) ;
            Writeln( ' as new file : Pascal StatusCode is ', f:1 ) ;
        END ;
    END
    ELSE
    BEGIN
        (*----------------------------------------*)
        (* we are opening a file for shared read. *)
        (*----------------------------------------*)
        f := COpenRandom(CFName);
        IF f < 0 THEN
        BEGIN
            Writeln( '%OpenRandom Warning : failed to open file ', FName ) ;
            Writeln( ' as new file : Pascal StatusCode is ', f:1 ) ;
        END ;
    END;
    
    OpenRandom := (f >= 0) ;

END     (* * *   OpenRandom   * * *) ;




(*======================================================================*)
-GLOBAL FUNCTION CloseRandom
        ( VAR f: RandomType; Discard: Boolean ) : Boolean
-ENDGLOBAL
(*======================================================================*)
(* This procedure closes a random access file.                          *)
(*======================================================================*)
VAR
    StatusCode: Integer;
    
BEGIN   (* * *   CloseRandom   * * *)

    StatusCode := CCloseRandom( f );

    IF StatusCode < 0 THEN
    BEGIN
        Writeln( '%CloseRandom Warning : failed with Pascal Status ', StatusCode:1 );
    END ;

    CloseRandom := (f >= 0);

END     (* * *   CloseRandom   * * *) ;


(*======================================================================*)
-GLOBAL PROCEDURE ZeroRandomBlock
    ( TheBlock : AtRandomBlock
    )
-ENDGLOBAL

VAR
    CleanUnit : AUnit ;
    CleanIter : UnitIndex ;

BEGIN   (* * *   ZeroRandomBlock   * * *)

    (* The only machine-dependant thing about this routine is the       *)
    (* assignment to CleanUnit below -- this depends on what aUnit is   *)
    (* on your machine. We want to get all the bits zeroed, please.     *)
    CleanUnit := Chr( 0 ) ;
    FOR CleanIter := 0 TO MAXUNITINDEX DO
    BEGIN
        TheBlock^[ CleanIter ] := CleanUnit ;
    END ;

END     (* * *   ZeroRandomBlock   * * *) ;


(*======================================================================*)
-GLOBAL FUNCTION ReadRandom
                ( VAR f: RandomType;
                         BlockNo: BlockNumber;
                         Whereto: AtRandomBlock ) : Boolean
-ENDGLOBAL
(*======================================================================*)
(* This procedure reads block BlockNo (block no.s start at ONE) from the*)
(* specified random file into buffer Whereto                            *)
(*======================================================================*)
VAR
    Success : Boolean ;
    Result: Integer;
BEGIN   (* * *   ReadRandom   * * *)

    Result := CReadRandom( f, BlockNo*2048, Whereto );
    Success := Result >= 0;
    
    IF NOT Success THEN
    BEGIN
        (* Need to zeroise WhereTo^, for hygeine *)
        ZeroRandomBlock( WhereTo ) ;    (* v2.1 - now a Routine. *)
        IF NOT Success THEN
        BEGIN
            Writeln( '?ReadRandom error : StatusCode = ', Result ) ;
        END ;
    END;
    
    ReadRandom := Success ;

END     (* * *   ReadRandom   * * *) ;




(*======================================================================*)
-GLOBAL FUNCTION WriteRandom
                ( VAR f: RandomType;
                         BlockNo: BlockNumber;
                         WhereFrom: AtRandomBlock ) : Boolean
-ENDGLOBAL
(*======================================================================*)
(* This procedure writes block BlockNo (block no.s start at ONE) of the *)
(* specified random file from buffer Wherefrom                          *)
(*======================================================================*)
VAR
    Result: Integer;
    Success : Boolean ;
BEGIN   (* * *   WriteRandom   * * *)

    Result := CWriteRandom( f, BlockNo*2048, WhereFrom );
    Success := Result >= 0;


    IF NOT Success THEN
    BEGIN
        Writeln( '?WriteRandom error : StatusCode = ', Result:1 ) ;
    END ;

    WriteRandom := Success ;

END     (* * *   WriteRandom   * * *) ;

(*======================================================================*)


--
-------------------------------------------------------------------------
Chris Price, Department of Computer Science, University College of Wales,
             Aberystwyth, Dyfed, SY23 3BZ, United Kingdom.
email: cjp@uk.ac.aber (within UK) cjp@aber.ac.uk (rest of world?)
Telephone: 0970-622444

NOTE: 
Change of address, ".cs" dropped so our mail doesn't go to Czechoslovakia.
-------------------------------------------------------------------------